Author Topic: B+'s Matrix Rain With World Map Backdrop  (Read 12028 times)

0 Members and 1 Guest are viewing this topic.

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
B+'s Matrix Rain With World Map Backdrop
« on: April 02, 2022, 03:17:31 pm »
Almost all of this code is from B+'s Matrix Rain 4. I tried to find the original post but one link didn't work anymore. Anyhow, for 2 days I've tried to add a world map as the backdrop to it and  finally succeeded using GET and PUT from the QB64 Wiki pages. I remembered that back in the 1990's I used to use XOR to make a background image with moving graphics over it. But instead of having to use XOR, DEST works pretty similar, with PUT and GET. Here is the code, photo, and the required world_map.jpg needed in the same folder as the code. I tried to section-off where I added my own code to this. Thank you B+!

Make sure and name this file, it won't work if you don't: Matrix Rain 4 mod by SierraKen.bas

Code: QB64: [Select]
  1. _Title "Matrix Rain 4 mod by SierraKen" 'B+ started 2019-03-16
  2. ' from Matrix Rain 2019-03-14
  3. ' or QB64 Purple Rain!
  4.  
  5. '>>> Save this file as: Matrix Rain 4 mod by SierraKen.bas, so the program can load the strings from it.  <<<
  6.  
  7. '2019-03-15 This will attempt to spin the drops as they fall
  8. '2019-03-16  Don't need no damn Character Set.DAT file!!!
  9. '2019-03-16 Ijust want to see the vertical code strings dangle and twist.
  10.  
  11. '2019-03-19 Matrix Rain 4
  12. ' + added randWeight to weight the random sizes chosen so many more on small side than large
  13. ' + draw letters on a transparent background so the background of the letter does not cover
  14. '   the drops behind it.
  15.  
  16. 'Mod by SierraKen - Added World Map as the backdrop. - April 2, 2022.
  17.  
  18. Const xmax = 1500
  19. Const ymax = 659
  20. Const nDrops = 500
  21. Type dropType
  22.     x As Single
  23.     sz As Single
  24.     curY As Integer
  25.     dxs As Single 'direction and change of spin some small fraction of 1, +-1/3, +-1/4, +-1/5...
  26.  
  27. 'SierraKen's World Map code with the array, GET, and DEST ---------------------------------------------
  28. Dim map As Long
  29.  
  30. map& = _LoadImage("world_map.jpg", 32)
  31. Screen map&
  32. wide& = _Width(map&): deep& = _Height(map&)
  33.  
  34. Dim Array(wide& * deep&) As Long
  35.  
  36. _Source map& 'REQUIRED to GET the proper image area!
  37. Get (0, 0)-(wide& - 1, deep& - 1), Array(0)
  38.  
  39.  
  40. '-------------------------------------------------------------------------------------------------------
  41.  
  42. 'Screen _NewImage(xmax, ymax, 32)
  43. _ScreenMove 80, 0 'for snap shot
  44. '_FULLSCREEN 'as screen saver
  45.  
  46. ReDim Shared fileStrings$(1000) 'container for these program lines that will be dangling
  47.  
  48. 'Changed this name. ----------------------------------------
  49. Open "Matrix Rain 4 mod by SierraKen.bas" For Input As #1
  50. '----------------------------------------------------------------
  51.     Line Input #1, fs$
  52.     If Len(LTrim$(fs$)) <> 0 Then 'less empty spaces
  53.         fileStrings$(i) = LTrim$(fs$)
  54.         i = i + 1
  55.     End If
  56. ReDim _Preserve fileStrings$(i - 1)
  57. ' check loading
  58. 'FOR i = 0 TO UBOUND(fileStrings$)
  59. '    PRINT i, fileStrings$(i)
  60. 'NEXT
  61. 'END
  62.  
  63. 'setup drops
  64. Dim Shared drop(nDrops) As dropType
  65. Dim Shared s$(nDrops)
  66.  
  67. For i = 0 To nDrops
  68.     newDrop i, 1
  69.  
  70. While _KeyDown(27) = 0
  71.     Cls
  72.     'SierraKen's PUT statement ----------------------------
  73.     Put (0, 0), Array(0), PSet , _RGB(0, 0, 0)
  74.     '------------------------------------------------------
  75.  
  76.     For i = 0 To nDrops
  77.         drawDrop (i)
  78.         drop(i).curY = drop(i).curY + 1
  79.         If drop(i).curY > Len(s$(i)) Then newDrop i, 0
  80.     Next
  81.     _Display
  82.     _Limit 25
  83.  
  84. Sub newDrop (i, start)
  85.     drop(i).x = Rnd * xmax 'set location
  86.     drop(i).sz = randWeight(.3, 5, 3) 'set size  weighted on small sizes
  87.     'length of text string can fit on screen
  88.     charLength = ymax \ (drop(i).sz * 16) + 1 'from size determine how many chars fit on screen
  89.     randLine = Int(Rnd * UBound(fileStrings$)) 'pick a random program line
  90.     s$(i) = Mid$(fileStrings$(randLine), 1, charLength) 'here is text string to dangle
  91.     While Len(s$(i)) < charLength
  92.         If randLine + 1 > UBound(fileStrings$) Then randLine = 0 Else randLine = randLine + 1
  93.         s$(i) = Mid$(s$(i) + " : " + fileStrings$(randLine), 1, charLength)
  94.     Wend
  95.     If start <> 0 Then drop(i).curY = Int(Rnd * (charLength)) + 1 Else drop(i).curY = 1 'flat and readable at curY
  96.     drop(i).dxs = 1 / (Int(Rnd * 7) + 3) 'change of spin rate +-1/3, +-1/4, ... +-1/9
  97.     If Rnd < .5 Then drop(i).dxs = -drop(i).dxs
  98.  
  99. Sub drawDrop (i)
  100.     For j = 1 To drop(i).curY
  101.         d = drop(i).curY - j
  102.         If d = 0 Then
  103.             c~& = _RGBA32(255, 100, 255, 225)
  104.         ElseIf d = 1 Then
  105.             c~& = _RGBA32(255, 50, 255, 205)
  106.         ElseIf d = 2 Then
  107.             c~& = _RGBA32(255, 25, 255, 180)
  108.         ElseIf d >= 3 Then
  109.             c~& = _RGBA32(255, 0, 255, 190 - d * 5)
  110.         End If
  111.         rot = 1: dir = -1
  112.         For k = 0 To d
  113.             rot = rot + drop(i).dxs * dir
  114.             If rot > 1 Then dir = -1 * dir: rot = 1 + drop(i).dxs * dir
  115.             If rot < -1 Then dir = dir * -1: rot = -1 + drop(i).dxs * dir
  116.         Next
  117.         drwChar Mid$(s$(i), j, 1), c~&, drop(i).x + 4 * drop(i).sz, drop(i).sz * 16 * (j - 1) + 8 * drop(i).sz, rot * drop(i).sz, drop(i).sz, 0
  118.     Next
  119.  
  120. Sub drwChar (char$, c As _Unsigned Long, midX, midY, xScale, yScale, Rotation) 'what ever the present color is set at
  121.     I& = _NewImage(8, 16, 32)
  122.     _Dest I&
  123.     Color c, _RGBA32(0, 0, 0, 0)
  124.     _PrintString (0, 0), char$
  125.     _Dest 0
  126.     RotoZoom2 midX, midY, I&, xScale, yScale, Rotation
  127.     _FreeImage I&
  128.  
  129. Sub RotoZoom2 (X As Long, Y As Long, Image As Long, xScale As Single, yScale As Single, Rotation As Single)
  130.     Dim px(3) As Single: Dim py(3) As Single
  131.     W& = _Width(Image&): H& = _Height(Image&)
  132.     px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
  133.     px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
  134.     sinr! = Sin(-Rotation): cosr! = Cos(-Rotation)
  135.     For i& = 0 To 3
  136.         x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + Y
  137.         px(i&) = x2&: py(i&) = y2&
  138.     Next
  139.     _MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
  140.     _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
  141.  
  142. Function randWeight (manyValue, fewValue, power)
  143.     randWeight = manyValue + Rnd ^ power * (fewValue - manyValue)
  144.  
world_map.jpg
* world_map.jpg (Filesize: 109.01 KB, Dimensions: 1500x659, Views: 305)
Matrix Rain 4 mod by SierraKen.jpg
* Matrix Rain 4 mod by SierraKen.jpg (Filesize: 580.22 KB, Dimensions: 1496x685, Views: 310)
« Last Edit: April 02, 2022, 03:25:35 pm by SierraKen »

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: B+'s Matrix Rain With World Map Backdrop
« Reply #1 on: April 02, 2022, 04:27:33 pm »
Here is a green version. I like it better myself because it's easier on the eyes with the white map background.
I'll add the map file also again.
Make sure and name this also: Matrix Rain 4 mod by SierraKen.bas

Code: QB64: [Select]
  1. _Title "Matrix Rain 4 mod by SierraKen" 'B+ started 2019-03-16
  2. ' from Matrix Rain 2019-03-14
  3. ' or QB64 Purple Rain!
  4.  
  5. '>>> Save this file as: Matrix Rain 4 mod by SierraKen.bas, so the program can load the strings from it.  <<<
  6.  
  7. '2019-03-15 This will attempt to spin the drops as they fall
  8. '2019-03-16  Don't need no damn Character Set.DAT file!!!
  9. '2019-03-16 Ijust want to see the vertical code strings dangle and twist.
  10.  
  11. '2019-03-19 Matrix Rain 4
  12. ' + added randWeight to weight the random sizes chosen so many more on small side than large
  13. ' + draw letters on a transparent background so the background of the letter does not cover
  14. '   the drops behind it.
  15.  
  16. 'Mod by SierraKen - Added World Map as the backdrop. - April 2, 2022.
  17.  
  18. Const xmax = 1500
  19. Const ymax = 659
  20. Const nDrops = 500
  21. Type dropType
  22.     x As Single
  23.     sz As Single
  24.     curY As Integer
  25.     dxs As Single 'direction and change of spin some small fraction of 1, +-1/3, +-1/4, +-1/5...
  26.  
  27. 'SierraKen's World Map code with the array, GET, and DEST ---------------------------------------------
  28. Dim map As Long
  29.  
  30. map& = _LoadImage("world_map.jpg", 32)
  31. Screen map&
  32. wide& = _Width(map&): deep& = _Height(map&)
  33.  
  34. Dim Array(wide& * deep&) As Long
  35.  
  36. _Source map& 'REQUIRED to GET the proper image area!
  37. Get (0, 0)-(wide& - 1, deep& - 1), Array(0)
  38.  
  39.  
  40. '-------------------------------------------------------------------------------------------------------
  41.  
  42. 'Screen _NewImage(xmax, ymax, 32)
  43. _ScreenMove 80, 0 'for snap shot
  44. '_FULLSCREEN 'as screen saver
  45.  
  46. ReDim Shared fileStrings$(1000) 'container for these program lines that will be dangling
  47. Open "Matrix Rain 4 mod by SierraKen.bas" For Input As #1
  48.     Line Input #1, fs$
  49.     If Len(LTrim$(fs$)) <> 0 Then 'less empty spaces
  50.         fileStrings$(i) = LTrim$(fs$)
  51.         i = i + 1
  52.     End If
  53. ReDim _Preserve fileStrings$(i - 1)
  54. ' check loading
  55. 'FOR i = 0 TO UBOUND(fileStrings$)
  56. '    PRINT i, fileStrings$(i)
  57. 'NEXT
  58. 'END
  59.  
  60. 'setup drops
  61. Dim Shared drop(nDrops) As dropType
  62. Dim Shared s$(nDrops)
  63.  
  64. For i = 0 To nDrops
  65.     newDrop i, 1
  66.  
  67. While _KeyDown(27) = 0
  68.     Cls
  69.     'SierraKen's PUT statement ----------------------------
  70.     Put (0, 0), Array(0), PSet , _RGB(0, 0, 0)
  71.     '------------------------------------------------------
  72.  
  73.     For i = 0 To nDrops
  74.         drawDrop (i)
  75.         drop(i).curY = drop(i).curY + 1
  76.         If drop(i).curY > Len(s$(i)) Then newDrop i, 0
  77.     Next
  78.     _Display
  79.     _Limit 25
  80.  
  81. Sub newDrop (i, start)
  82.     drop(i).x = Rnd * xmax 'set location
  83.     drop(i).sz = randWeight(.3, 5, 3) 'set size  weighted on small sizes
  84.     'length of text string can fit on screen
  85.     charLength = ymax \ (drop(i).sz * 16) + 1 'from size determine how many chars fit on screen
  86.     randLine = Int(Rnd * UBound(fileStrings$)) 'pick a random program line
  87.     s$(i) = Mid$(fileStrings$(randLine), 1, charLength) 'here is text string to dangle
  88.     While Len(s$(i)) < charLength
  89.         If randLine + 1 > UBound(fileStrings$) Then randLine = 0 Else randLine = randLine + 1
  90.         s$(i) = Mid$(s$(i) + " : " + fileStrings$(randLine), 1, charLength)
  91.     Wend
  92.     If start <> 0 Then drop(i).curY = Int(Rnd * (charLength)) + 1 Else drop(i).curY = 1 'flat and readable at curY
  93.     drop(i).dxs = 1 / (Int(Rnd * 7) + 3) 'change of spin rate +-1/3, +-1/4, ... +-1/9
  94.     If Rnd < .5 Then drop(i).dxs = -drop(i).dxs
  95.  
  96. Sub drawDrop (i)
  97.     For j = 1 To drop(i).curY
  98.         d = drop(i).curY - j
  99.         If d = 0 Then
  100.             c~& = _RGBA32(0, 255, 0, 225)
  101.         ElseIf d = 1 Then
  102.             c~& = _RGBA32(50, 255, 0, 205)
  103.         ElseIf d = 2 Then
  104.             c~& = _RGBA32(25, 255, 0, 180)
  105.         ElseIf d >= 3 Then
  106.             c~& = _RGBA32(0, 255, 0, 190 - d * 5)
  107.         End If
  108.         rot = 1: dir = -1
  109.         For k = 0 To d
  110.             rot = rot + drop(i).dxs * dir
  111.             If rot > 1 Then dir = -1 * dir: rot = 1 + drop(i).dxs * dir
  112.             If rot < -1 Then dir = dir * -1: rot = -1 + drop(i).dxs * dir
  113.         Next
  114.         drwChar Mid$(s$(i), j, 1), c~&, drop(i).x + 4 * drop(i).sz, drop(i).sz * 16 * (j - 1) + 8 * drop(i).sz, rot * drop(i).sz, drop(i).sz, 0
  115.     Next
  116.  
  117. Sub drwChar (char$, c As _Unsigned Long, midX, midY, xScale, yScale, Rotation) 'what ever the present color is set at
  118.     I& = _NewImage(8, 16, 32)
  119.     _Dest I&
  120.     Color c, _RGBA32(0, 0, 0, 0)
  121.     _PrintString (0, 0), char$
  122.     _Dest 0
  123.     RotoZoom2 midX, midY, I&, xScale, yScale, Rotation
  124.     _FreeImage I&
  125.  
  126. Sub RotoZoom2 (X As Long, Y As Long, Image As Long, xScale As Single, yScale As Single, Rotation As Single)
  127.     Dim px(3) As Single: Dim py(3) As Single
  128.     W& = _Width(Image&): H& = _Height(Image&)
  129.     px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
  130.     px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
  131.     sinr! = Sin(-Rotation): cosr! = Cos(-Rotation)
  132.     For i& = 0 To 3
  133.         x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + Y
  134.         px(i&) = x2&: py(i&) = y2&
  135.     Next
  136.     _MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
  137.     _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
  138.  
  139. Function randWeight (manyValue, fewValue, power)
  140.     randWeight = manyValue + Rnd ^ power * (fewValue - manyValue)
  141.  
  142.  

world_map.jpg
* world_map.jpg (Filesize: 109.01 KB, Dimensions: 1500x659, Views: 301)
Matrix Rain 4 mod by SierraKen 2.jpg
* Matrix Rain 4 mod by SierraKen 2.jpg (Filesize: 578.86 KB, Dimensions: 1503x683, Views: 305)

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: B+'s Matrix Rain With World Map Backdrop
« Reply #2 on: April 02, 2022, 04:30:22 pm »
Interesting background Ken :)

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: B+'s Matrix Rain With World Map Backdrop
« Reply #3 on: April 02, 2022, 04:49:32 pm »
Here's an even BETTER version! I inverted the colors to the world map.
B+, I finally figured out why you load the file from within the program, I had no idea that the symbols, letters, and numbers all come from THIS program! LOL Awesome!

Make sure and name it the same as before: Matrix Rain 4 mod by SierraKen.bas

I added a 2 on the world_map.jpg so you can keep both.

Code: QB64: [Select]
  1. _Title "Matrix Rain 4 mod by SierraKen" 'B+ started 2019-03-16
  2. ' from Matrix Rain 2019-03-14
  3. ' or QB64 Purple Rain!
  4.  
  5. '>>> Save this file as: Matrix Rain 4 mod by SierraKen.bas, so the program can load the strings from it.  <<<
  6.  
  7. '2019-03-15 This will attempt to spin the drops as they fall
  8. '2019-03-16  Don't need no damn Character Set.DAT file!!!
  9. '2019-03-16 Ijust want to see the vertical code strings dangle and twist.
  10.  
  11. '2019-03-19 Matrix Rain 4
  12. ' + added randWeight to weight the random sizes chosen so many more on small side than large
  13. ' + draw letters on a transparent background so the background of the letter does not cover
  14. '   the drops behind it.
  15.  
  16. 'Mod by SierraKen - Added World Map as the backdrop. - April 2, 2022.
  17.  
  18. Const xmax = 1500
  19. Const ymax = 659
  20. Const nDrops = 500
  21. Type dropType
  22.     x As Single
  23.     sz As Single
  24.     curY As Integer
  25.     dxs As Single 'direction and change of spin some small fraction of 1, +-1/3, +-1/4, +-1/5...
  26.  
  27. 'SierraKen's World Map code with the array, GET, and DEST ---------------------------------------------
  28. Dim map As Long
  29.  
  30. map& = _LoadImage("world_map2.jpg", 32)
  31. Screen map&
  32. wide& = _Width(map&): deep& = _Height(map&)
  33.  
  34. Dim Array(wide& * deep&) As Long
  35.  
  36. _Source map& 'REQUIRED to GET the proper image area!
  37. Get (0, 0)-(wide& - 1, deep& - 1), Array(0)
  38.  
  39.  
  40. '-------------------------------------------------------------------------------------------------------
  41.  
  42. 'Screen _NewImage(xmax, ymax, 32)
  43. _ScreenMove 80, 0 'for snap shot
  44. '_FULLSCREEN 'as screen saver
  45.  
  46. ReDim Shared fileStrings$(1000) 'container for these program lines that will be dangling
  47. Open "Matrix Rain 4 mod by SierraKen.bas" For Input As #1
  48.     Line Input #1, fs$
  49.     If Len(LTrim$(fs$)) <> 0 Then 'less empty spaces
  50.         fileStrings$(i) = LTrim$(fs$)
  51.         i = i + 1
  52.     End If
  53. ReDim _Preserve fileStrings$(i - 1)
  54. ' check loading
  55. 'FOR i = 0 TO UBOUND(fileStrings$)
  56. '    PRINT i, fileStrings$(i)
  57. 'NEXT
  58. 'END
  59.  
  60. 'setup drops
  61. Dim Shared drop(nDrops) As dropType
  62. Dim Shared s$(nDrops)
  63.  
  64. For i = 0 To nDrops
  65.     newDrop i, 1
  66.  
  67. While _KeyDown(27) = 0
  68.     Cls
  69.     'SierraKen's PUT statement ----------------------------
  70.     Put (0, 0), Array(0), PSet , _RGB(0, 0, 0)
  71.     '------------------------------------------------------
  72.  
  73.     For i = 0 To nDrops
  74.         drawDrop (i)
  75.         drop(i).curY = drop(i).curY + 1
  76.         If drop(i).curY > Len(s$(i)) Then newDrop i, 0
  77.     Next
  78.     _Display
  79.     _Limit 25
  80.  
  81. Sub newDrop (i, start)
  82.     drop(i).x = Rnd * xmax 'set location
  83.     drop(i).sz = randWeight(.3, 5, 3) 'set size  weighted on small sizes
  84.     'length of text string can fit on screen
  85.     charLength = ymax \ (drop(i).sz * 16) + 1 'from size determine how many chars fit on screen
  86.     randLine = Int(Rnd * UBound(fileStrings$)) 'pick a random program line
  87.     s$(i) = Mid$(fileStrings$(randLine), 1, charLength) 'here is text string to dangle
  88.     While Len(s$(i)) < charLength
  89.         If randLine + 1 > UBound(fileStrings$) Then randLine = 0 Else randLine = randLine + 1
  90.         s$(i) = Mid$(s$(i) + " : " + fileStrings$(randLine), 1, charLength)
  91.     Wend
  92.     If start <> 0 Then drop(i).curY = Int(Rnd * (charLength)) + 1 Else drop(i).curY = 1 'flat and readable at curY
  93.     drop(i).dxs = 1 / (Int(Rnd * 7) + 3) 'change of spin rate +-1/3, +-1/4, ... +-1/9
  94.     If Rnd < .5 Then drop(i).dxs = -drop(i).dxs
  95.  
  96. Sub drawDrop (i)
  97.     For j = 1 To drop(i).curY
  98.         d = drop(i).curY - j
  99.         If d = 0 Then
  100.             c~& = _RGBA32(0, 255, 0, 225)
  101.         ElseIf d = 1 Then
  102.             c~& = _RGBA32(50, 255, 0, 205)
  103.         ElseIf d = 2 Then
  104.             c~& = _RGBA32(25, 255, 0, 180)
  105.         ElseIf d >= 3 Then
  106.             c~& = _RGBA32(0, 255, 0, 190 - d * 5)
  107.         End If
  108.         rot = 1: dir = -1
  109.         For k = 0 To d
  110.             rot = rot + drop(i).dxs * dir
  111.             If rot > 1 Then dir = -1 * dir: rot = 1 + drop(i).dxs * dir
  112.             If rot < -1 Then dir = dir * -1: rot = -1 + drop(i).dxs * dir
  113.         Next
  114.         drwChar Mid$(s$(i), j, 1), c~&, drop(i).x + 4 * drop(i).sz, drop(i).sz * 16 * (j - 1) + 8 * drop(i).sz, rot * drop(i).sz, drop(i).sz, 0
  115.     Next
  116.  
  117. Sub drwChar (char$, c As _Unsigned Long, midX, midY, xScale, yScale, Rotation) 'what ever the present color is set at
  118.     I& = _NewImage(8, 16, 32)
  119.     _Dest I&
  120.     Color c, _RGBA32(0, 0, 0, 0)
  121.     _PrintString (0, 0), char$
  122.     _Dest 0
  123.     RotoZoom2 midX, midY, I&, xScale, yScale, Rotation
  124.     _FreeImage I&
  125.  
  126. Sub RotoZoom2 (X As Long, Y As Long, Image As Long, xScale As Single, yScale As Single, Rotation As Single)
  127.     Dim px(3) As Single: Dim py(3) As Single
  128.     W& = _Width(Image&): H& = _Height(Image&)
  129.     px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
  130.     px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
  131.     sinr! = Sin(-Rotation): cosr! = Cos(-Rotation)
  132.     For i& = 0 To 3
  133.         x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + Y
  134.         px(i&) = x2&: py(i&) = y2&
  135.     Next
  136.     _MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
  137.     _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
  138.  
  139. Function randWeight (manyValue, fewValue, power)
  140.     randWeight = manyValue + Rnd ^ power * (fewValue - manyValue)
  141.  
world_map2.jpg
* world_map2.jpg (Filesize: 108.68 KB, Dimensions: 1500x659, Views: 303)
Matrix Rain 4 mod by SierraKen 3.jpg
* Matrix Rain 4 mod by SierraKen 3.jpg (Filesize: 519.1 KB, Dimensions: 1501x684, Views: 311)

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: B+'s Matrix Rain With World Map Backdrop
« Reply #4 on: April 02, 2022, 04:57:51 pm »
Yeah green and black look pretty good.

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: B+'s Matrix Rain With World Map Backdrop
« Reply #5 on: April 02, 2022, 05:04:54 pm »
You know, it kinda resembles the world, digitally connected through the Internet and non-stop traffic. :)

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: B+'s Matrix Rain With World Map Backdrop
« Reply #6 on: April 05, 2022, 01:16:14 pm »
A couple of tiny changes that speed up rain ie screen width at or below 1024 definitely need in this app (something Terry discovered some time ago). Full screen option is cool but map proportions are off.

Anyway I think the rain falls faster now, maybe it just having less screen to cover? :
Code: QB64: [Select]
  1. _Title "Matrix Rain 4 mod by SierraKen mod b+" 'B+ started 2019-03-16
  2. ' Ken added great background and changed rain color
  3. ' 2022-04-05 b+ adjusted screen for x width 1024 for speedier graphics
  4. ' from Matrix Rain 2019-03-14
  5. ' or QB64 Purple Rain!
  6.  
  7. '>>> Save this file as: Matrix Rain 4 mod by SierraKen.bas, so the program can load the strings from it.  <<<
  8.  
  9. '2019-03-15 This will attempt to spin the drops as they fall
  10. '2019-03-16  Don't need no damn Character Set.DAT file!!!
  11. '2019-03-16 Ijust want to see the vertical code strings dangle and twist.
  12.  
  13. '2019-03-19 Matrix Rain 4
  14. ' + added randWeight to weight the random sizes chosen so many more on small side than large
  15. ' + draw letters on a transparent background so the background of the letter does not cover
  16. '   the drops behind it.
  17.  
  18. 'Mod by SierraKen - Added World Map as the backdrop. - April 2, 2022.
  19.  
  20. Const xmax = 1024
  21. Const ymax = 450
  22. Const nDrops = 500
  23. Type dropType
  24.     x As Single
  25.     sz As Single
  26.     curY As Integer
  27.     dxs As Single 'direction and change of spin some small fraction of 1, +-1/3, +-1/4, +-1/5...
  28.  
  29. 'SierraKen's World Map code with the array, GET, and DEST ---------------------------------------------
  30. Dim map As Long
  31. map& = _LoadImage("world_map2.jpg", 32)
  32.  
  33. Screen _NewImage(xmax, ymax, 32)
  34. _ScreenMove 80, 0 'for snap shot
  35. '_FullScreen '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< optional full screen but out of proportion with map
  36.  
  37. ReDim Shared fileStrings$(1000) 'container for these program lines that will be dangling
  38. Open "Matrix Rain 4 mod by SierraKen.bas" For Input As #1
  39.     Line Input #1, fs$
  40.     If Len(LTrim$(fs$)) <> 0 Then 'less empty spaces
  41.         fileStrings$(i) = LTrim$(fs$)
  42.         i = i + 1
  43.     End If
  44. ReDim _Preserve fileStrings$(i - 1)
  45. ' check loading
  46. 'FOR i = 0 TO UBOUND(fileStrings$)
  47. '    PRINT i, fileStrings$(i)
  48. 'NEXT
  49. 'END
  50.  
  51. 'setup drops
  52. Dim Shared drop(nDrops) As dropType
  53. Dim Shared s$(nDrops)
  54.  
  55. For i = 0 To nDrops
  56.     newDrop i, 1
  57.  
  58. While _KeyDown(27) = 0
  59.     Cls
  60.     'SierraKen's PUT statement ----------------------------
  61.     _PutImage , map&, 0
  62.     '------------------------------------------------------
  63.  
  64.     For i = 0 To nDrops
  65.         drawDrop (i)
  66.         drop(i).curY = drop(i).curY + 1
  67.         If drop(i).curY > Len(s$(i)) Then newDrop i, 0
  68.     Next
  69.     _Display
  70.     _Limit 25
  71.  
  72. Sub newDrop (i, start)
  73.     drop(i).x = Rnd * xmax 'set location
  74.     drop(i).sz = randWeight(.3, 5, 3) 'set size  weighted on small sizes
  75.     'length of text string can fit on screen
  76.     charLength = ymax \ (drop(i).sz * 16) + 1 'from size determine how many chars fit on screen
  77.     randLine = Int(Rnd * UBound(fileStrings$)) 'pick a random program line
  78.     s$(i) = Mid$(fileStrings$(randLine), 1, charLength) 'here is text string to dangle
  79.     While Len(s$(i)) < charLength
  80.         If randLine + 1 > UBound(fileStrings$) Then randLine = 0 Else randLine = randLine + 1
  81.         s$(i) = Mid$(s$(i) + " : " + fileStrings$(randLine), 1, charLength)
  82.     Wend
  83.     If start <> 0 Then drop(i).curY = Int(Rnd * (charLength)) + 1 Else drop(i).curY = 1 'flat and readable at curY
  84.     drop(i).dxs = 1 / (Int(Rnd * 7) + 3) 'change of spin rate +-1/3, +-1/4, ... +-1/9
  85.     If Rnd < .5 Then drop(i).dxs = -drop(i).dxs
  86.  
  87. Sub drawDrop (i)
  88.     For j = 1 To drop(i).curY
  89.         d = drop(i).curY - j
  90.         If d = 0 Then
  91.             c~& = _RGBA32(0, 255, 0, 225)
  92.         ElseIf d = 1 Then
  93.             c~& = _RGBA32(50, 255, 0, 205)
  94.         ElseIf d = 2 Then
  95.             c~& = _RGBA32(25, 255, 0, 180)
  96.         ElseIf d >= 3 Then
  97.             c~& = _RGBA32(0, 255, 0, 190 - d * 5)
  98.         End If
  99.         rot = 1: dir = -1
  100.         For k = 0 To d
  101.             rot = rot + drop(i).dxs * dir
  102.             If rot > 1 Then dir = -1 * dir: rot = 1 + drop(i).dxs * dir
  103.             If rot < -1 Then dir = dir * -1: rot = -1 + drop(i).dxs * dir
  104.         Next
  105.         drwChar Mid$(s$(i), j, 1), c~&, drop(i).x + 4 * drop(i).sz, drop(i).sz * 16 * (j - 1) + 8 * drop(i).sz, rot * drop(i).sz, drop(i).sz, 0
  106.     Next
  107.  
  108. Sub drwChar (char$, c As _Unsigned Long, midX, midY, xScale, yScale, Rotation) 'what ever the present color is set at
  109.     I& = _NewImage(8, 16, 32)
  110.     _Dest I&
  111.     Color c, _RGBA32(0, 0, 0, 0)
  112.     _PrintString (0, 0), char$
  113.     _Dest 0
  114.     RotoZoom2 midX, midY, I&, xScale, yScale, Rotation
  115.     _FreeImage I&
  116.  
  117. Sub RotoZoom2 (X As Long, Y As Long, Image As Long, xScale As Single, yScale As Single, Rotation As Single)
  118.     Dim px(3) As Single: Dim py(3) As Single
  119.     W& = _Width(Image&): H& = _Height(Image&)
  120.     px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
  121.     px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
  122.     sinr! = Sin(-Rotation): cosr! = Cos(-Rotation)
  123.     For i& = 0 To 3
  124.         x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + Y
  125.         px(i&) = x2&: py(i&) = y2&
  126.     Next
  127.     _MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
  128.     _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
  129.  
  130. Function randWeight (manyValue, fewValue, power)
  131.     randWeight = manyValue + Rnd ^ power * (fewValue - manyValue)
  132.  
  133.  
  134.  


Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: B+'s Matrix Rain With World Map Backdrop
« Reply #7 on: April 05, 2022, 01:25:49 pm »
Wow that is a lot faster. Probably has something to do with the graphics card memory.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: B+'s Matrix Rain With World Map Backdrop
« Reply #8 on: April 05, 2022, 02:19:56 pm »
If you're wanting to speed it up, here's what I'd suggest:

Code: QB64: [Select]
  1. Sub drwChar (char$, c As _Unsigned Long, midX, midY, xScale, yScale, Rotation) 'what ever the present color is set at
  2.     I& = _NewImage(8, 16, 32)
  3.     _Dest I&
  4.     Color c, _RGBA32(0, 0, 0, 0)
  5.     _PrintString (0, 0), char$
  6.     _Dest 0
  7.     RotoZoom2 midX, midY, I&, xScale, yScale, Rotation
  8.     _FreeImage I&

This routine here is very unoptimized and inefficient.  You're drawing each letter every time you need it and then freeing the image that you drew it on over and over repeatedly.  I can see why you're going this route -- you've got multiple colors to deal with -- but here's my suggestion:

Make a single sprite array once for processing and keep it for the length of the program's running.

STATIC I(3,255) AS LONG
IF I(0,0) = 0 THEN
    FOR colors = 0 to 3 '4 rows of letters for the 4 colors possible in the program
        FOR characters = 0 to 255 '256 columns for the letters.
            I(colors, characters) = _newimage(8, 16, 32)
... stuff
END IF

Now, instead of passing a char$, you'd be passing the ASCII value of your character, and instead of passing c, you'd simply be passing d.  The whole IF d = 0 ELSEIF , ELSEIF, ELSEIF, ELSE block could be removed, and you'd get rid of the slow Mid$(s$(i), j, 1) and replace it with a simple ASC(s$(i),j).  There'd be no redrawing of each letter over and over, and no need to constantly allocate and free memory in the program. 

I haven't tried it, but from what I can tell looking over the code, I imagine that your bottleneck in performance is in the above routine, and I think this could fix it.  ;)

https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: B+'s Matrix Rain With World Map Backdrop
« Reply #9 on: April 05, 2022, 02:37:09 pm »
Thanks Steve, I'll check it out.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: B+'s Matrix Rain With World Map Backdrop
« Reply #10 on: April 05, 2022, 02:51:01 pm »
Trying it, I'm getting about twice the FPS on my machine:

Code: QB64: [Select]
  1. _Title "Matrix Rain 4 mod by SierraKen mod b+" 'B+ started 2019-03-16
  2. ' Ken added great background and changed rain color
  3. ' 2022-04-05 b+ adjusted screen for x width 1024 for speedier graphics
  4. ' from Matrix Rain 2019-03-14
  5. ' or QB64 Purple Rain!
  6.  
  7. '>>> Save this file as: Matrix Rain 4 mod by SierraKen.bas, so the program can load the strings from it.  <<<
  8.  
  9. '2019-03-15 This will attempt to spin the drops as they fall
  10. '2019-03-16  Don't need no damn Character Set.DAT file!!!
  11. '2019-03-16 Ijust want to see the vertical code strings dangle and twist.
  12.  
  13. '2019-03-19 Matrix Rain 4
  14. ' + added randWeight to weight the random sizes chosen so many more on small side than large
  15. ' + draw letters on a transparent background so the background of the letter does not cover
  16. '   the drops behind it.
  17.  
  18. 'Mod by SierraKen - Added World Map as the backdrop. - April 2, 2022.
  19.  
  20. Const xmax = 1024
  21. Const ymax = 450
  22. Const nDrops = 500
  23. Type dropType
  24.     x As Single
  25.     sz As Single
  26.     curY As Integer
  27.     dxs As Single 'direction and change of spin some small fraction of 1, +-1/3, +-1/4, +-1/5...
  28.  
  29. 'SierraKen's World Map code with the array, GET, and DEST ---------------------------------------------
  30. Dim map As Long
  31. tmap& = _LoadImage("world_map2.jpg", 32)
  32. map& = _CopyImage(tmap&, 33)
  33.  
  34. WorkScreen = _NewImage(xmax, ymax, 32)
  35. Screen WorkScreen
  36. _ScreenMove 80, 0 'for snap shot
  37. '_FullScreen '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< optional full screen but out of proportion with map
  38.  
  39. ReDim Shared fileStrings$(1000) 'container for these program lines that will be dangling
  40. Open "Matrix Rain 4 mod by SierraKen.bas" For Input As #1
  41.     Line Input #1, fs$
  42.     If Len(LTrim$(fs$)) <> 0 Then 'less empty spaces
  43.         fileStrings$(i) = LTrim$(fs$)
  44.         i = i + 1
  45.     End If
  46. ReDim _Preserve fileStrings$(i - 1)
  47. ' check loading
  48. 'FOR i = 0 TO UBOUND(fileStrings$)
  49. '    PRINT i, fileStrings$(i)
  50. 'NEXT
  51. 'END
  52.  
  53. 'setup drops
  54. Dim Shared drop(nDrops) As dropType
  55. Dim Shared s$(nDrops)
  56.  
  57. For i = 0 To nDrops
  58.     newDrop i, 1
  59. While _KeyDown(27) = 0
  60.     Cls , 0
  61.     'SierraKen's PUT statement ----------------------------
  62.     _PutImage , map&
  63.     '------------------------------------------------------
  64.  
  65.     For i = 0 To nDrops
  66.         drawDrop (i)
  67.         drop(i).curY = drop(i).curY + 1
  68.         If drop(i).curY > Len(s$(i)) Then newDrop i, 0
  69.     Next
  70.     _Display
  71.     fps = fps + 1
  72.     If Timer > FPStimer Then _Title "FPS:" + Str$(fps): fps = 0: FPStimer = Timer + 1
  73.     '_Limit 25
  74.  
  75. Sub newDrop (i, start)
  76.     drop(i).x = Rnd * xmax 'set location
  77.     drop(i).sz = randWeight(.3, 5, 3) 'set size  weighted on small sizes
  78.     'length of text string can fit on screen
  79.     charLength = ymax \ (drop(i).sz * 16) + 1 'from size determine how many chars fit on screen
  80.     randLine = Int(Rnd * UBound(fileStrings$)) 'pick a random program line
  81.     s$(i) = Mid$(fileStrings$(randLine), 1, charLength) 'here is text string to dangle
  82.     While Len(s$(i)) < charLength
  83.         If randLine + 1 > UBound(fileStrings$) Then randLine = 0 Else randLine = randLine + 1
  84.         s$(i) = Mid$(s$(i) + " : " + fileStrings$(randLine), 1, charLength)
  85.     Wend
  86.     If start <> 0 Then drop(i).curY = Int(Rnd * (charLength)) + 1 Else drop(i).curY = 1 'flat and readable at curY
  87.     drop(i).dxs = 1 / (Int(Rnd * 7) + 3) 'change of spin rate +-1/3, +-1/4, ... +-1/9
  88.     If Rnd < .5 Then drop(i).dxs = -drop(i).dxs
  89.  
  90. Sub drawDrop (i)
  91.     For j = 1 To drop(i).curY
  92.         d = drop(i).curY - j
  93.         rot = 1: dir = -1
  94.         For k = 0 To d
  95.             rot = rot + drop(i).dxs * dir
  96.             If rot > 1 Then
  97.                 dir = -1 * dir: rot = 1 + drop(i).dxs * dir
  98.             ElseIf rot < -1 Then
  99.                 dir = dir * -1: rot = -1 + drop(i).dxs * dir
  100.             End If
  101.         Next
  102.         drwChar Asc(s$(i), j), d, drop(i).x + 4 * drop(i).sz, drop(i).sz * 16 * (j - 1) + 8 * drop(i).sz, rot * drop(i).sz, drop(i).sz, 0
  103.     Next
  104.  
  105. Sub drwChar (char, c As _Unsigned Long, midX, midY, xScale, yScale, Rotation) 'what ever the present color is set at
  106.     Static I(18, 255) As Long
  107.     If I(0, 0) = 0 Then
  108.         For d = 0 To 18 '18 rows of letters for all the colors possible in the program
  109.             If d = 0 Then
  110.                 ColorSet& = _RGBA32(0, 255, 0, 225)
  111.             ElseIf d = 1 Then
  112.                 ColorSet& = _RGBA32(50, 255, 0, 205)
  113.             ElseIf d = 2 Then
  114.                 ColorSet& = _RGBA32(25, 255, 0, 180)
  115.             ElseIf d >= 3 And d <= 18 Then
  116.                 ColorSet& = _RGBA32(0, 255, 0, 190 - d * 5)
  117.             Else 'beyond this value, the 190 - d * 5 becomes a negative value?
  118.                 'For values beyond this, I'm just going to exit the sub and whistle innocently, uncertain what they're supposed to be....  *whistle*
  119.             End If
  120.             For ch = 0 To 255 '256 columns for the letters.
  121.                 I(d, ch) = _NewImage(8, 16, 32)
  122.                 _Dest I(d, ch)
  123.                 Color ColorSet&, 0
  124.                 _PrintString (0, 0), Chr$(ch)
  125.             Next
  126.         Next
  127.         _Dest 0
  128.     End If
  129.     If c > 18 Then Exit Sub ' *whistle*  *whistele*
  130.     RotoZoom2 midX, midY, I(c, char), xScale, yScale, Rotation
  131.  
  132. Sub RotoZoom2 (X As Long, Y As Long, Image As Long, xScale As Single, yScale As Single, Rotation As Single)
  133.     Dim px(3) As Single: Dim py(3) As Single
  134.     W& = _Width(Image&): H& = _Height(Image&)
  135.     px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
  136.     px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
  137.     sinr! = Sin(-Rotation): cosr! = Cos(-Rotation)
  138.     For i& = 0 To 3
  139.         x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + Y
  140.         px(i&) = x2&: py(i&) = y2&
  141.     Next
  142.     _MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
  143.     _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
  144.  
  145. Function randWeight (manyValue, fewValue, power)
  146.     randWeight = manyValue + Rnd ^ power * (fewValue - manyValue)
  147.  

You'll have to read my comments though...  *whistles innocently*.   Your math leaves me a little confuzzled at one point in the code, so ..  *whistles innocently*...
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: B+'s Matrix Rain With World Map Backdrop
« Reply #11 on: April 05, 2022, 03:16:25 pm »
Swapped everything over to hardware images, and suprisingly, it makes very little difference compared to what I have above.  Maybe a 10-20% increase in this case, and I wouldn't swear to that.

Code: QB64: [Select]
  1. _Title "Matrix Rain 4 mod by SierraKen mod b+" 'B+ started 2019-03-16
  2. ' Ken added great background and changed rain color
  3. ' 2022-04-05 b+ adjusted screen for x width 1024 for speedier graphics
  4. ' from Matrix Rain 2019-03-14
  5. ' or QB64 Purple Rain!
  6.  
  7. '>>> Save this file as: Matrix Rain 4 mod by SierraKen.bas, so the program can load the strings from it.  <<<
  8.  
  9. '2019-03-15 This will attempt to spin the drops as they fall
  10. '2019-03-16  Don't need no damn Character Set.DAT file!!!
  11. '2019-03-16 Ijust want to see the vertical code strings dangle and twist.
  12.  
  13. '2019-03-19 Matrix Rain 4
  14. ' + added randWeight to weight the random sizes chosen so many more on small side than large
  15. ' + draw letters on a transparent background so the background of the letter does not cover
  16. '   the drops behind it.
  17.  
  18. 'Mod by SierraKen - Added World Map as the backdrop. - April 2, 2022.
  19.  
  20. Const xmax = 1024
  21. Const ymax = 450
  22. Const nDrops = 500
  23. Type dropType
  24.     x As Single
  25.     sz As Single
  26.     curY As Integer
  27.     dxs As Single 'direction and change of spin some small fraction of 1, +-1/3, +-1/4, +-1/5...
  28.  
  29. 'SierraKen's World Map code with the array, GET, and DEST ---------------------------------------------
  30. Dim map As Long
  31. tmap& = _LoadImage("world_map2.jpg", 32)
  32. map& = _CopyImage(tmap&, 33)
  33.  
  34. WorkScreen = _NewImage(xmax, ymax, 32)
  35. Screen WorkScreen
  36. _ScreenMove 80, 0 'for snap shot
  37. '_FullScreen '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< optional full screen but out of proportion with map
  38.  
  39. ReDim Shared fileStrings$(1000) 'container for these program lines that will be dangling
  40. Open "Matrix Rain 4 mod by SierraKen.bas" For Input As #1
  41.     Line Input #1, fs$
  42.     If Len(LTrim$(fs$)) <> 0 Then 'less empty spaces
  43.         fileStrings$(i) = LTrim$(fs$)
  44.         i = i + 1
  45.     End If
  46. ReDim _Preserve fileStrings$(i - 1)
  47. ' check loading
  48. 'FOR i = 0 TO UBOUND(fileStrings$)
  49. '    PRINT i, fileStrings$(i)
  50. 'NEXT
  51. 'END
  52.  
  53. 'setup drops
  54. Dim Shared drop(nDrops) As dropType
  55. Dim Shared s$(nDrops)
  56.  
  57. For i = 0 To nDrops
  58.     newDrop i, 1
  59. While _KeyDown(27) = 0
  60.     'Cls , 0
  61.     'SierraKen's PUT statement ----------------------------
  62.     _PutImage , map&
  63.     '------------------------------------------------------
  64.  
  65.     For i = 0 To nDrops
  66.         drawDrop (i)
  67.         drop(i).curY = drop(i).curY + 1
  68.         If drop(i).curY > Len(s$(i)) Then newDrop i, 0
  69.     Next
  70.     _Display
  71.     fps = fps + 1
  72.     If Timer > FPStimer Then _Title "FPS:" + Str$(fps): fps = 0: FPStimer = Timer + 1
  73.     '_Limit 25
  74.  
  75. Sub newDrop (i, start)
  76.     drop(i).x = Rnd * xmax 'set location
  77.     drop(i).sz = randWeight(.3, 5, 3) 'set size  weighted on small sizes
  78.     'length of text string can fit on screen
  79.     charLength = ymax \ (drop(i).sz * 16) + 1 'from size determine how many chars fit on screen
  80.     randLine = Int(Rnd * UBound(fileStrings$)) 'pick a random program line
  81.     s$(i) = Mid$(fileStrings$(randLine), 1, charLength) 'here is text string to dangle
  82.     While Len(s$(i)) < charLength
  83.         If randLine + 1 > UBound(fileStrings$) Then randLine = 0 Else randLine = randLine + 1
  84.         s$(i) = Mid$(s$(i) + " : " + fileStrings$(randLine), 1, charLength)
  85.     Wend
  86.     If start <> 0 Then drop(i).curY = Int(Rnd * (charLength)) + 1 Else drop(i).curY = 1 'flat and readable at curY
  87.     drop(i).dxs = 1 / (Int(Rnd * 7) + 3) 'change of spin rate +-1/3, +-1/4, ... +-1/9
  88.     If Rnd < .5 Then drop(i).dxs = -drop(i).dxs
  89.  
  90. Sub drawDrop (i)
  91.     For j = 1 To drop(i).curY
  92.         d = drop(i).curY - j
  93.         rot = 1: dir = -1
  94.         For k = 0 To d
  95.             rot = rot + drop(i).dxs * dir
  96.             If rot > 1 Then
  97.                 dir = -1 * dir: rot = 1 + drop(i).dxs * dir
  98.             ElseIf rot < -1 Then
  99.                 dir = dir * -1: rot = -1 + drop(i).dxs * dir
  100.             End If
  101.         Next
  102.         drwChar Asc(s$(i), j), d, drop(i).x + 4 * drop(i).sz, drop(i).sz * 16 * (j - 1) + 8 * drop(i).sz, rot * drop(i).sz, drop(i).sz, 0
  103.     Next
  104.  
  105. Sub drwChar (char, c As _Unsigned Long, midX, midY, xScale, yScale, Rotation) 'what ever the present color is set at
  106.     Static I(18, 255) As Long
  107.     If I(0, 0) = 0 Then
  108.         For d = 0 To 18 '18 rows of letters for all the colors possible in the program
  109.             If d = 0 Then
  110.                 ColorSet& = _RGBA32(0, 255, 0, 225)
  111.             ElseIf d = 1 Then
  112.                 ColorSet& = _RGBA32(50, 255, 0, 205)
  113.             ElseIf d = 2 Then
  114.                 ColorSet& = _RGBA32(25, 255, 0, 180)
  115.             ElseIf d >= 3 And d <= 18 Then
  116.                 ColorSet& = _RGBA32(0, 255, 0, 190 - d * 5)
  117.             Else 'beyond this value, the 190 - d * 5 becomes a negative value?
  118.                 'For values beyond this, I'm just going to exit the sub and whistle innocently, uncertain what they're supposed to be....  *whistle*
  119.             End If
  120.             For ch = 0 To 255 '256 columns for the letters.
  121.                 temp = _NewImage(8, 16, 32)
  122.                 _Dest temp
  123.                 Color ColorSet&, 0
  124.                 _PrintString (0, 0), Chr$(ch)
  125.                 I(d, ch) = _CopyImage(temp, 33)
  126.             Next
  127.         Next
  128.         _Dest 0
  129.     End If
  130.     If c > 18 Then Exit Sub ' *whistle*  *whistele*
  131.     RotoZoom2 midX, midY, I(c, char), xScale, yScale, Rotation
  132.  
  133. Sub RotoZoom2 (X As Long, Y As Long, Image As Long, xScale As Single, yScale As Single, Rotation As Single)
  134.     Dim px(3) As Single: Dim py(3) As Single
  135.     W& = _Width(Image&): H& = _Height(Image&)
  136.     px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
  137.     px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
  138.     sinr! = Sin(-Rotation): cosr! = Cos(-Rotation)
  139.     For i& = 0 To 3
  140.         x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + Y
  141.         px(i&) = x2&: py(i&) = y2&
  142.     Next
  143.     _MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
  144.     _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
  145.  
  146. Function randWeight (manyValue, fewValue, power)
  147.     randWeight = manyValue + Rnd ^ power * (fewValue - manyValue)
  148.  
  149.  
  150.  
  151.  

Best I can tend to max out with is about 140 FPS on my laptop.   
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: B+'s Matrix Rain With World Map Backdrop
« Reply #12 on: April 05, 2022, 03:50:43 pm »
Dang that's fast! Whew!

I do miss the color of drop going to white at end.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: B+'s Matrix Rain With World Map Backdrop
« Reply #13 on: April 05, 2022, 04:00:40 pm »
Dang that's fast! Whew!

I do miss the color of drop going to white at end.

How do we go to white at the end?  Is it something to do with this line?

        ElseIf d >= 3 Then
            c~& = _RGBA32(0, 255, 0, 190 - d * 5)

When d is greater than 18, aren't you dealing with a negative value alpha, which overflows back to repeating the same color palette normally?

What's going on here when d becomes a value like 77 (I noticed it that high with a few error debugging lines before)?  Is it somehow overflowing to alter other values than just alpha so that we end up more white than red?
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: B+'s Matrix Rain With World Map Backdrop
« Reply #14 on: April 05, 2022, 05:00:29 pm »
Here's what it was before color change by Ken, Purple Rain light (not white sorry) at the drop end = 0 and growing darker going up.
Code: QB64: [Select]
  1. Sub drawDrop (i)
  2.     For j = 1 To drop(i).curY
  3.         d = drop(i).curY - j
  4.         If d = 0 Then
  5.             c~& = _RGBA32(255, 100, 255, 225)
  6.         ElseIf d = 1 Then
  7.             c~& = _RGBA32(255, 50, 255, 205)
  8.         ElseIf d = 2 Then
  9.             c~& = _RGBA32(255, 25, 255, 180)
  10.         ElseIf d >= 3 Then
  11.             c~& = _RGBA32(255, 0, 255, 190 - d * 5)
  12.         End If
  13.  

So try this:
Code: QB64: [Select]
  1. _Title "Matrix Rain 4 mod by SierraKen mod b+" 'B+ started 2019-03-16
  2. ' Ken added great background and changed rain color
  3. ' 2022-04-05 b+ adjusted screen for x width 1024 for speedier graphics
  4. ' from Matrix Rain 2019-03-14
  5. ' or QB64 Purple Rain!
  6.  
  7. '>>> Save this file as: Matrix Rain 4 mod by SierraKen.bas, so the program can load the strings from it.  <<<
  8.  
  9. '2019-03-15 This will attempt to spin the drops as they fall
  10. '2019-03-16  Don't need no damn Character Set.DAT file!!!
  11. '2019-03-16 Ijust want to see the vertical code strings dangle and twist.
  12.  
  13. '2019-03-19 Matrix Rain 4
  14. ' + added randWeight to weight the random sizes chosen so many more on small side than large
  15. ' + draw letters on a transparent background so the background of the letter does not cover
  16. '   the drops behind it.
  17.  
  18. 'Mod by SierraKen - Added World Map as the backdrop. - April 2, 2022.
  19.  
  20. Const xmax = 1024
  21. Const ymax = 450
  22. Const nDrops = 500
  23. Type dropType
  24.     x As Single
  25.     sz As Single
  26.     curY As Integer
  27.     dxs As Single 'direction and change of spin some small fraction of 1, +-1/3, +-1/4, +-1/5...
  28.  
  29. 'SierraKen's World Map code with the array, GET, and DEST ---------------------------------------------
  30. Dim map As Long
  31. tmap& = _LoadImage("world_map2.jpg", 32)
  32. map& = _CopyImage(tmap&, 33)
  33.  
  34. WorkScreen = _NewImage(xmax, ymax, 32)
  35. Screen WorkScreen
  36. _ScreenMove 80, 0 'for snap shot
  37. '_FullScreen '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< optional full screen but out of proportion with map
  38.  
  39. ReDim Shared fileStrings$(1000) 'container for these program lines that will be dangling
  40. Open "Matrix Rain 4 mod by SierraKen.bas" For Input As #1
  41.     Line Input #1, fs$
  42.     If Len(LTrim$(fs$)) <> 0 Then 'less empty spaces
  43.         fileStrings$(i) = LTrim$(fs$)
  44.         i = i + 1
  45.     End If
  46. ReDim _Preserve fileStrings$(i - 1)
  47. ' check loading
  48. 'FOR i = 0 TO UBOUND(fileStrings$)
  49. '    PRINT i, fileStrings$(i)
  50. 'NEXT
  51. 'END
  52.  
  53. 'setup drops
  54. Dim Shared drop(nDrops) As dropType
  55. Dim Shared s$(nDrops)
  56.  
  57. For i = 0 To nDrops
  58.     newDrop i, 1
  59. While _KeyDown(27) = 0
  60.     'Cls , 0
  61.     'SierraKen's PUT statement ----------------------------
  62.     _PutImage , map&
  63.     '------------------------------------------------------
  64.  
  65.     For i = 0 To nDrops
  66.         drawDrop (i)
  67.         drop(i).curY = drop(i).curY + 1
  68.         If drop(i).curY > Len(s$(i)) Then newDrop i, 0
  69.     Next
  70.     _Display
  71.     fps = fps + 1
  72.     If Timer > FPStimer Then _Title "FPS:" + Str$(fps): fps = 0: FPStimer = Timer + 1
  73.     _Limit 15
  74.  
  75. Sub newDrop (i, start)
  76.     drop(i).x = Rnd * xmax 'set location
  77.     drop(i).sz = randWeight(.3, 5, 3) 'set size  weighted on small sizes
  78.     'length of text string can fit on screen
  79.     charLength = ymax \ (drop(i).sz * 16) + 1 'from size determine how many chars fit on screen
  80.     randLine = Int(Rnd * UBound(fileStrings$)) 'pick a random program line
  81.     s$(i) = Mid$(fileStrings$(randLine), 1, charLength) 'here is text string to dangle
  82.     While Len(s$(i)) < charLength
  83.         If randLine + 1 > UBound(fileStrings$) Then randLine = 0 Else randLine = randLine + 1
  84.         s$(i) = Mid$(s$(i) + " : " + fileStrings$(randLine), 1, charLength)
  85.     Wend
  86.     If start <> 0 Then drop(i).curY = Int(Rnd * (charLength)) + 1 Else drop(i).curY = 1 'flat and readable at curY
  87.     drop(i).dxs = 1 / (Int(Rnd * 7) + 3) 'change of spin rate +-1/3, +-1/4, ... +-1/9
  88.     If Rnd < .5 Then drop(i).dxs = -drop(i).dxs
  89.  
  90. Sub drawDrop (i)
  91.     For j = 1 To drop(i).curY
  92.         d = drop(i).curY - j
  93.         rot = 1: dir = -1
  94.         For k = 0 To d
  95.             rot = rot + drop(i).dxs * dir
  96.             If rot > 1 Then
  97.                 dir = -1 * dir: rot = 1 + drop(i).dxs * dir
  98.             ElseIf rot < -1 Then
  99.                 dir = dir * -1: rot = -1 + drop(i).dxs * dir
  100.             End If
  101.         Next
  102.         drwChar Asc(s$(i), j), d, drop(i).x + 4 * drop(i).sz, drop(i).sz * 16 * (j - 1) + 8 * drop(i).sz, rot * drop(i).sz, drop(i).sz, 0
  103.     Next
  104.  
  105. Sub drwChar (char, c As _Unsigned Long, midX, midY, xScale, yScale, Rotation) 'what ever the present color is set at
  106.     Static I(18, 255) As Long
  107.     If I(0, 0) = 0 Then
  108.         For d = 0 To 18 '18 rows of letters for all the colors possible in the program
  109.             If d = 0 Then
  110.                 ColorSet& = _RGBA32(200, 255, 200, 225)
  111.             ElseIf d = 1 Then
  112.                 ColorSet& = _RGBA32(100, 255, 100, 205)
  113.             ElseIf d = 2 Then
  114.                 ColorSet& = _RGBA32(50, 255, 50, 180)
  115.             ElseIf d >= 3 And d <= 18 Then
  116.                 ColorSet& = _RGBA32(0, 255, 0, 190 - d * 5)
  117.             Else 'beyond this value, the 190 - d * 5 becomes a negative value?
  118.                 'For values beyond this, I'm just going to exit the sub and whistle innocently, uncertain what they're supposed to be....  *whistle*
  119.             End If
  120.             For ch = 0 To 255 '256 columns for the letters.
  121.                 temp = _NewImage(8, 16, 32)
  122.                 _Dest temp
  123.                 Color ColorSet&, 0
  124.                 _PrintString (0, 0), Chr$(ch)
  125.                 I(d, ch) = _CopyImage(temp, 33)
  126.             Next
  127.         Next
  128.         _Dest 0
  129.     End If
  130.     If c > 18 Then Exit Sub ' *whistle*  *whistele*
  131.     RotoZoom2 midX, midY, I(c, char), xScale, yScale, Rotation
  132.  
  133. Sub RotoZoom2 (X As Long, Y As Long, Image As Long, xScale As Single, yScale As Single, Rotation As Single)
  134.     Dim px(3) As Single: Dim py(3) As Single
  135.     W& = _Width(Image&): H& = _Height(Image&)
  136.     px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
  137.     px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
  138.     sinr! = Sin(-Rotation): cosr! = Cos(-Rotation)
  139.     For i& = 0 To 3
  140.         x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + Y
  141.         px(i&) = x2&: py(i&) = y2&
  142.     Next
  143.     _MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
  144.     _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
  145.  
  146. Function randWeight (manyValue, fewValue, power)
  147.     randWeight = manyValue + Rnd ^ power * (fewValue - manyValue)
  148.  
  149.  

 It is so fast need to slow down to catch effects ;-))