Show Posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.


Messages - Dustinian

Pages: [1]
1
Programs / Re: Screensaver: Super Simple Snowfall (with accumulation)
« on: December 23, 2021, 01:16:54 am »
Wow! A lot of great feedback on my first post! I've taken a lot of the feedback to heart.
  • Hairy Snow @bplus, great feedback! I added a "settle" function that gives spikey accumulation an increasingly likely chance to settle left or right when the delta is 2 pixels or more.
  • Screen 9 @Richard Frost, great feedback! I've made this change!
  • Timer Crossing Midnight @Richard Frost, great feedback, I had not considered midnight! I've made a similar change to the one you suggested (your exact suggestion didn't work for me... using MOD to get the remainder after seconds causes a 1 second delay every other second... the same problem you pointed out would occur after midnight, but every second now. So I just added another condition to the loop that sngStart had to be >= Timer for the loop to continue.

Code: QB64: [Select]
  1. 'SNOWFALL.BAS
  2. '============
  3.  
  4. 'DESCRIPTION
  5. '-----------
  6. '   A holiday screensaver for QBasic.
  7.  
  8. 'AUTHOR
  9. '------
  10. '   Dustinian Camburides
  11.  
  12. 'PLATFORM
  13. '--------
  14. '   Written in QB64.
  15. '   But designed to be QBasic/QuickBasic compatible.
  16. '       Although, I haven't tested QBasic / QuickBasic compatability yet.
  17.  
  18. 'VERSION
  19. '-------
  20. '1.0, 2021-12-18: First working version.
  21. '1.1, 2021-12-19: I was excited to keep working!
  22. '   Added page-flipping to reduce flicker!
  23. '   Added background snowflakes at a smaller speed and dimmer color!
  24. '   Set the formula to advance snowflakes to actually use the FALLSPEED constant.
  25. '   Also started the timer before calculating all the snowflakes to smooth out the animation.
  26. '1.2, 2021-12-23: Updates with encouragement from the great folks at qb64.org/forum!
  27. '   Added a "settle" function to let "spiky" snow accumulation settle. (Thank you for the suggestion bplus!)
  28. '   Updated the delay so it doesn't break when it starts before midnight and ends after midnight. (Thank you for the suggestion Richard Frost!)
  29. '   Shifted to screen 9 to keep page-flipping, but at a higher resolution. (Thank you for the suggestion Richard Frost!)
  30.  
  31. 'PLANNED ENHANCEMENTS
  32. '--------------------
  33. 'Maybe next year I will add...
  34. '   - Actual, tested QBasic compatability (need to to a DosBox install and find a copy of QBasic).
  35. '   - A more complex data structure for snowflakes that can store both X and Y coordinates in a dynamic array of user-defined types... so it can support more than one snowflake per column... and mabe some drift back-and-forth in the X-axis.
  36.  
  37. 'HOLIDAY MESSAGE
  38. '---------------
  39. 'But for now, I'm happy that I have my first QB64 program that has animation. Happy Holidays!
  40.  
  41. 'SUBS
  42. Declare Sub CalculateSnowflakeColumn (SnowFlake As Integer, Accumulation As Integer, Rows As Integer, FallSpeed As Integer, Odds As Single)
  43. Declare Sub DrawSnowflakeColumn (Snowflake As Integer, Accumulation As Integer, Column As Integer, Rows As Integer, SnowColor As Integer)
  44. Declare SettleAccumulation (LeftAccumulation As Integer, Accumulation As Integer, RightAccumulation As Integer)
  45.  
  46. 'CONSTANTS
  47. Const FALLSPEED = 1 'Snow falls this many pixels per frame.
  48. Const COLUMNS = 639 'The screen is 640 pixels across (0-639) in Screen 9.
  49. Const ROWS = 349 'The screen is 350 pixels tall (0-349) in Screen 9.
  50. Const DELAY = 0.04 'The number of seconds between snowflake recalculation / re-draw... QBasic can't detect less than 0.04 seconds...
  51. Const ODDS = 0.7 'The % chance a snowflake will be added to a column that doesn't have a snowflake... anything over 1% will results in "waves" of snowflakes.
  52.  
  53. 'VARIABLES
  54. Dim intSnowflakes(COLUMNS) As Integer 'Array that holds the current Y-coordinate for a snowflake per column... this means there can only be one snowflake per column at any given time.
  55. Dim intBackgroundSnowflakes(COLUMNS) As Integer 'Same as above, but for the background.
  56. Dim intAccumulation(COLUMNS) As Integer 'Array that holds the current accumulated pixels of snow per column.
  57. Dim intBackgroundAccumulation(COLUMNS) As Integer ' Same as above, but for the background.
  58. Dim intColumn As Integer 'The current column in the loop.
  59. Dim sngStart As Single 'The timer at the start of the delay loop.
  60. Dim intBackgroundFrame As Integer 'Whether the current frame will move the background snow...
  61. Dim intFullColumns As Integer 'Used to track the number of columns that are full of snow...
  62.  
  63. 'INITIALIZE VARIABLES
  64. 'For each column...
  65. For intColumn = 0 To COLUMNS
  66.     'Set all snowflakes to -1, indicating there is no snowflake in this column.
  67.     intSnowflakes(intColumn) = -1
  68.     intBackgroundSnowflakes(intColumn) = -1
  69.     'Set all accumulation to 0, indicating there is no accumulation in this column.
  70.     intAccumulation(intColumn) = 0
  71.     intBackgroundAccumulation(intColumn) = 0
  72. Next intColumn
  73. intBackgroundFrame = 0
  76.  
  77. 'INITIALIZE SCREEN
  78. 'Set the screen to mode 9 with an active page (where the cls, pset, and line commands occur) of 0 and a visible page (that the user sees) of 1.
  79. Screen 9, , 0, 1
  80. Color 15, 0
  82.  
  83. 'PROGRAM
  84. 'While no key has been pressed...
  85. While InKey$ = "" And intFullColumns < COLUMNS
  86.     'Set the delay timer...
  87.     sngStart = Timer
  88.     'Reset the number of full columns...
  89.     intFullColumns = 0
  90.     'Flip whether the background snow will move on or off...
  91.     intBackgroundFrame = Not intBackgroundFrame
  92.     'For each column... calculate the changes to the snowfall...
  93.     For intColumn = 0 To COLUMNS
  94.         'Settle the accumulation...
  95.         If intColumn > 0 And intColumn < COLUMNS Then
  96.             Call SettleAccumulation(intAccumulation(intColumn - 1), intAccumulation(intColumn), intAccumulation(intColumn + 1))
  97.             Call SettleAccumulation(intBackgroundAccumulation(intColumn - 1), intBackgroundAccumulation(intColumn), intBackgroundAccumulation(intColumn + 1))
  98.         End If
  99.         'If this is a background frame...
  100.         If intBackgroundFrame Then
  101.             'Recalculate background snow...
  102.             Call CalculateSnowflakeColumn(intBackgroundSnowflakes(intColumn), intBackgroundAccumulation(intColumn), ROWS, FALLSPEED, ODDS)
  103.             'Ensure background accumulation keeps up with foreground accumulation to smooth out the accumulation...
  104.             If intAccumulation(intColumn) > intBackgroundAccumulation(intColumn) Then intBackgroundAccumulation(intColumn) = intAccumulation(intColumn)
  105.         End If
  106.         'Draw the background snow first...
  107.         Call DrawSnowflakeColumn(intBackgroundSnowflakes(intColumn), intBackgroundAccumulation(intColumn), intColumn, ROWS, 7)
  108.         'Recalculate the foreground snow...
  109.         Call CalculateSnowflakeColumn(intSnowflakes(intColumn), intAccumulation(intColumn), ROWS, FALLSPEED, ODDS)
  110.         'Draw the foreground snow next, on top of the background snow...
  111.         Call DrawSnowflakeColumn(intSnowflakes(intColumn), intAccumulation(intColumn), intColumn, ROWS, 15)
  112.         'Track whether or not this column is full of snow (program will terminate when all columns are full)...
  113.         If intAccumulation(intColumn) = ROWS Then intFullColumns = intFullColumns + 1
  114.     Next intColumn
  115.     'Copy the active page (where we just drew the snow) to the visible page...
  116.     PCopy 0, 1
  117.     'Clear the active page for the next frame...
  118.     Cls
  119.     'Wait for the delay to pass before starting over...
  120.     While (Timer < (sngStart + DELAY)) And (Timer >= sngStart)
  121.     Wend
  124. PCopy 0, 1
  126.  
  127. Sub CalculateSnowflakeColumn (Snowflake As Integer, Accumulation As Integer, Rows As Integer, FallSpeed As Integer, Odds As Single)
  128.     'If there is a snowflake in the column (i.e. any value > -1) then...
  129.     If Snowflake > -1 Then
  130.         'If the snowflake has not fallen to the accumulation...
  131.         If (Snowflake + FallSpeed) < (Rows - Accumulation) Then
  132.             'Advance the snowflake...
  133.             Snowflake = Snowflake + FallSpeed
  134.         Else
  135.             'Eliminate the flake...
  136.             Snowflake = -1
  137.             'Add to the accumulation...
  138.             Accumulation = Accumulation + 1
  139.         End If
  140.     Else
  141.         'If accumulation hasn't filled up the column...
  142.         If Accumulation < Rows Then
  143.             'Maybe add a flake...
  144.             If (Rnd * 100) < Odds Then
  145.                 Snowflake = 0
  146.             End If
  147.         End If
  148.     End If
  150.  
  151. Sub DrawSnowflakeColumn (Snowflake As Integer, Accumulation As Integer, Column As Integer, Rows As Integer, SnowColor As Integer)
  152.     'If there is a snowflake in this column...
  153.     If Snowflake > -1 Then
  154.         'Draw the snowflake...
  155.         PSet (Column, Snowflake), SnowColor
  156.     End If
  157.     'If there is accumulation in this column...
  158.     If Accumulation > 0 Then
  159.         'Draw the accumulation...
  160.         Line (Column, Rows)-(Column, (Rows - Accumulation + 1)), SnowColor
  161.     End If
  163.  
  164. Sub SettleAccumulation (LeftAccumulation As Integer, Accumulation As Integer, RightAccumulation As Integer)
  165.     'If accumulation should settle left...
  166.     If ((Rnd * (Accumulation - LeftAccumulation)) > 2) Then
  167.         'Shift accumulation to the left
  168.         LeftAccumulation = LeftAccumulation + 1
  169.         Accumulation = Accumulation - 1
  170.         'If accumulation should settle right...
  171.     ElseIf ((Rnd * (Accumulation - RightAccumulation)) > 2) Then
  172.         'Shift accumulation to the right
  173.         RightAccumulation = RightAccumulation + 1
  174.         Accumulation = Accumulation - 1
  175.     End If
  177.  

2
Programs / Screensaver: Super Simple Snowfall (with accumulation)
« on: December 20, 2021, 08:57:56 pm »
Here is my own, simple snowfall program (with accumulation)! This was my first attempt at animation in QBasic. I heavily commented it, in case it helps others. I'm also very open to feedback!

Code: QB64: [Select]
  1. 'SNOWFALL.BAS
  2. '============
  3.  
  4. 'DESCRIPTION
  5. '-----------
  6. '   A holiday screensaver for QBasic.
  7.  
  8. 'AUTHOR
  9. '------
  10. '   Dustinian Camburides
  11.  
  12. 'PLATFORM
  13. '--------
  14. '   Written in QB64.
  15. '   But designed to be QBasic/QuickBasic compatible.
  16. '       Although, I haven't tested QBasic / QuickBasic compatability yet.
  17.  
  18. 'VERSION
  19. '-------
  20. '1.0, 2021-12-18: First working version.
  21. '1.1, 2021-12-19: I was excited to keep working!
  22. '   Added page flipping to reduce flicker!
  23. '   Added background snowflakes at a smaller speed and dimmer color!
  24. '   Set the formula to advance snowflakes to actually use the FALLSPEED constant.
  25. '   Also started the timer before calculating all the snowflakes to smooth out the animation.
  26.  
  27. 'PLANNED ENHANCEMENTS
  28. '--------------------
  29. 'Maybe next year I will add...
  30. '   - Actual, tested QBasic compatability (need to to a DosBox install and find a copy of QBasic).
  31. '   - A more complex data structure for snowflakes that can store both X and Y coordinates in a dynamic array of user-defined types... so it can support more than one snowflake per column... and mabe some drift back-and-forth in the X-axis.
  32.  
  33. 'HOLIDAY MESSAGE
  34. '---------------
  35. 'But for now, I'm happy that I have my first QB64 program that has animation. Happy Holidays!
  36.  
  37. 'SUBS
  38. Declare Sub CalculateSnowflakeColumn (SnowFlake As Integer, Accumulation As Integer, Rows As Integer, FallSpeed As Integer, Odds As Single)
  39. Declare Sub DrawSnowflakeColumn (Snowflake As Integer, Accumulation As Integer, Column As Integer, Rows As Integer, SnowColor As Integer)
  40.  
  41. 'CONSTANTS
  42. Const FALLSPEED = 1 'Snow falls this many pixels at a time.
  43. Const COLUMNS = 319 'The screen is 320 pixels across (0-319) in Screen 7.
  44. Const ROWS = 199 'The screen is 200 pixels tall (0-199) in Screen 7.
  45. Const DELAY = 0.04 'The number of seconds between snowflake recalculation / re-draw... QBasic can't detect less than 0.04 seconds...
  46. Const ODDS = 0.7 'The % chance a snowflake will be added to a column that doesn't have a snowflake... anything over 1% will results in "waves" of snowflakes.
  47.  
  48. 'VARIABLES
  49. Dim intSnowflakes(COLUMNS) As Integer 'Array that holds the current Y-coordinate for a snowflake in this column... this means there can only be one snowflake per column at any given time.
  50. Dim intBackgroundSnowflakes(COLUMNS) As Integer 'Same as above, but for the background.
  51. Dim intAccumulation(COLUMNS) As Integer 'Array that holds the current accumulated pixels of snow in this column.
  52. Dim intBackgroundAccumulation(COLUMNS) As Integer ' Same as above, but for the background.
  53. Dim intColumn As Integer 'The current column in the loop.
  54. Dim sngStart As Single 'The timer at the start of the delay loop.
  55. Dim intBackgroundFrame As Integer 'Used to track whether the current frame will move the background snow...
  56. Dim intFullColumns As Integer 'Used to track the number of columns that are full of snow...
  57.  
  58. 'INITIALIZE VARIABLES
  59. 'For each column...
  60. For intColumn = 0 To COLUMNS
  61.     'Set all snowflakes to -1, indicating there is no snowflake in this column.
  62.     intSnowflakes(intColumn) = -1
  63.     intBackgroundSnowflakes(intColumn) = -1
  64.     'Set all accumulation to 0, indicating there is no accumulation in this column.
  65.     intAccumulation(intColumn) = 0
  66.     intBackgroundAccumulation(intColumn) = 0
  67. Next intColumn
  68. intBackgroundFrame = 0
  70.  
  71. 'INITIALIZE SCREEN
  72. 'Set the screen to mode 7 with an active page (where the cls, pset, and line commands occur) of 0 and a visible page (that the user sees) of 1.
  73. Screen 7, , 0, 1
  74. Color 15, 0
  76.  
  77. 'PROGRAM
  78. 'While no key has been pressed...
  79. While InKey$ = "" And intFullColumns < COLUMNS
  80.     'Set the delay timer...
  81.     Timer On
  82.     sngStart = Timer
  83.     'Reset the number of full columns...
  84.     intFullColumns = 0
  85.     'Flip whether the background snow will move on or off...
  86.     intBackgroundFrame = Not intBackgroundFrame
  87.     'For each column... calculate the changes to the snowfall...
  88.     For intColumn = 0 To COLUMNS
  89.         'If this is a background frame...
  90.         If intBackgroundFrame Then
  91.             'Recalculate background snow...
  92.             Call CalculateSnowflakeColumn(intBackgroundSnowflakes(intColumn), intBackgroundAccumulation(intColumn), ROWS, FALLSPEED, ODDS)
  93.             'Ensure background accumulation keeps up with foreground accumulation to smooth out the accumulation...
  94.             If intAccumulation(intColumn) > intBackgroundAccumulation(intColumn) Then intBackgroundAccumulation(intColumn) = intAccumulation(intColumn)
  95.         End If
  96.         'Draw the background snow first...
  97.         Call DrawSnowflakeColumn(intBackgroundSnowflakes(intColumn), intBackgroundAccumulation(intColumn), intColumn, ROWS, 7)
  98.         'Recalculate the foreground snow...
  99.         Call CalculateSnowflakeColumn(intSnowflakes(intColumn), intAccumulation(intColumn), ROWS, FALLSPEED, ODDS)
  100.         'Draw the foreground snow next, on top of the background snow...
  101.         Call DrawSnowflakeColumn(intSnowflakes(intColumn), intAccumulation(intColumn), intColumn, ROWS, 15)
  102.         'Track whether or not this column is full of snow (program will terminate when all columns are full)...
  103.         If intAccumulation(intColumn) = ROWS Then intFullColumns = intFullColumns + 1
  104.     Next intColumn
  105.     'Copy the active page (where we just drew the snow) to the visible page...
  106.     PCopy 0, 1
  107.     'Clear the active page for the next frame...
  108.     Cls
  109.     'Wait for the delay to pass before starting over...
  110.     Do
  111.     Loop Until Timer > sngStart + DELAY
  112.     Timer Off
  115.  
  116. Sub CalculateSnowflakeColumn (Snowflake As Integer, Accumulation As Integer, Rows As Integer, FallSpeed As Integer, Odds As Single)
  117.     'If there is a snowflake in the column (i.e. any value > -1) then...
  118.     If Snowflake > -1 Then
  119.         'If the snowflake has not fallen to the accumulation...
  120.         If (Snowflake + FallSpeed) < (Rows - Accumulation) Then
  121.             'Advance the snowflake...
  122.             Snowflake = Snowflake + FallSpeed
  123.         Else
  124.             'Eliminate the flake...
  125.             Snowflake = -1
  126.             'Add to the accumulation...
  127.             Accumulation = Accumulation + 1
  128.         End If
  129.     Else
  130.         'If accumulation hasn't filled up the column...
  131.         If Accumulation < Rows Then
  132.             'Maybe add a flake...
  133.             If (Rnd * 100) < Odds Then
  134.                 Snowflake = 0
  135.             End If
  136.         End If
  137.     End If
  139.  
  140. Sub DrawSnowflakeColumn (Snowflake As Integer, Accumulation As Integer, Column As Integer, Rows As Integer, SnowColor As Integer)
  141.     'If there is a snowflake in this column...
  142.     If Snowflake > -1 Then
  143.         'Draw the snowflake...
  144.         PSet (Column, Snowflake), SnowColor
  145.     End If
  146.     'If there is accumulation in this column...
  147.     If Accumulation > 0 Then
  148.         'Draw the accumulation...
  149.         Line (Column, Rows)-(Column, (Rows - Accumulation + 1)), SnowColor
  150.     End If

Pages: [1]