_Title "Matrix Rain 4 mod by SierraKen mod b+" 'B+ started 2019-03-16 ' Ken added great background and changed rain color
' 2022-04-05 b+ adjusted screen for x width 1024 for speedier graphics
' from Matrix Rain 2019-03-14
' or QB64 Purple Rain!
'>>> Save this file as: Matrix Rain 4 mod by SierraKen.bas, so the program can load the strings from it. <<<
'2019-03-15 This will attempt to spin the drops as they fall
'2019-03-16 Don't need no damn Character Set.DAT file!!!
'2019-03-16 Ijust want to see the vertical code strings dangle and twist.
'2019-03-19 Matrix Rain 4
' + added randWeight to weight the random sizes chosen so many more on small side than large
' + draw letters on a transparent background so the background of the letter does not cover
' the drops behind it.
'Mod by SierraKen - Added World Map as the backdrop. - April 2, 2022.
dxs
As Single 'direction and change of spin some small fraction of 1, +-1/3, +-1/4, +-1/5...
'SierraKen's World Map code with the array, GET, and DEST ---------------------------------------------
'_FullScreen '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< optional full screen but out of proportion with map
ReDim Shared fileStrings$
(1000) 'container for these program lines that will be dangling i = i + 1
' check loading
'FOR i = 0 TO UBOUND(fileStrings$)
' PRINT i, fileStrings$(i)
'NEXT
'END
'setup drops
newDrop i, 1
'Cls , 0
'SierraKen's PUT statement ----------------------------
'------------------------------------------------------
drawDrop (i)
drop(i).curY = drop(i).curY + 1
If drop
(i
).curY
> Len(s$
(i
)) Then newDrop i
, 0 fps = fps + 1
'_Limit 25
drop
(i
).x
= Rnd * xmax
'set location drop(i).sz = randWeight(.3, 5, 3) 'set size weighted on small sizes
'length of text string can fit on screen
charLength = ymax \ (drop(i).sz * 16) + 1 'from size determine how many chars fit on screen
randLine
= Int(Rnd * UBound(fileStrings$
)) 'pick a random program line s$
(i
) = Mid$(fileStrings$
(randLine
), 1, charLength
) 'here is text string to dangle If randLine
+ 1 > UBound(fileStrings$
) Then randLine
= 0 Else randLine
= randLine
+ 1 s$
(i
) = Mid$(s$
(i
) + " : " + fileStrings$
(randLine
), 1, charLength
) If start
<> 0 Then drop
(i
).curY
= Int(Rnd * (charLength
)) + 1 Else drop
(i
).curY
= 1 'flat and readable at curY drop
(i
).dxs
= 1 / (Int(Rnd * 7) + 3) 'change of spin rate +-1/3, +-1/4, ... +-1/9
For j
= 1 To drop
(i
).curY
d = drop(i).curY - j
rot = 1: dir = -1
rot = rot + drop(i).dxs * dir
dir = -1 * dir: rot = 1 + drop(i).dxs * dir
dir = dir * -1: rot = -1 + drop(i).dxs * dir
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
Sub drwChar
(char
, c
As _Unsigned Long, midX
, midY
, xScale
, yScale
, Rotation
) 'what ever the present color is set at For d
= 0 To 18 '18 rows of letters for all the colors possible in the program ColorSet&
= _RGBA32(0, 255, 0, 225) ColorSet&
= _RGBA32(50, 255, 0, 205) ColorSet&
= _RGBA32(25, 255, 0, 180) ColorSet&
= _RGBA32(0, 255, 0, 190 - d
* 5) Else 'beyond this value, the 190 - d * 5 becomes a negative value? 'For values beyond this, I'm just going to exit the sub and whistle innocently, uncertain what they're supposed to be.... *whistle*
For ch
= 0 To 255 '256 columns for the letters. RotoZoom2 midX, midY, I(c, char), xScale, yScale, Rotation
px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
sinr!
= Sin(-Rotation
): cosr!
= Cos(-Rotation
) x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + Y
px(i&) = x2&: py(i&) = y2&
_MapTriangle (0, 0)-(0, H&
- 1)-(W&
- 1, H&
- 1), Image&
To(px
(0), py
(0))-(px
(1), py
(1))-(px
(2), py
(2)) _MapTriangle (0, 0)-(W&
- 1, 0)-(W&
- 1, H&
- 1), Image&
To(px
(0), py
(0))-(px
(3), py
(3))-(px
(2), py
(2))
Function randWeight
(manyValue
, fewValue
, power
) randWeight
= manyValue
+ Rnd ^ power
* (fewValue
- manyValue
)