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 - bplus

Pages: 1 2 3 [4] 5 6 ... 537
46
Programs / Re: B+'s Matrix Rain With World Map Backdrop
« 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.  
  21. Const xmax = 1024
  22. Const ymax = 450
  23. Const nDrops = 500
  24. Type dropType
  25.     x As Single
  26.     sz As Single
  27.     curY As Integer
  28.     dxs As Single 'direction and change of spin some small fraction of 1, +-1/3, +-1/4, +-1/5...
  30.  
  31. 'SierraKen's World Map code with the array, GET, and DEST ---------------------------------------------
  32. Dim map As Long
  33. tmap& = _LoadImage("world_map2.jpg", 32)
  34. map& = _CopyImage(tmap&, 33)
  35.  
  36. WorkScreen = _NewImage(xmax, ymax, 32)
  37. Screen WorkScreen
  38. _ScreenMove 80, 0 'for snap shot
  39. '_FullScreen '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< optional full screen but out of proportion with map
  40.  
  41. ReDim Shared fileStrings$(1000) 'container for these program lines that will be dangling
  42. Open "Matrix Rain 4 mod by SierraKen.bas" For Input As #1
  44.     Line Input #1, fs$
  45.     If Len(LTrim$(fs$)) <> 0 Then 'less empty spaces
  46.         fileStrings$(i) = LTrim$(fs$)
  47.         i = i + 1
  48.     End If
  51. ReDim _Preserve fileStrings$(i - 1)
  52. ' check loading
  53. 'FOR i = 0 TO UBOUND(fileStrings$)
  54. '    PRINT i, fileStrings$(i)
  55. 'NEXT
  56. 'END
  57.  
  58. 'setup drops
  59. Dim Shared drop(nDrops) As dropType
  60. Dim Shared s$(nDrops)
  61.  
  62. For i = 0 To nDrops
  63.     newDrop i, 1
  66. While _KeyDown(27) = 0
  67.     'Cls , 0
  68.     'SierraKen's PUT statement ----------------------------
  69.     _PutImage , map&
  70.     '------------------------------------------------------
  71.  
  72.     For i = 0 To nDrops
  73.         drawDrop (i)
  74.         drop(i).curY = drop(i).curY + 1
  75.         If drop(i).curY > Len(s$(i)) Then newDrop i, 0
  76.     Next
  77.     _Display
  78.     fps = fps + 1
  79.     If Timer > FPStimer Then _Title "FPS:" + Str$(fps): fps = 0: FPStimer = Timer + 1
  80.     _Limit 15
  82.  
  83. Sub newDrop (i, start)
  84.     drop(i).x = Rnd * xmax 'set location
  85.     drop(i).sz = randWeight(.3, 5, 3) 'set size  weighted on small sizes
  86.     'length of text string can fit on screen
  87.     charLength = ymax \ (drop(i).sz * 16) + 1 'from size determine how many chars fit on screen
  88.     randLine = Int(Rnd * UBound(fileStrings$)) 'pick a random program line
  89.     s$(i) = Mid$(fileStrings$(randLine), 1, charLength) 'here is text string to dangle
  90.     While Len(s$(i)) < charLength
  91.         If randLine + 1 > UBound(fileStrings$) Then randLine = 0 Else randLine = randLine + 1
  92.         s$(i) = Mid$(s$(i) + " : " + fileStrings$(randLine), 1, charLength)
  93.     Wend
  94.     If start <> 0 Then drop(i).curY = Int(Rnd * (charLength)) + 1 Else drop(i).curY = 1 'flat and readable at curY
  95.     drop(i).dxs = 1 / (Int(Rnd * 7) + 3) 'change of spin rate +-1/3, +-1/4, ... +-1/9
  96.     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.         rot = 1: dir = -1
  103.         For k = 0 To d
  104.             rot = rot + drop(i).dxs * dir
  105.             If rot > 1 Then
  106.                 dir = -1 * dir: rot = 1 + drop(i).dxs * dir
  107.             ElseIf rot < -1 Then
  108.                 dir = dir * -1: rot = -1 + drop(i).dxs * dir
  109.             End If
  110.         Next
  111.         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
  112.     Next
  114.  
  115. Sub drwChar (char, c As _Unsigned Long, midX, midY, xScale, yScale, Rotation) 'what ever the present color is set at
  116.     Static I(18, 255) As Long
  117.     If I(0, 0) = 0 Then
  118.         For d = 0 To 18 '18 rows of letters for all the colors possible in the program
  119.             If d = 0 Then
  120.                 ColorSet& = _RGBA32(200, 255, 200, 225)
  121.             ElseIf d = 1 Then
  122.                 ColorSet& = _RGBA32(100, 255, 100, 205)
  123.             ElseIf d = 2 Then
  124.                 ColorSet& = _RGBA32(50, 255, 50, 180)
  125.             ElseIf d >= 3 And d <= 18 Then
  126.                 ColorSet& = _RGBA32(0, 255, 0, 190 - d * 5)
  127.             Else 'beyond this value, the 190 - d * 5 becomes a negative value?
  128.                 'For values beyond this, I'm just going to exit the sub and whistle innocently, uncertain what they're supposed to be....  *whistle*
  129.             End If
  130.             For ch = 0 To 255 '256 columns for the letters.
  131.                 temp = _NewImage(8, 16, 32)
  132.                 _Dest temp
  133.                 Color ColorSet&, 0
  134.                 _PrintString (0, 0), Chr$(ch)
  135.                 I(d, ch) = _CopyImage(temp, 33)
  136.             Next
  137.         Next
  138.         _Dest 0
  139.     End If
  140.     If c > 18 Then Exit Sub ' *whistle*  *whistele*
  141.     RotoZoom2 midX, midY, I(c, char), xScale, yScale, Rotation
  143.  
  144. Sub RotoZoom2 (X As Long, Y As Long, Image As Long, xScale As Single, yScale As Single, Rotation As Single)
  145.     Dim px(3) As Single: Dim py(3) As Single
  146.     W& = _Width(Image&): H& = _Height(Image&)
  147.     px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
  148.     px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
  149.     sinr! = Sin(-Rotation): cosr! = Cos(-Rotation)
  150.     For i& = 0 To 3
  151.         x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + Y
  152.         px(i&) = x2&: py(i&) = y2&
  153.     Next
  154.     _MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
  155.     _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
  157.  
  158. Function randWeight (manyValue, fewValue, power)
  159.     randWeight = manyValue + Rnd ^ power * (fewValue - manyValue)
  161.  
  162.  

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

47
Programs / Re: Just a silly "Hello World" Marquis
« on: April 05, 2022, 03:54:29 pm »
Classic Basic, like the frame!

48
Programs / Re: B+'s Matrix Rain With World Map Backdrop
« 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.

49
Programs / Re: B+'s Matrix Rain With World Map Backdrop
« on: April 05, 2022, 02:37:09 pm »
Thanks Steve, I'll check it out.

50
QB64 Discussion / Re: Fickle Increment variable
« on: April 05, 2022, 01:49:08 pm »
Line 132 doesn't have the Const's or variables defined.

BTW to add to what Steve said, yeah I think _Keyhit is neg when holding it down and positive when release. Might be able to time that.

51
QB64 Discussion / Re: Fickle Increment variable
« on: April 05, 2022, 01:32:08 pm »
Is this thing for a user to select a time?

Run is not liking line 132 one bit!
Code: QB64: [Select]
  1. got$ = GetOneTimeAmount$("Test")
  2.  
  3. Function GetOneTimeAmount$ (title$)
  4.     Dim minOption, maxOption, haltAndDisplay, xPos, yPos, highlightedOption As Integer
  5.     Dim years1, days1, hours1, minutes1, seconds1, keyWasPressed, timerStarted As Integer
  6.     Dim isLessThan, notZero As Integer
  7.  
  8.     differentTime1:
  9.  
  10.     highlightedOption = 4: haltAndDisplay = TRUE: keyWasPressed = FALSE
  11.     isLessThan = FALSE: notZero = TRUE: Increment = 1
  12.     minOption = 4: maxOption = 8
  13.     Do
  14.         userCommand$ = InKey$
  15.         If haltAndDisplay = TRUE Then
  16.  
  17.             Color 14, 1: Cls: yPos = 25: xPos = 15
  18.             a$ = title$: Locate 5, Center(a$): Print a$
  19.  
  20.             Locate yPos, xPos - 3
  21.             If highlightedOption >= 4 And highlightedOption <= 8 Then
  22.             Color 10, 0: Else Color 14, 1: End If
  23.             Print "Time:"
  24.             xPos = xPos + 18
  25.  
  26.             Locate yPos - 5, xPos - 10
  27.             If highlightedOption = 4 Then
  28.             Color 10, 0: Else Color 14, 1: End If: Print "Years"
  29.             Locate yPos - 2, xPos - 10: Color 14, 1:
  30.             If years1 - 1 >= 0 Then
  31.             Print Using "#,###"; (years1 - 1): Else Print "9,999": End If
  32.             Locate yPos: Color 10, 0: If years1 >= 0 And years1 < 10 Then
  33.                 Locate , xPos - 6: Print S$(years1)
  34.             ElseIf years1 >= 10 And years1 < 100 Then Locate , xPos - 7: Print S$(years1)
  35.             ElseIf years1 >= 100 And years1 < 1000 Then Locate , xPos - 8: Print S$(years1)
  36.             ElseIf years1 >= 1000 And years1 < 10000 Then Locate , xPos - 10: Print Using "#,###"; years1
  37.             Else Print "I hope I don't see this error": End If
  38.             Locate yPos + 2, xPos - 10: Color 14, 1: If years1 + 1 < 10000 Then
  39.             Print Using "#,###"; years1 + 1: Else Print Using "#,###"; 0: End If
  40.  
  41.             Locate yPos - 5, xPos
  42.             If highlightedOption = 5 Then
  43.             Color 10, 0: Else Color 14, 1: End If: Print "Days"
  44.             Color 14, 1: Locate yPos - 2, xPos: If days1 - 1 = -1 Then
  45.             Print "365": Else Print Using "###"; days1 - 1: End If
  46.             Color 10, 0: Locate yPos ', ' xPos + 9:
  47.             If days1 >= 0 And days1 < 10 Then
  48.                 Locate , xPos + 2: Print S$(days1)
  49.             ElseIf days1 >= 10 And days1 < 100 Then Locate , xPos + 1: Print S$(days1)
  50.             ElseIf days1 >= 100 And days1 <= 365 Then Locate , xPos + 0: Print S$(days1)
  51.             End If
  52.             Color 14, 1: Locate yPos + 2, xPos + 0: Print Using "###"; days1 + 1 ': IF days1 + 1 >= 0 AND days1 + 1 < 10 THEN
  53.  
  54.             Locate yPos - 5, xPos + 9
  55.             If highlightedOption = 6 Then
  56.             Color 10, 0: Else Color 14, 1: End If: Print "Hours"
  57.             Color 14, 1: Locate yPos - 2, xPos + 11: If hours1 - 1 >= 0 Then
  58.             Print S$(hours1 - 1): Else Print "23": End If
  59.             Locate yPos, xPos + 11: Color 10, 0: Print S$(hours1)
  60.             Locate yPos + 2, xPos + 11: Color 14, 1: If hours1 + 1 <= 23 Then
  61.             Print S$(hours1 + 1): Else Print "0": End If
  62.  
  63.             Locate yPos - 5, xPos + 18
  64.             If highlightedOption = 7 Then
  65.             Color 10, 0: Else Color 14, 1: End If: Print "Minutes"
  66.             Color 14, 1: Locate yPos - 2, xPos + 20: If minutes1 - 1 >= 0 Then
  67.             Print S$(minutes1 - 1): Else Print "59": End If
  68.             Locate yPos, xPos + 20: Color 10, 0: Print S$(minutes1)
  69.             Locate yPos + 2, xPos + 20: Color 14, 1: If minutes1 + 1 < 60 Then
  70.             Print S$(minutes1 + 1): Else Print "0": End If
  71.  
  72.             Locate yPos - 5, xPos + 29
  73.             If highlightedOption = 8 Then
  74.             Color 10, 0: Else Color 14, 1: End If: Print "Seconds"
  75.             Color 14, 1: Locate yPos - 2, xPos + 32: If seconds1 - 1 >= 0 Then
  76.             Print S$(seconds1 - 1): Else Print "59": End If
  77.             Locate yPos, xPos + 32: Color 10, 0: Print S$(seconds1)
  78.             Locate yPos + 2, xPos + 32: Color 14, 1: If seconds1 + 1 <= 59 Then
  79.             Print S$(seconds1 + 1): Else Print "0": End If
  80.  
  81.             b1$ = "YYYY DDD HH MM SS"
  82.             a1$ = ""
  83.             If years1 = 0 Then
  84.                 a1$ = "0000"
  85.             ElseIf years1 > 0 And years1 < 10 Then
  86.                 a1$ = "000" + S$(years1)
  87.             ElseIf years1 >= 10 And years1 < 100 Then
  88.                 a1$ = "00" + S$(years1)
  89.             ElseIf years1 >= 100 And years1 < 1000 Then
  90.                 a1$ = a1$ + "0" + S$(years1)
  91.             ElseIf years1 >= 1000 And years1 < 10000 Then
  92.                 a1$ = a1$ + S$(years1)
  93.             End If
  94.             a1$ = a1$ + ":"
  95.             If days1 = 0 Then
  96.                 a1$ = a1$ + "000"
  97.             ElseIf days1 > 0 And days1 < 10 Then
  98.                 a1$ = a1$ + "00" + S$(days1)
  99.             ElseIf days1 >= 10 And days1 < 100 Then
  100.                 a1$ = a1$ + "0" + S$(days1)
  101.             Else
  102.                 a1$ = a1$ + S$(days1)
  103.             End If
  104.             a1$ = a1$ + ":"
  105.             If hours1 = 0 Then
  106.                 a1$ = a1$ + "00"
  107.             ElseIf hours1 > 0 And hours1 < 10 Then
  108.                 a1$ = a1$ + "0" + S$(hours1)
  109.             Else
  110.                 a1$ = a1$ + S$(hours1)
  111.             End If
  112.             a1$ = a1$ + ":"
  113.             If minutes1 = 0 Then
  114.                 a1$ = a1$ + "00"
  115.             ElseIf minutes1 > 0 And minutes1 < 10 Then
  116.                 a1$ = a1$ + "0" + S$(minutes1)
  117.             Else
  118.                 a1$ = a1$ + S$(minutes1)
  119.             End If
  120.             a1$ = a1$ + ":"
  121.             If seconds1 = 0 Then
  122.                 a1$ = a1$ + "00"
  123.             ElseIf seconds1 > 0 And seconds1 < 10 Then
  124.                 a1$ = a1$ + "0" + S$(seconds1)
  125.             Else
  126.                 a1$ = a1$ + S$(seconds1)
  127.             End If
  128.             haltAndDisplay = FALSE
  129.             '      LOCATE 48, 1: PRINT a1$
  130.         End If
  131.  
  132.         If _KeyDown(upKeydownCode) <> 0 Or _KeyDown(downKeydownCode) <> 0 Then
  133.             If keyWasPressed = FALSE Then
  134.                 timerStarted = Timer
  135.                 keyWasPressed = TRUE
  136.             End If
  137.             If Int(Timer - timerStarted) = 2 Then
  138.                 Increment = 10
  139.             ElseIf Int(Timer - timerStarted) = 3 Then Increment = 20
  140.             ElseIf Int(Timer - timerStarted) = 5 Then Increment = 50
  141.             ElseIf Int(Timer - timerStarted) = 7 Then Increment = 100
  142.             End If
  143.         Else
  144.             keyWasPressed = FALSE
  145.             Increment = 1
  146.         End If
  147.  
  148.         Select Case userCommand$
  149.             Case upArrowKey$
  150.                 If highlightedOption = 4 Then
  151.                     years1 = years1 - Increment
  152.                     If years1 <= -1 Then years1 = 9999
  153.                 ElseIf highlightedOption = 5 Then
  154.                     days1 = days1 - Increment
  155.                     If days1 <= -1 Then days1 = 365
  156.                 ElseIf highlightedOption = 6 Then
  157.                     hours1 = hours1 - Increment: If hours1 <= -1 Then hours1 = 23
  158.                 ElseIf highlightedOption = 7 Then
  159.                     minutes1 = minutes1 - Increment: If minutes1 <= -1 Then minutes1 = 59
  160.                 ElseIf highlightedOption = 8 Then
  161.                     seconds1 = seconds1 - Increment: If seconds1 <= -1 Then seconds1 = 59
  162.                 End If
  163.                 haltAndDisplay = TRUE
  164.             Case downArrowKey$
  165.                 If highlightedOption = 4 Then
  166.                     years1 = years1 + Increment
  167.                     If years1 >= 10000 Then years1 = 0
  168.                 ElseIf highlightedOption = 5 Then
  169.                     days1 = days1 + Increment: If days1 >= 366 Then days1 = 0
  170.                 ElseIf highlightedOption = 6 Then
  171.                     hours1 = hours1 + Increment: If hours1 >= 24 Then hours1 = 0
  172.                 ElseIf highlightedOption = 7 Then
  173.                     minutes1 = minutes1 + Increment: If minutes1 >= 60 Then minutes1 = 0
  174.                 ElseIf highlightedOption = 8 Then
  175.                     seconds1 = seconds1 + Increment: If seconds1 >= 60 Then seconds1 = 0
  176.                 End If
  177.                 haltAndDisplay = TRUE
  178.             Case rightArrowKey$
  179.                 highlightedOption = highlightedOption + 1
  180.                 If highlightedOption > maxOption Then highlightedOption = minOption
  181.                 haltAndDisplay = TRUE
  182.             Case leftArrowKey$
  183.                 highlightedOption = highlightedOption - 1
  184.                 If highlightedOption < minOption Then highlightedOption = maxOption
  185.                 haltAndDisplay = TRUE
  186.             Case Chr$(13), Chr$(32)
  187.                 notZero = TRUE
  188.                 If years1 = 0 And days1 = 0 And hours1 = 0 And minutes1 = 0 And seconds1 = 0 Then
  189.                     notZero = FALSE
  190.                 End If
  191.                 '        isLessThan = FALSE
  192.                 '        IF years1 < years2 THEN isLessThan = TRUE
  193.                 '        IF years1 = years2 AND days1 < days2 THEN isLessThan = TRUE
  194.                 '        IF days1 = days2 AND hours1 < hours2 THEN isLessThan = TRUE
  195.                 '        IF days1 = days2 AND hours1 = hours2 AND minutes1 < minutes2 THEN isLessThan = TRUE
  196.                 '        IF days1 = days2 AND hours1 = hours2 AND minutes1 = minutes2 AND seconds1 < seconds2 THEN isLessThan = TRUE
  197.                 '        IF isLessThan = TRUE THEN
  198.                 '          userCommand$ = ""
  199.                 '          a$ = "Time 1 cannot be less than Time 2": LOCATE yPos - 8, Center(a$): COLOR 12, 0: PRINT a$
  200.                 '          _DELAY (2.5)
  201.                 '          a$ = "                                 ": LOCATE yPos - 8, Center(a$): COLOR 14, 1: PRINT a$
  202.                 '        END IF
  203.                 If notZero = TRUE Then 'AND isLessThan = FALSE THEN
  204.                     '          LOCATE yPos + 10, 1 'xPos - 10
  205.                     '          PRINT "here": ll$ = P$
  206.                     this$ = "You have selected "
  207.                     If years1 <> 0 Then
  208.                         If years1 >= 1000 Then
  209.                             lftNum = Int(years1 / 1000)
  210.                             this$ = this$ + S$(lftNum) + ","
  211.                             rtNum = years1 - (lftNum * 1000)
  212.                             this$ = this$ + S$(rtNum)
  213.                         Else
  214.                             this$ = this$ + S$(years1)
  215.                         End If
  216.                         this$ = this$ + " year"
  217.                         If years1 <> 1 Then this$ = this$ + "s"
  218.                         If (days1 <> 0 And (minutes1 <> 0 Or hours1 <> 0 Or seconds1 <> 0)) Or (hours1 <> 0 And (minutes1 <> 0 Or seconds1 <> 0)) Or (minutes1 <> 0 And seconds1 <> 0) Then
  219.                             this$ = this$ + ", "
  220.                         ElseIf days1 <> 0 Or minutes1 <> 0 Or hours1 <> 0 Or seconds1 <> 0 Then
  221.                             this$ = this$ + " and "
  222.                         End If
  223.                     End If
  224.                     If days1 <> 0 Then
  225.                         this$ = this$ + S$(days1) + " day"
  226.                         If days1 <> 1 Then this$ = this$ + "s"
  227.                         If (hours1 <> 0 And (minutes1 <> 0 Or seconds1 <> 0)) Or (minutes1 <> 0 And seconds1 <> 0) Then
  228.                             this$ = this$ + ", "
  229.                         ElseIf minutes1 <> 0 And seconds1 <> 0 Then
  230.                             this$ = this$ + " and "
  231.                         End If
  232.                     End If
  233.                     If hours1 <> 0 Then
  234.                         this$ = this$ + S$(hours1) + " hour"
  235.                         If hours1 <> 1 Then this$ = this$ + "s"
  236.                         If minutes1 <> 0 And seconds1 <> 0 Then
  237.                             this$ = this$ + ", "
  238.                         ElseIf minutes1 <> 0 Or seconds1 <> 0 Then
  239.                             this$ = this$ + " and "
  240.                         End If
  241.                     End If
  242.                     If minutes1 <> 0 Then
  243.                         this$ = this$ + S$(minutes1) + " minute"
  244.                         If minutes1 <> 1 Then this$ = this$ + "s"
  245.                         If seconds1 <> 0 Then this$ = this$ + " and "
  246.                     End If
  247.                     If seconds1 <> 0 Then
  248.                         this$ = this$ + S$(seconds1) + " second"
  249.                         If seconds1 <> 1 Then this$ = this$ + "s"
  250.                     End If
  251.                     Locate yPos + 10, Center(this$): Print this$
  252.                     a$ = "Is this correct?": Locate yPos + 12, Center(a$): Print a$
  253.                     yn$ = UCase$(P$)
  254.                     If yn$ = "N" Then GoTo differentTime1
  255.                 Else
  256.                     a$ = "You have selected 0. Is this correct?"
  257.                     yn$ = UCase$(P$)
  258.                     If yn$ = "N" Then GoTo differentTime1
  259.                 End If
  260.             Case Chr$(27)
  261.                 montH = 1: daY = 1: year = 2022
  262.                 years1 = 0: days1 = 0: hours1 = 0: minutes1 = 0: seconds1 = 0
  263.                 '        years2 = 0: days2 = 0: hours2 = 0: minutes2 = 0: seconds2 = 0
  264.                 haltAndDisplay = TRUE
  265.             Case "X"
  266.                 End
  267.         End Select
  268.     Loop Until userCommand$ = Chr$(13) Or userCommand$ = Chr$(32)
  269.  
  270.     GetOneTimeAmount$ = a1$
  271.  
  273.  
  274. Function Center (text$): Center = Int((80 - Len(text$))) / 2: End Function
  275. Function S$ (number): S$ = LTrim$(Str$(number)): End Function
  276. Function P$: pause$ = Input$(1): If pause$ = Chr$(27) Then End
  277. P$ = pause$: End Function
  278.  
  279.  

52
QB64 Discussion / Re: Fickle Increment variable
« on: April 05, 2022, 01:26:28 pm »
You have this one giant function?

Should you not separate the demo part with the feature function part? Maybe I misunderstand?

Also looks like you have Center() function missing line 16. It's Red lining in IDE.

53
Programs / Re: B+'s Matrix Rain With World Map Backdrop
« 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.  
  21. Const xmax = 1024
  22. Const ymax = 450
  23. Const nDrops = 500
  24. Type dropType
  25.     x As Single
  26.     sz As Single
  27.     curY As Integer
  28.     dxs As Single 'direction and change of spin some small fraction of 1, +-1/3, +-1/4, +-1/5...
  30.  
  31. 'SierraKen's World Map code with the array, GET, and DEST ---------------------------------------------
  32. Dim map As Long
  33. map& = _LoadImage("world_map2.jpg", 32)
  34.  
  35. Screen _NewImage(xmax, ymax, 32)
  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
  42.     Line Input #1, fs$
  43.     If Len(LTrim$(fs$)) <> 0 Then 'less empty spaces
  44.         fileStrings$(i) = LTrim$(fs$)
  45.         i = i + 1
  46.     End If
  49. ReDim _Preserve fileStrings$(i - 1)
  50. ' check loading
  51. 'FOR i = 0 TO UBOUND(fileStrings$)
  52. '    PRINT i, fileStrings$(i)
  53. 'NEXT
  54. 'END
  55.  
  56. 'setup drops
  57. Dim Shared drop(nDrops) As dropType
  58. Dim Shared s$(nDrops)
  59.  
  60. For i = 0 To nDrops
  61.     newDrop i, 1
  63.  
  64. While _KeyDown(27) = 0
  65.     Cls
  66.     'SierraKen's PUT statement ----------------------------
  67.     _PutImage , map&, 0
  68.     '------------------------------------------------------
  69.  
  70.     For i = 0 To nDrops
  71.         drawDrop (i)
  72.         drop(i).curY = drop(i).curY + 1
  73.         If drop(i).curY > Len(s$(i)) Then newDrop i, 0
  74.     Next
  75.     _Display
  76.     _Limit 25
  78.  
  79. Sub newDrop (i, start)
  80.     drop(i).x = Rnd * xmax 'set location
  81.     drop(i).sz = randWeight(.3, 5, 3) 'set size  weighted on small sizes
  82.     'length of text string can fit on screen
  83.     charLength = ymax \ (drop(i).sz * 16) + 1 'from size determine how many chars fit on screen
  84.     randLine = Int(Rnd * UBound(fileStrings$)) 'pick a random program line
  85.     s$(i) = Mid$(fileStrings$(randLine), 1, charLength) 'here is text string to dangle
  86.     While Len(s$(i)) < charLength
  87.         If randLine + 1 > UBound(fileStrings$) Then randLine = 0 Else randLine = randLine + 1
  88.         s$(i) = Mid$(s$(i) + " : " + fileStrings$(randLine), 1, charLength)
  89.     Wend
  90.     If start <> 0 Then drop(i).curY = Int(Rnd * (charLength)) + 1 Else drop(i).curY = 1 'flat and readable at curY
  91.     drop(i).dxs = 1 / (Int(Rnd * 7) + 3) 'change of spin rate +-1/3, +-1/4, ... +-1/9
  92.     If Rnd < .5 Then drop(i).dxs = -drop(i).dxs
  94.  
  95. Sub drawDrop (i)
  96.     For j = 1 To drop(i).curY
  97.         d = drop(i).curY - j
  98.         If d = 0 Then
  99.             c~& = _RGBA32(0, 255, 0, 225)
  100.         ElseIf d = 1 Then
  101.             c~& = _RGBA32(50, 255, 0, 205)
  102.         ElseIf d = 2 Then
  103.             c~& = _RGBA32(25, 255, 0, 180)
  104.         ElseIf d >= 3 Then
  105.             c~& = _RGBA32(0, 255, 0, 190 - d * 5)
  106.         End If
  107.         rot = 1: dir = -1
  108.         For k = 0 To d
  109.             rot = rot + drop(i).dxs * dir
  110.             If rot > 1 Then dir = -1 * dir: rot = 1 + drop(i).dxs * dir
  111.             If rot < -1 Then dir = dir * -1: rot = -1 + drop(i).dxs * dir
  112.         Next
  113.         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
  114.     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&
  126.  
  127. Sub RotoZoom2 (X As Long, Y As Long, Image As Long, xScale As Single, yScale As Single, Rotation As Single)
  128.     Dim px(3) As Single: Dim py(3) As Single
  129.     W& = _Width(Image&): H& = _Height(Image&)
  130.     px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
  131.     px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
  132.     sinr! = Sin(-Rotation): cosr! = Cos(-Rotation)
  133.     For i& = 0 To 3
  134.         x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + Y
  135.         px(i&) = x2&: py(i&) = y2&
  136.     Next
  137.     _MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
  138.     _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
  140.  
  141. Function randWeight (manyValue, fewValue, power)
  142.     randWeight = manyValue + Rnd ^ power * (fewValue - manyValue)
  144.  
  145.  
  146.  


54
Programs / Re: QBZerk
« on: April 05, 2022, 10:02:11 am »
Yeah Terry does nice work! We have several of his games in library to sample.

Good luck @madscijr with your mods.

55
QB64 Discussion / Re: defsng math going off the rails, creating a total from list of numbers in file
« on: April 05, 2022, 09:58:45 am »
Overhauled my adding machine with just Long type for Cents Amounts or values has Dollar$ function to display Dollars and cents of Long Running Total:
https://qb64forum.alephc.xyz/index.php?topic=1639.msg141814#msg141814

56
Programs / Re: Check the Cash Register Receipt
« on: April 05, 2022, 09:55:42 am »
Update: Now done with Long Integers for cents and using dollars$ function to display with decimal.
Oh yeah, I put the Input line at the bottom and your "paper" tape is above and will show your last 20 lines.

Now, no more the crazy stuff the default Single adds or subtracts from a number.

Instructions (some in the title):
"q" enter to quit (or just use the normal way).
"r" enter lets you read / review the paper tape simulation, scrollable with mouse wheel.
"c" enter lets you clear the screen, tape and running total
just enter allows you to add (or subtract if negative) the last amount entered.
So just enter positive and negative numbers for a running total to check receipt or balance checking account.

Code: QB64: [Select]
  1. _Title "Adding machine, use c to clear total, enter again to repeat an add, R to review tape" 'B+ 2019-08-20
  2. ' 2022-04-04 overhaul with input Cents (no decimal)
  3.  
  4. ReDim tape(0) As String
  5. Dim test$
  6. Dim As Long total, amt, quit, row, start, i
  7. row = 0
  8.  
  10.     Locate 25, 1: Input "Enter Cents Amount (no decimal), q to quit "; test$
  11.     If test$ = "q" Then
  12.         quit = -1
  13.     ElseIf test$ = "c" Then
  14.         Cls: total = 0
  15.         row = 0
  16.         ReDim tape(0) As String
  17.     ElseIf test$ = "r" Then
  18.         _KeyClear
  19.         show tape()
  20.         GoSub AndDisplay
  21.     ElseIf allNumber%(test$) Then
  22.         View Print 1 To 21
  23.         amt = Val(test$)
  24.         GoSub addAndDisplay
  25.     ElseIf test$ = "" Then ' just enter then repeat last amt
  26.         GoSub addAndDisplay
  27.     End If
  28.     _Limit 60
  29. Loop Until quit
  31.  
  32. addAndDisplay:
  33. total = total + amt
  34. s$ = dollars$(amt) + Space$(20 - Len(dollars$(amt)) - Len(dollars$(total))) + dollars$(total)
  35. sAppend tape(), s$
  36. row = row + 1
  37. AndDisplay:
  38. If row > 20 Then start = row - 20 Else start = 1
  40. For i = start To row
  41.     Print tape(i)
  44.  
  45. Function dollars$ (cents As Long)
  46.     s$ = _Trim$(Str$(cents))
  47.     If Left$(s$, 1) = "-" Then sign$ = "-": s$ = Mid$(s$, 2) Else sign$ = ""
  48.     If Len(s$) = 1 Then
  49.         s$ = sign$ + "0.0" + s$
  50.     ElseIf Len(s$) = 2 Then
  51.         s$ = sign$ + "0." + s$
  52.     Else
  53.         s$ = sign$ + Mid$(s$, 1, Len(s$) - 2) + "." + Mid$(s$, Len(s$) - 1)
  54.     End If
  55.     dollars$ = s$
  57.  
  58. Function allNumber% (s$)
  59.     If Len(s$) = 0 Then Exit Function
  60.     For i = 1 To Len(s$)
  61.         If InStr("-1234567890", Mid$(s$, i, 1)) <= 0 Then Exit Function 'done return 0
  62.     Next
  63.     allNumber% = -1
  65.  
  66. 'append to the string array the string item
  67. Sub sAppend (arr() As String, item As String)
  68.     ReDim _Preserve arr(LBound(arr) To UBound(arr) + 1) As String
  69.     arr(UBound(arr)) = item
  71.  
  72. Sub show (arr() As String)
  73.     Dim lb As Long, ub As Long, top As Long, i As Long, row As Long, prevrow As Long, n As Long
  74.     lb = LBound(arr): ub = UBound(arr)
  75.     If ub - lb + 1 < 21 Then top = ub Else top = lb + 19
  76.     Cls: Print "press any key to quit scroller..."
  77.     Locate 2, 1
  78.     For i = lb To top
  79.         Print arr(i)
  80.     Next
  81.     Do
  82.         If ub - lb + 1 > 20 Then
  83.             Do While _MouseInput
  84.                 If row >= lb Then row = row + _MouseWheel Else row = lb 'prevent under scrolling
  85.                 If row > ub - 19 Then row = ub - 19 'prevent over scrolling
  86.                 If prevrow <> row Then 'look for a change in row value
  87.                     If row >= lb And row <= ub - 19 Then
  88.                         Cls: Print "press any key to quit Review of tape..."
  89.                         Locate 2, 1
  90.                         For n = row To row + 19
  91.                             Print arr(n)
  92.                         Next
  93.                     End If
  94.                 End If
  95.                 prevrow = row 'store previous row value
  96.             Loop
  97.         End If
  98.     Loop Until InKey$ > ""
  100.  
  101.  
  102.  

PS If Long fits 10 years of seconds then that's how many cents the Total may add to before it's limit fails.

57
QB64 Discussion / Re: defsng math going off the rails, creating a total from list of numbers in file
« on: April 04, 2022, 08:38:14 pm »
@doppler have you tried Steve's suggestion with Long Type?

I made a sloppily coded adding machine that has same problem with singles collecting garbage .9999 stuff or .00006 for dollars and cents numbers, think I will try Longs and just show numbers with a decimal inserted 2 digits in from right, see how that works.

58
QB64 Discussion / Re: big number
« on: April 04, 2022, 06:17:57 pm »
Yes, Type _Integer64

and if all positive or 0 then use _unsigned _integer64

59
Programs / Re: and another one for your toolbox...
« on: April 04, 2022, 02:19:29 pm »
Quote from: NOVARSEG on April 04, 2022, 12:48:37 am
Ok im all rusty now but heh I remember the good ol days - labyrinth tiles, one line word editors, BMP viewers,  all the stuff we know and love

I'd ask where have you been, if you don't mind but that's for Discord. That's right they converted me.

60
QB64 Discussion / Re: defsng math going off the rails, creating a total from list of numbers in file
« on: April 04, 2022, 01:06:35 pm »
Quote from: doppler on April 04, 2022, 10:17:29 am
@bplus using read and data statements defeats the whole purpose.  I needed a double check way to verify some number tables.  Using a file with line by line entry of the numbers is faster and reusable.  I only need to change the file and re-execute.

Same difference when talking about Single precision and a Data Read is more convenient to forum folks, maybe next time put the bas and dat file in a zip, just a suggestion.

BTW my format$ fix fails if your totals kept going on and on... eventually the garbage will add up to significant difference specially if you start multiplying. Sorry if I was no help. I try.

Pages: 1 2 3 [4] 5 6 ... 537