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.


Topics - SierraKen

Pages: [1] 2 3 ... 11
1
Programs / 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.  
  19. Const xmax = 1500
  20. Const ymax = 659
  21. Const nDrops = 500
  22. Type dropType
  23.     x As Single
  24.     sz As Single
  25.     curY As Integer
  26.     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.  
  32. map& = _LoadImage("world_map.jpg", 32)
  33. Screen map&
  34. wide& = _Width(map&): deep& = _Height(map&)
  35.  
  36. Dim Array(wide& * deep&) As Long
  37.  
  38. _Source map& 'REQUIRED to GET the proper image area!
  39. Get (0, 0)-(wide& - 1, deep& - 1), Array(0)
  40.  
  42.  
  43. '-------------------------------------------------------------------------------------------------------
  44.  
  45. 'Screen _NewImage(xmax, ymax, 32)
  46. _ScreenMove 80, 0 'for snap shot
  47. '_FULLSCREEN 'as screen saver
  48.  
  49. ReDim Shared fileStrings$(1000) 'container for these program lines that will be dangling
  50.  
  51. 'Changed this name. ----------------------------------------
  52. Open "Matrix Rain 4 mod by SierraKen.bas" For Input As #1
  53. '----------------------------------------------------------------
  55.     Line Input #1, fs$
  56.     If Len(LTrim$(fs$)) <> 0 Then 'less empty spaces
  57.         fileStrings$(i) = LTrim$(fs$)
  58.         i = i + 1
  59.     End If
  62. ReDim _Preserve fileStrings$(i - 1)
  63. ' check loading
  64. 'FOR i = 0 TO UBOUND(fileStrings$)
  65. '    PRINT i, fileStrings$(i)
  66. 'NEXT
  67. 'END
  68.  
  69. 'setup drops
  70. Dim Shared drop(nDrops) As dropType
  71. Dim Shared s$(nDrops)
  72.  
  73. For i = 0 To nDrops
  74.     newDrop i, 1
  76.  
  77. While _KeyDown(27) = 0
  78.     Cls
  79.     'SierraKen's PUT statement ----------------------------
  80.     Put (0, 0), Array(0), PSet , _RGB(0, 0, 0)
  81.     '------------------------------------------------------
  82.  
  83.     For i = 0 To nDrops
  84.         drawDrop (i)
  85.         drop(i).curY = drop(i).curY + 1
  86.         If drop(i).curY > Len(s$(i)) Then newDrop i, 0
  87.     Next
  88.     _Display
  89.     _Limit 25
  91.  
  92. Sub newDrop (i, start)
  93.     drop(i).x = Rnd * xmax 'set location
  94.     drop(i).sz = randWeight(.3, 5, 3) 'set size  weighted on small sizes
  95.     'length of text string can fit on screen
  96.     charLength = ymax \ (drop(i).sz * 16) + 1 'from size determine how many chars fit on screen
  97.     randLine = Int(Rnd * UBound(fileStrings$)) 'pick a random program line
  98.     s$(i) = Mid$(fileStrings$(randLine), 1, charLength) 'here is text string to dangle
  99.     While Len(s$(i)) < charLength
  100.         If randLine + 1 > UBound(fileStrings$) Then randLine = 0 Else randLine = randLine + 1
  101.         s$(i) = Mid$(s$(i) + " : " + fileStrings$(randLine), 1, charLength)
  102.     Wend
  103.     If start <> 0 Then drop(i).curY = Int(Rnd * (charLength)) + 1 Else drop(i).curY = 1 'flat and readable at curY
  104.     drop(i).dxs = 1 / (Int(Rnd * 7) + 3) 'change of spin rate +-1/3, +-1/4, ... +-1/9
  105.     If Rnd < .5 Then drop(i).dxs = -drop(i).dxs
  107.  
  108. Sub drawDrop (i)
  109.     For j = 1 To drop(i).curY
  110.         d = drop(i).curY - j
  111.         If d = 0 Then
  112.             c~& = _RGBA32(255, 100, 255, 225)
  113.         ElseIf d = 1 Then
  114.             c~& = _RGBA32(255, 50, 255, 205)
  115.         ElseIf d = 2 Then
  116.             c~& = _RGBA32(255, 25, 255, 180)
  117.         ElseIf d >= 3 Then
  118.             c~& = _RGBA32(255, 0, 255, 190 - d * 5)
  119.         End If
  120.         rot = 1: dir = -1
  121.         For k = 0 To d
  122.             rot = rot + drop(i).dxs * dir
  123.             If rot > 1 Then dir = -1 * dir: rot = 1 + drop(i).dxs * dir
  124.             If rot < -1 Then dir = dir * -1: rot = -1 + drop(i).dxs * dir
  125.         Next
  126.         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
  127.     Next
  129.  
  130. Sub drwChar (char$, c As _Unsigned Long, midX, midY, xScale, yScale, Rotation) 'what ever the present color is set at
  131.     I& = _NewImage(8, 16, 32)
  132.     _Dest I&
  133.     Color c, _RGBA32(0, 0, 0, 0)
  134.     _PrintString (0, 0), char$
  135.     _Dest 0
  136.     RotoZoom2 midX, midY, I&, xScale, yScale, Rotation
  137.     _FreeImage I&
  139.  
  140. Sub RotoZoom2 (X As Long, Y As Long, Image As Long, xScale As Single, yScale As Single, Rotation As Single)
  141.     Dim px(3) As Single: Dim py(3) As Single
  142.     W& = _Width(Image&): H& = _Height(Image&)
  143.     px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
  144.     px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
  145.     sinr! = Sin(-Rotation): cosr! = Cos(-Rotation)
  146.     For i& = 0 To 3
  147.         x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + Y
  148.         px(i&) = x2&: py(i&) = y2&
  149.     Next
  150.     _MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
  151.     _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
  153.  
  154. Function randWeight (manyValue, fewValue, power)
  155.     randWeight = manyValue + Rnd ^ power * (fewValue - manyValue)
  157.  

2
Programs / Neon Clock
« on: March 23, 2022, 01:43:31 am »
A couple years ago someone told us how to get neon colors using a _GL Sub. I'm guessing it's only for Windows computers but I could be wrong. Anyway, I decided to dig it up tonight and make a Neon Clock. Using CLS and _DISPLAY doesn't work with it (it flashes too much), so instead of CLS on my usual clocks, I drew the neon circles for the clock and used a LINE command to delete the clock hands. Doing this I also added the trail-effect that B+ showed me when I first started. Tell me what you think. It also chimes the hour every hour. Here is a photo of it also below. By the way, how do you view larger photos on here that others are using, I only know the Attachments, thanks.

Code: QB64: [Select]
  1. _Title "Neon Clock by SierraKen"
  2. Screen _NewImage(600, 600, 32)
  3.  
  4. Type vec2
  5.     x As Single
  6.     y As Single
  8.  
  9. ReDim Shared vert(4024) As vec2, max_v_index
  10. Dim Shared rFactor!, gFactor!, bFactor!
  11. rFactor! = 0.5: gFactor! = 1: bFactor! = 0.5
  12.  
  14. For t = 0 To 360 Step .5
  15.     x2 = (Sin(t) * 260) + 400
  16.     y2 = (Cos(t) * 190) + 300
  17.     max_v_index = max_v_index + 1
  18.     vert(max_v_index).x = x2
  19.     vert(max_v_index).y = y2
  21.  
  22. For t = 1 To 359
  23.     For tt = t - 2 To t + 2 Step .5
  24.         x2 = Int((Sin(tt) * 230) + 400)
  25.         y2 = Int((Cos(tt) * 170) + 300)
  26.         max_v_index = max_v_index + 1
  27.         vert(max_v_index).x = x2
  28.         vert(max_v_index).y = y2
  29.     Next tt
  31.  
  33.     _Limit 30
  34.  
  35.     hours = Timer \ 3600
  36.     minutes = Timer \ 60 - hours * 60
  37.     seconds = (Timer - hours * 3600 - minutes * 60)
  38.     ho$ = Left$(Time$, 2): hou = Val(ho$)
  39.     min$ = Mid$(Time$, 4, 2): minu = Val(min$)
  40.     seco$ = Right$(Time$, 2): secon = Val(seco$)
  41.  
  42.     'Minutes
  43.     m = 180 - minutes * 6
  44.     xx = Int(Sin(m / 180 * 3.141592) * 120) + 300
  45.     yy = Int(Cos(m / 180 * 3.141592) * 120) + 304
  46.     For b = -5 To 5 Step .1
  47.         Line (300 + b, 304)-(xx, yy), _RGB32(0, 255, 255)
  48.         Line (300, 304 + b)-(xx, yy), _RGB32(0, 255, 255)
  49.     Next b
  50.     'Hours
  51.     h = 360 - hours * 30 + 180
  52.     xxx = Int(Sin(h / 180 * 3.141592) * 100) + 300
  53.     yyy = Int(Cos(h / 180 * 3.141592) * 100) + 304
  54.     For b = -5 To 5 Step .1
  55.         Line (300 + b, 304)-(xxx, yyy), _RGB32(0, 255, 0)
  56.         Line (300, 304 + b)-(xxx, yyy), _RGB32(0, 255, 0)
  57.     Next b
  58.     'Seconds
  59.     s = (60 - seconds) * 6 + 180
  60.     xxxx = Int(Sin(s / 180 * 3.141592) * 125) + 300
  61.     yyyy = Int(Cos(s / 180 * 3.141592) * 125) + 304
  62.     For b = -5 To 5 Step .1
  63.         Line (300 + b, 304)-(xxxx, yyyy), _RGB32(255, 0, 0)
  64.         Line (300, 304 + b)-(xxxx, yyyy), _RGB32(255, 0, 0)
  65.     Next b
  66.     _Display
  67.     Line (175, 175)-(425, 440), _RGB32(0, 0, 0, 5), BF
  68.  
  69.     'Chimes
  70.     If minu = 0 And secon = 0 Then
  71.         hour2 = hou
  72.         If hour2 > 12 Then hour2 = hour2 - 12
  73.         If hour2 = 0 Then hour2 = 12
  74.         For chimes = 1 To hour2
  75.             ttt = 0
  76.             Do
  77.                 'queue some sound
  78.                 Do While _SndRawLen < 0.1 'you may wish to adjust this
  79.                     sample = Sin(ttt * 340 * Atn(1) * 8) '340Hz sine wave (ttt * 440 * 2p)
  80.                     sample = sample * Exp(-ttt * 3) 'fade out eliminates clicks after sound
  81.                     _SndRaw sample
  82.                     ttt = ttt + 1 / _SndRate 'sound card sample frequency determines time
  83.                 Loop
  84.                 'do other stuff, but it may interrupt sound
  85.             Loop While ttt < 2 'play for 2 seconds
  86.             Do While _SndRawLen > 0 'Finish any left over queued sound!
  87.             Loop
  88.         Next chimes
  89.     End If
  90.     two:
  92.  
  94.  
  95. Sub _GL ()
  96.     Static glInit
  97.     If glInit = 0 Then
  98.         glInit = 1
  99.  
  100.     End If
  102.     'set the gl screen so that it can work normal screen coordinates
  103.     _glTranslatef -1, 1, 0
  104.     _glScalef 1 / 400, -1 / 300, 1
  105.  
  106.     _glEnable _GL_BLEND
  107.  
  108.     _glBlendFunc _GL_SRC_ALPHA, _GL_ONE
  109.     _glEnableClientState _GL_VERTEX_ARRAY
  110.     _glVertexPointer 2, _GL_FLOAT, 0, _Offset(vert())
  111.     For j = 1 To 15
  112.         _glColor4f rFactor!, gFactor!, bFactor!, 0.015
  113.         _glPointSize j
  114.         _glDrawArrays _GL_POINTS, 10, max_v_index
  115.     Next
  116.     _glFlush
  118.  

3
Programs / Rotating Flower
« on: March 21, 2022, 08:00:51 pm »
Many of you have probably seen this before and have made it before. But without looking at any of your code, except for the Wiki pages, I decided to try it myself. This flower has 3 layers and the pedals keep going around and around because there is no way to stop it and look right that I can figure out. It's because the last pedal is placed on top of both the left and the right (the first) pedal and won't go underneath the first pedal. There might be a way around this using advanced math or maybe even using the POINT command, but since I'm using the ROTOZOOM Sub that I found in the Wiki pages, this is as good as I can get. Check it out. :) Oh by the way, something tells me that there was a RotoZoom command, without having to use the Sub, but I couldn't find it in the Wiki. I'll place a photo of this flower below.

Code: QB64: [Select]
  1. _Title "Ken's Rotating Flower"
  2. Dim image As Long
  3. Screen _NewImage(800, 600, 32)
  4.  
  5. For tt = 0 To _Pi Step .2
  6.     For t = 1 To 20 Step .1
  7.         Circle (400 + t, 150 + tt), 100, _RGB32(255, 0, 0), _Pi, ((3 * _Pi) / 2)
  8.         Circle (298 + t, 250 + tt), 100, _RGB32(255, 0, 0), (2 * _Pi), (_Pi / 2)
  9.     Next t
  10. Next tt
  11. Paint (350, 200), _RGB32(255, 255, 128), _RGB32(255, 0, 0)
  12.  
  13. image& = _CopyImage(0)
  15. 'sky
  16. Paint (1, 1), _RGB32(128, 255, 255)
  17. zoom = 1.5
  18. zoom2 = .5
  19. zoom3 = .2
  21.     _Limit 20
  22.     RotoZoom 400, 300, image&, zoom, angle
  23.     RotoZoom 400, 300, image&, zoom2, angle
  24.     RotoZoom 400, 300, image&, zoom3, angle
  25.     _Display
  26.     angle = angle + 20
  27.     If angle >= 360 Then Paint (400, 300), _RGB32(255, 255, 128), _RGB32(255, 0, 0): angle = 0
  28.     _Delay .1
  30.  
  31.  
  32. Sub RotoZoom (X As Long, Y As Long, image&, Scale As Single, Rotation As Single)
  33.     Dim px(3) As Single: Dim py(3) As Single
  34.     W& = _Width(image&): H& = _Height(image&)
  35.     px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
  36.     px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
  37.     sinr! = Sin(-Rotation / 57.2957795131): cosr! = Cos(-Rotation / 57.2957795131)
  38.     For i& = 0 To 3
  39.         x2& = (px(i&) * cosr! + sinr! * py(i&)) * Scale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * Scale + Y
  40.         px(i&) = x2&: py(i&) = y2&
  41.     Next
  42.     _MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
  43.     _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
  45.  

4
Programs / Flower
« on: March 20, 2022, 08:06:58 pm »
I made my first rose today for the First Day of Spring. I posted the picture of it below.

Code: QB64: [Select]
  1. Screen _NewImage(800, 600, 32)
  2. _Title "Happy First Day Of Spring!"
  3.  
  5. Paint (1, 1), _RGB32(128, 255, 255)
  6. For sz = .1 To 600 Step .1
  7.     Circle (400, 900), sz, _RGB32(127, 255, 127)
  8. Next sz
  9.  
  10. Line (398, 300)-(402, 250), _RGB32(127, 255, 0), BF
  11.  
  12. For sz2 = -5 To 5 Step .5
  13.     Circle (400 - sz2, 150 + sz2), sz2 + 100, _RGB32(255, 0, 0), _Pi, (3 * _Pi) / 2
  14.     Circle (300 + sz2, 250 - sz2), sz2 + 100, _RGB32(255, 0, 0), (2 * _Pi), _Pi / 2
  15. Next sz2
  16.  
  17. For sz3 = -5 To 5 Step .5
  18.     Circle (400 + sz3, 150 + sz3), sz3 + 100, _RGB32(255, 0, 0), (3 * _Pi) / 2, 2 * _Pi
  19.     Circle (500 - sz3, 250 - sz3), sz3 + 100, _RGB32(255, 0, 0), (_Pi / 2), _Pi
  20. Next sz3
  21.  
  22. Line (399, 200)-(401, 150), _RGB32(127, 255, 127), BF
  23. For sz4 = .1 To 5 Step .1
  24.     Circle (400, 145), sz4, _RGB32(255, 255, 127)
  25. Next sz4
  26.  
  27. Paint (375, 225), _RGB32(255, 0, 1), _RGB32(255, 0, 0)
  28. Paint (425, 225), _RGB32(255, 0, 1), _RGB32(255, 0, 0)
  29.  
  32.  

5
Programs / Terrain Grid
« on: March 16, 2022, 09:29:06 pm »
Using Petr's Sound Visualization code, I converted it to this small simulation of flying over a green terrain grid and a blue sky. I might look into this more sometime to see if there is ways to turn, etc. But here is the general code for it. I started this new thread so it wouldn't take over Petr's and in case anyone wants to make mods of it. 
Petr's Music Visualization code is here: https://qb64forum.alephc.xyz/index.php?topic=4719.0

Code: QB64: [Select]
  1. 'Almost all of this code comes from Petr's Music Visualizer.
  2. Screen _NewImage(800, 600, 32)
  4.     ShiftIt = 89
  5.     $NoPrefix
  6.     Dest Texture
  7.     Cls
  8.     Paint (1, 1), _RGB32(127, 255, 127)
  9.     For diY = 0 To 100
  10.         Line (diY + 20, diY + 20)-(235 - diY, 235 - diY), RGB32(0, diY, 0), B
  11.     Next
  12.     Dest 0
  13.     Dim M3D(90, 90) As Single
  14.     Dim M2D(90, 90) As Single
  15.     DW = 800
  16.     DH = 600
  17.     HT = CopyImage(Texture, 33)
  18.     If Texture <> 0 Then FreeImage Texture
  19.     Screen NewImage(DW, DH, 32)
  20.     Do Until ShiftIt < 0
  21.         For rows = 0 To 90
  22.             Swap M3D(rows, ShiftIt), M3D(rows, ShiftIt + 1)
  23.             Swap M2D(rows, ShiftIt), M2D(rows, ShiftIt + 1)
  24.         Next
  25.         ShiftIt = ShiftIt - 1
  26.     Loop
  27.     Depth = 0
  28.     Do Until Depth = 90000
  29.         M3D(ra, 0) = Rnd * 2.5
  30.         M2D(ra, 0) = Rnd * 2.5
  31.         Depth = Depth + 1000
  32.         ra = ra + 1
  33.     Loop
  34.  
  35.     ra = 0
  36.  
  37.     For Z = 0 To 89
  38.         For X = 0 To 89
  39.             HX = -45 + X
  40.             HX2 = HX + 1
  41.             HZ = -89 + Z
  42.             HZ2 = HZ + 1
  43.             HY1 = -3 + M3D(X, Z): HY2 = -3 + M3D(X + 1, Z): HY3 = -3 + M3D(X, Z + 1): HY4 = -3 + M3D(X + 1, Z + 1)
  44.             HY11 = 3 - M2D(X, Z): HY12 = 3 - M2D(X + 1, Z): HY13 = 3 - M2D(X, Z + 1): HY14 = 3 - M2D(X + 1, Z + 1)
  45.             'Ground
  46.             MapTriangle (0, 0)-(255, 0)-(0, 255), HT To(HX, HY1, HZ)-(HX2, HY2, HZ)-(HX, HY3, HZ2), 0, Smooth
  47.             MapTriangle (255, 0)-(0, 255)-(255, 255), HT To(HX2, HY2, HZ)-(HX, HY3, HZ2)-(HX2, HY4, HZ2), 0, Smooth
  48.             'Ceiling
  49.             'MapTriangle (0, 0)-(255, 0)-(0, 255), HT To(HX, HY11, HZ)-(HX2, HY12, HZ)-(HX, HY13, HZ2), 0, Smooth
  50.             'MapTriangle (255, 0)-(0, 255)-(255, 255), HT To(HX2, HY12, HZ)-(HX, HY13, HZ2)-(HX2, HY14, HZ2), 0, Smooth
  51.     Next X, Z
  52.     'Sky
  53.     Paint (1, 1), _RGB32(128, 255, 255)
  54.     Display
  55.     Limit 20
  56.  
  58.  

6
Programs / Happy _PI Day!
« on: March 14, 2022, 12:18:44 pm »
Happy 3.14 _PI Day!

Here are some orbits I made today.

Code: QB64: [Select]
  1. Screen _NewImage(800, 600, 32)
  2. tilt = 60
  4.     _Limit 300
  5.     Circle (400, 200), 30, _RGB32(127, 255, 255)
  6.  
  7.     seconds = seconds + .1
  8.     If seconds > 59 Then seconds = 0
  9.     s = (60 - seconds) * 6 + 180
  10.     x = Int(Sin(s / 180 * _Pi) * 125) + 400
  11.     y = Int(Cos(s / 180 * _Pi) * 125 / tilt) + 200
  12.     Circle (x, y), 5, _RGB32(255, 0, 0)
  13.     seconds2 = seconds2 + .1
  14.     If seconds2 > 59 Then seconds2 = 0
  15.     s2 = (60 - seconds2) * 6 + 180
  16.     x2 = Int(Sin(s2 / 180 * _Pi) * 125) + 400
  17.     y2 = Int(Cos(s2 / 180 * _Pi) * 125 + tilt) + 200
  18.     Circle (x2, y2), 5, _RGB32(255, 0, 0)
  19.     seconds3 = seconds3 - .1
  20.     If seconds3 > 59 Then seconds3 = 0
  21.     s3 = (60 - seconds3) * 6 + 180
  22.     x3 = Int(Sin(s3 / 180 * _Pi) * 125) + 400
  23.     y3 = Int(Cos(s3 / 180 * _Pi) * 125 - tilt) + 200
  24.     Circle (x3, y3), 5, _RGB32(255, 0, 0)
  25.  
  26.     _Delay .002
  27.     _Display
  28.     Cls
  30.  

7
Programs / Peace Sign
« on: March 09, 2022, 08:13:17 pm »
This is a peace sign I just threw together. The colors of the sign change and then go back and start over.

Code: QB64: [Select]
  1. _Title "Peace - press Esc to quit app."
  2. Screen _NewImage(800, 600, 32)
  3. r = 50: g = 1: b = 1
  4. _Limit 100
  6.     If r < 256 Then r = r + .005
  7.     If r > 255 Then r2 = 1
  8.     If b < 256 And r2 = 1 Then b = b + .005
  9.     If b > 255 Then b2 = 1
  10.     If g < 256 And r2 = 1 And b2 = 1 Then g = g + .005
  11.     If g > 255 Then r2 = 0: b2 = 0: r = 1: b = 1: g = 1
  12.  
  13.     x = x + .01
  14.     y = y + .01
  15.     Line (0, y)-(x, 0), _RGB32(r, g, b)
  16.     If y > 2000 Then GoTo design:
  18. design:
  19.  
  20. For cir = .1 To 100 Step .1
  21.     Circle (400, 300), cir, _RGB32(127 - cir, 255 / cir, 255 / cir)
  22. Next cir
  24.     bl = bl + 1
  25.     If bl > 254 Then bl = 1
  26.     gr = gr + 1
  27.     If gr > 254 Then gr = 1
  28.     re = red + 1
  29.     If re > 254 Then re = 1
  30.     For thick = .1 To 10 Step .1
  31.         Circle (400, 300), 90 + thick, _RGB32(re, gr, bl)
  32.     Next thick
  33.  
  34.     seconds = 29.99
  35.     s = (60 - seconds) * 6 + 180
  36.     x2 = Int(Sin(s / 180 * 3.141592) * 100) + 400
  37.     y2 = Int(Cos(s / 180 * 3.141592) * 100) + 300
  38.     Line (400, 300)-(x2, y2), _RGB32(re, gr, bl)
  39.     seconds = 60
  40.     s = (60 - seconds) * 6 + 180
  41.     x2 = Int(Sin(s / 180 * 3.141592) * 100) + 400
  42.     y2 = Int(Cos(s / 180 * 3.141592) * 100) + 300
  43.     Line (400, 300)-(x2, y2), _RGB32(re, gr, bl)
  44.     seconds = 20
  45.     s = (60 - seconds) * 6 + 180
  46.     x2 = Int(Sin(s / 180 * 3.141592) * 100) + 400
  47.     y2 = Int(Cos(s / 180 * 3.141592) * 100) + 300
  48.     Line (400, 300)-(x2, y2), _RGB32(re, gr, bl)
  49.     seconds = 40
  50.     s = (60 - seconds) * 6 + 180
  51.     x2 = Int(Sin(s / 180 * 3.141592) * 100) + 400
  52.     y2 = Int(Cos(s / 180 * 3.141592) * 100) + 300
  53.     Line (400, 300)-(x2, y2), _RGB32(re, gr, bl)
  54.  
  55.     _Delay .02
  56.     If bl = 254 Then _Delay 1
  58.  


8
Programs / Rosie Bot
« on: February 24, 2022, 01:58:52 pm »
Hi all. I decided to play around with the Microsoft Windows text-to-speech stuff some more by making a simple chat bot that I named Rosie. There's a few questions that Rosie answers and I also decided to add a .txt file for the user to be able to make their own bot by adding as many questions and answers as they wish. To do that, simply type: add, or addon, or add question and it will go to that mode. It's not perfect of course and I haven't tested it fully, like if someone adds a question that it already has (either in the botaddon file or internally in the bot) but I'm guessing it would just answer with both answers, possibly speaking both at the same time. If that happens, or any other botaddon.txt problem, just open up the .txt file with Notepad and carefully erase the --- line above it, the question, and the answer. I will put all of this in the comments section of the code at the start so programmers know. But have fun with it, that's why I made it. :) Also tell me what you think. Thanks.

The 2 files are zipped in Rosie Bot.zip and placed in the attachments of this post. Put these 2 files in the same folder.

Edit: Attachment deleted, please see the replies below to get the newest one.

9
Programs / The Date For Non-Orthodox Easter Calculation
« on: February 22, 2022, 12:18:18 am »
Here is a small program that calculates the date of Easter for any given year.
I use the same code that's on my calendar maker. Since it uses the Gregorian Calendar,  it starts at 1753 A.D. This is for the Non-Orthodox Easter date.

Code: QB64: [Select]
  1. 'What Is The Date For Easter (Non-Orthodox)
  2. 'By SierraKen
  3. 'Equation Code found online.
  4.  
  5. _Title "What Is The Date For Easter"
  6. start:
  9. start2:
  11. Input "          Year (Higher Than 1753 A.D.): ", PQA
  12. If PQA < 1753 Then Print: Print "          Your year is too long ago for the Gregorian Calendar, try again.": GoTo start2:
  13. If PQA <> Int(PQA) Then Print "          Cannot use decimals, try again.": GoTo start2:
  14. GoSub PAQUES:
  16. If pqm = 3 Then month$ = "March"
  17. If pqm = 4 Then month$ = "April"
  18.  
  19. day$ = Str$(PQJ)
  20. year$ = Str$(PQA)
  23. Print "          Easter Date: " + month$ + " " + day$ + ", " + year$
  28. Input "          More (Y/N):", yn$
  29. If Left$(yn$, 1) = "y" Or Left$(yn$, 1) = "Y" Then GoTo start:
  31.  
  32. 'Find the right date for Easter.
  33. PAQUES:
  34. pqm = Int(PQA / 100): PQ1 = PQA - pqm * 100: PQJ = Int(((PQA / 19 - Int(PQA / 19)) + .001) * 19)
  35. PQ2 = Int(pqm / 4): PQ3 = Int(((pqm / 4) - PQ2 + .001) * 4): PQ4 = Int((8 + pqm) / 25)
  36. PQ5 = Int((1 + pqm - PQ4 + .001) / 3): PQ4 = (15 + 19 * PQJ + pqm - PQ2 - PQ5 + .001) / 30: PQ4 = PQ4 - Int(PQ4)
  37. PQ4 = Int(PQ4 * 30): PQ5 = Int(PQ1 / 4): PQ6 = ((PQ1 / 4) - PQ5) * 4
  38. PQ7 = (32 + 2 * PQ3 + 2 * PQ5 - PQ4 - PQ6 + .001) / 7: PQ7 = (PQ7 - Int(PQ7)) * 7: PQ6 = (PQJ + 11 * PQ4 + 22 * PQ7) / 451
  39. PQ6 = Int(PQ6): PQ2 = (114 + PQ4 + PQ7 - 7 * PQ6) / 31: pqm = Int(PQ2): PQJ = Int((PQ2 - pqm + .001) * 31 + 1)
  41.  

 

10
Programs / Ken's U.S. Flag version 4 - With moving clouds
« on: February 09, 2022, 12:47:16 am »
Tonight I was going over a list of my old apps I made and remembered that I made a U.S. flag. So I found one I made that is waving and has random hills in the background and decided to add the new moving clouds in the sky that Vince has been using. Just by chance the flag is moving the same direction as the clouds. :) Press the Space Bar to get different random hills. Feel free to mod mod mod. :D Thanks Vince and someone named rattrapmax6!

(Code deleted because of a memory leak, please get the one below instead.)

11
Programs / 4 Letter Word Invaders Game
« on: February 05, 2022, 08:47:14 pm »
Test your typing skills by typing a random 4 letter word that falls as you type. There are 500 4-letter words that it chooses from. Get 40 right before losing all your lives wins. It's possible the same word is used more than once. Others may have made this game in the past, I'm pretty sure I saw it back in the 90's somewhere. But I thought I would give it a try myself. Each word you type right makes the next one go faster. No need to press the Enter key, it uses INKEY$. I've played a couple times and can only get to 39. Good luck!

Code: QB64: [Select]
  1. '4 Letter Word Invaders Game
  2. 'By SierraKen on Feb. 5, 2022
  3. '
  4. 'Test your typing skills by typing each word that falls. No need press the Enter key.
  5. 'The more you get right, the faster it goes. 40 points wins. Good Luck!
  6.  
  7. Dim a$(600)
  8. For t = 1 To 500
  9.     Read a$(t)
  11. Screen _NewImage(800, 600, 32)
  12. Color _RGB32(255, 255, 255)
  14. start:
  15. score = 0
  16. speed = .5
  17. lives = 5
  18. score$ = Str$(score)
  19. lives$ = Str$(lives)
  20. s$ = "Score: " + score$ + " Lives: " + lives$
  22.  
  24.     x = Rnd * 750
  25.     y = 5
  26.     tt = Int(Rnd * 500) + 1
  27.     word$ = a$(tt)
  28.     c = 1
  29.     Do
  30.         y = y + 10
  31.         If y > 500 Then
  32.             Sound 250, 1
  33.             Sound 150, 1
  34.             lives = lives - 1
  35.             score$ = Str$(score)
  36.             lives$ = Str$(lives)
  37.             s$ = "Score: " + score$ + " Lives: " + lives$
  38.             _Title s$
  39.             If lives = 0 Then
  40.                 Print "    Y o u  L o s e !"
  41.                 Print: Print
  42.                 Input "Again (Y/N)"; ag$
  43.                 If Left$(ag$, 1) = "y" Or Left$(ag$, 1) = "Y" Then GoTo start:
  44.                 End
  45.             End If
  46.             GoTo more:
  47.         End If
  48.         _PrintString (x, y), word$
  49.         Locate 25, 1
  50.         Print "->";
  51.         w$ = InKey$
  52.         If w$ = Chr$(27) Then End
  53.         Locate 25, 3 + c: Print w$
  54.         If w$ <> "" Then
  55.             If w$ = Mid$(word$, c, 1) Then
  56.                 c = c + 1
  57.                 If c > 4 Then
  58.                     Sound 850, .5
  59.                     speed = speed - .0125
  60.                     score = score + 1
  61.                     score$ = Str$(score)
  62.                     lives$ = Str$(lives)
  63.                     s$ = "Score: " + score$ + " Lives: " + lives$
  64.                     _Title s$
  65.                     If score = 40 Then
  66.                         Print "    Y O U   W I N ! ! ! ! ! ! !"
  67.                         Print: Print
  68.                         Input "Again (Y/N)"; ag$
  69.                         If Left$(ag$, 1) = "y" Or Left$(ag$, 1) = "Y" Then GoTo start:
  70.                         End
  71.                     End If
  72.                     _Display
  73.                     Cls
  74.                     GoTo more:
  75.                 End If
  76.             Else
  77.                 c = 1
  78.             End If
  79.         End If
  80.         _Delay speed
  81.         _Display
  82.         Cls
  83.     Loop
  84.     more:
  86.  
  87. Data able,acid,aged,also,area,army,away,baby,back,ball
  88. Data band,bank,base,bath,bear,beat,been,beer,bell,belt
  89. Data best,bill,bird,blow,blue,boat,body,bomb,bond,bone
  90. Data book,boom,born,boss,both,bowl,bulk,burn,bush,busy
  91. Data call,calm,came,camp,card,care,case,cash,cast,cell
  92. Data chat,chip,city,club,coal,coat,code,cold,come,cook
  93. Data cool,cope,copy,core,cost,crew,crop,dark,data,date
  94. Data dawn,days,dead,deal,dean,dear,debt,deep,deny,desk
  95. Data dial,dock,diet,disc,disk,does,done,door,dose,down
  96. Data draw,drew,drop,drug,dual,duke,dust,duty,each,earn
  97. Data ease,east,easy,edge,else,even,ever,evil,exit,face
  98. Data fact,fail,fair,fall,farm,fast,fate,fear,feed,feel
  99. Data feet,fell,felt,file,fill,film,find,fine,fire,firm
  100. Data fish,five,flat,flow,food,foot,ford,form,fort,four
  101. Data free,from,fuel,full,fund,gain,game,gate,gave,gear
  102. Data gene,gift,girl,give,glad,goal,goes,gold,Golf,gone
  103. Data good,gray,grew,grey,grow,gulf,hair,half,hall,hand
  104. Data hang,hard,harm,hate,have,head,hear,heat,held,hell
  105. Data help,here,hero,high,hill,hire,hold,hole,holy,home
  106. Data hope,host,hour,huge,hung,hunt,hurt,idea,inch,into
  107. Data iron,item,jack,jane,jean,john,join,jump,jury,just
  108. Data keen,keep,kent,kept,kick,kill,kind,king,knee,knew
  109. Data know,lack,lady,laid,lake,land,lane,last,late,lead
  110. Data left,less,life,lift,like,line,link,list,live,load
  111. Data loan,lock,logo,long,look,lord,lose,loss,lost,love
  112. Data luck,made,mail,main,make,male,many,mark,mass,matt
  113. Data meal,mean,meat,meet,menu,mere,mike,mile,milk,mill
  114. Data mind,mine,miss,mode,mood,moon,more,most,move,much
  115. Data must,name,navy,near,neck,need,news,next,nice,nick
  116. Data nine,none,nose,note,okay,once,only,onto,open,oral
  117. Data over,pace,pack,page,paid,pain,pair,palm,park,part
  118. Data pass,past,path,peak,pick,pink,pipe,plan,play,plot
  119. Data plug,plus,poll,pool,poor,port,post,pull,pure,push
  120. Data race,rail,rain,rank,rare,rate,read,real,rear,rely
  121. Data rent,rest,rice,rich,ride,ring,rise,risk,road,rock
  122. Data role,roll,roof,room,root,rose,rule,rush,ruth,safe
  123. Data said,sake,sale,salt,same,sand,save,seat,seed,seek
  124. Data seem,seen,self,sell,send,sent,sept,ship,shop,shot
  125. Data show,shut,sick,side,sign,site,size,skin,slip,slow
  126. Data snow,soft,soil,sold,sole,some,song,soon,sort,soul
  127. Data spot,star,stay,step,stop,such,suit,sure,take,tale
  128. Data talk,tall,tank,tape,task,team,tech,tell,tend,term
  129. Data test,text,than,that,them,then,they,thin,this,thus
  130. Data till,time,tiny,told,toll,tone,tony,took,tool,tour
  131. Data town,tree,trip,true,tune,turn,twin,type,unit,upon
  132. Data used,user,vary,vast,very,vice,view,vote,wage,wait
  133. Data wake,walk,wall,want,ward,warm,wash,wave,ways,weak
  134. Data wear,week,well,went,were,west,what,when,whom,wide
  135. Data wife,wild,will,wind,wine,wing,wire,wise,wish,with
  136. Data wood,word,wore,work,yard,yeah,year,your,zero,zone
  137.  

12
Programs / Tool to convert word list to DATA lines
« on: February 05, 2022, 04:02:27 pm »
I've been thinking about making some kind of word game, so I found a list online of 549 4-letter words, which I might use. But I needed a tool to convert 549 lines of a text file to DATA lines with 10 words on each line. So I decided to make this tool. It doesn't put quotation marks around the words which an awesome thing about QB64 is that you don't need them. :) I'll post the app code first, then the original list of words, then an output text file I made with it (you can make any kind of text-type file with it including .bas). I hope some of you can use this, I know I will. :)
I'm sure you can also use this with a list of numbers, but I haven't tried that yet.

*Edit: An updated version is after this post.

Here is the list to DATA lines tool:
Code: QB64: [Select]
  1. 'This is a tool to convert a list of words or numbers to DATA lines.
  2. Input "Filename To Read From: "; filename$
  3. Input "Filename To Output To: "; filename2$
  4. Open filename$ For Input As #1
  5. Open filename2$ For Output As #2
  7.     For words = 1 To 10
  8.         Input #1, a$
  9.         If words = 1 Then
  10.             b$ = "DATA " + a$ + ", "
  11.             Print #2, b$;
  12.         Else
  13.             If words < 10 Then
  14.                 c$ = a$ + ", "
  15.                 Print #2, c$;
  16.                 If EOF(1) Then GoTo done:
  17.             Else
  18.                 c$ = a$
  19.                 Print #2, c$
  20.                 If EOF(1) Then GoTo done:
  21.             End If
  22.         End If
  23.     Next words
  25. done:
  28.  

Here is the original list of words I used:
Code: QB64: [Select]
  1. Area
  2. Army
  3. Baby
  4. Back
  5. Ball
  6. Band
  7. Bank
  9. Bill
  10. Body
  11. Book
  13. Card
  14. Care
  16. Cash
  17. City
  18. Club
  19. Cost
  20. Date
  21. Deal
  22. Door
  23. Duty
  24. East
  25. Edge
  26. Face
  27. Fact
  28. Farm
  29. Fear
  30. Fig
  31. File
  32. Film
  33. Fire
  34. Firm
  35. Fish
  36. Food
  37. Foot
  38. Form
  39. Fund
  40. Game
  41. Girl
  42. Goal
  43. Gold
  44. Hair
  45. Half
  46. Hall
  47. Hand
  48. Head
  49. Help
  50. Hill
  51. Home
  52. Hope
  53. Hour
  54. Idea
  55. Jack
  56. John
  57. Kind
  58. King
  59. Lack
  60. Lady
  61. Land
  62. Life
  65. Look
  66. Lord
  67. Loss
  68. Love
  69. Mark
  70. Mary
  71. Mind
  72. Miss
  73. Move
  75. Need
  76. News
  77. Note
  78. Page
  79. Pain
  80. Pair
  81. Park
  82. Part
  83. Past
  84. Path
  85. Paul
  86. Plan
  88. Post
  89. Race
  90. Rain
  91. Rate
  92. Rest
  93. Rise
  94. Risk
  95. Road
  96. Rock
  97. Role
  98. Room
  99. Rule
  100. Sale
  101. Seat
  102. Shop
  103. Show
  104. Side
  105. Sign
  106. Site
  107. Size
  108. Skin
  109. Sort
  110. Star
  112. Task
  113. Team
  114. Term
  115. Test
  116. Text
  117. Time
  118. Tour
  119. Town
  120. Tree
  121. Turn
  123. Unit
  124. User
  126. Wall
  127. Week
  128. West
  129. Wife
  130. Will
  131. Wind
  132. Wine
  133. Wood
  134. Word
  135. Work
  136. Year
  137. Dese
  138. Enuf
  139. Feel
  140. Hern
  141. Hers
  142. Many
  143. Mine
  144. Mine
  145. Much
  146. Nada
  147. Nish
  148. None
  149. Nowt
  150. Ours
  151. Same
  152. Self
  153. Some
  154. Such
  155. That
  156. Thee
  157. Them
  158. They
  159. This
  160. Thon
  161. Thor
  162. Thou
  163. Thou
  164. Tone
  165. What
  166. When
  167. Whom
  168. Yere
  169. Your
  170. Bear
  171. Beat
  172. Blow
  173. Burn
  175. Care
  176. Cast
  177. Come
  178. Cook
  179. Cope
  180. Cost
  181. Dare
  182. Deal
  183. Deny
  185. Drop
  186. Earn
  187. Face
  188. Fail
  189. Fall
  190. Fear
  191. Feel
  192. Fill
  193. Find
  194. Form
  195. Gain
  196. Give
  197. Grow
  198. Hang
  199. Hate
  200. Have
  201. Head
  202. Hear
  203. Help
  204. Hide
  205. Hold
  206. Hope
  207. Hurt
  208. Join
  209. Jump
  210. Keep
  212. Know
  213. Land
  214. Last
  215. Lead
  216. Lend
  217. Lift
  218. Like
  219. Link
  220. Live
  221. Look
  222. Lose
  223. Love
  224. Make
  225. Mark
  226. Meet
  227. Mind
  228. Miss
  229. Move
  230. Must
  232. Need
  233. Note
  235. Pass
  236. Pick
  237. Plan
  239. Pray
  240. Pull
  241. Push
  243. Rely
  244. Rest
  245. Ride
  246. Ring
  247. Rise
  248. Risk
  249. Roll
  250. Rule
  251. Save
  253. Seem
  254. Sell
  255. Send
  256. Shed
  257. Show
  258. Shut
  259. Sign
  260. Sing
  261. Slip
  262. Sort
  263. Stay
  266. Suit
  267. Take
  268. Talk
  269. Tell
  270. Tend
  271. Test
  272. Turn
  273. Vary
  275. Vote
  277. Wake
  278. Walk
  279. Want
  280. Warn
  281. Wash
  282. Wear
  283. Will
  284. Wish
  285. Work
  286. Able
  287. Back
  288. Bare
  289. Bass
  290. Blue
  291. Bold
  292. Busy
  293. Calm
  294. Cold
  295. Cool
  296. Damp
  297. Dark
  298. Dead
  299. Deaf
  300. Dear
  301. Deep
  302. Dual
  303. Dull
  304. Dumb
  305. Easy
  306. Evil
  307. Fair
  308. Fast
  309. Fine
  310. Firm
  311. Flat
  312. Fond
  313. Foul
  315. Full
  316. Glad
  317. Good
  318. Grey
  319. Grim
  320. Half
  321. Hard
  322. Head
  323. High
  324. Holy
  325. Huge
  326. Just
  327. Keen
  328. Kind
  329. Last
  330. Late
  331. Lazy
  332. Like
  333. Live
  334. Lone
  336. Loud
  337. Main
  338. Male
  339. Mass
  340. Mean
  341. Mere
  342. Mild
  343. Nazi
  344. Near
  345. Neat
  347. Nice
  348. Okay
  351. Oral
  352. Pale
  353. Past
  354. Pink
  355. Poor
  356. Pure
  357. Rare
  358. Real
  359. Rear
  360. Rich
  361. Rude
  362. Safe
  363. Same
  364. Sick
  365. Slim
  366. Slow
  367. Soft
  368. Sole
  369. Sore
  370. Sure
  371. Tall
  373. Thin
  374. Tidy
  375. Tiny
  376. Tory
  377. True
  378. Ugly
  379. Vain
  380. Vast
  381. Very
  382. Vice
  383. Warm
  384. Wary
  385. Weak
  386. Wide
  387. Wild
  388. Wise
  389. Zero
  390. Both
  392. Ergo
  393. Lest
  394. Like
  395. Once
  397. Plus
  398. Save
  399. Sith
  400. Than
  401. That
  403. Thou
  404. Till
  405. Unto
  406. When
  407. Some
  408. Ably
  409. Afar
  410. Anew
  411. Away
  412. Back
  413. Damn
  414. Dead
  415. Deep
  416. Down
  417. Duly
  418. Easy
  420. Even
  421. Ever
  422. Fair
  423. Fast
  424. Flat
  425. Full
  426. Good
  427. Half
  428. Hard
  429. Here
  430. High
  431. Home
  432. Idly
  433. Just
  434. Late
  435. Like
  436. Live
  438. Loud
  439. Much
  440. Near
  441. Nice
  442. Okay
  443. Once
  445. Over
  446. Part
  447. Past
  448. Real
  449. Slow
  450. Solo
  451. Soon
  452. Sure
  453. That
  455. This
  456. Thus
  457. Very
  458. When
  459. Wide
  460. Ajax
  461. Amid
  462. Anti
  463. Apud
  464. Atop
  465. Bout
  466. Chez
  467. Come
  468. Dahn
  469. Doon
  470. Down
  471. From
  472. Gain
  473. Half
  474. Into
  475. Like
  476. Mang
  477. Mong
  478. Near
  479. Nigh
  480. Offa
  481. Onto
  482. Outa
  483. Over
  484. Past
  485. Post
  486. Save
  487. Than
  488. Thro
  489. Thru
  490. Till
  491. Unto
  492. Upon
  493. Vice
  494. Whiz
  495. With
  496. Ahem
  497. Ahoy
  498. Alas
  499. Amen
  500. Bang
  501. Blah
  502. Ciao
  503. Crud
  504. Damn
  505. Darn
  506. Egad
  507. Eina
  508. Fact
  509. Flip
  510. Fore
  511. Gosh
  512. Heck
  513. Hell
  514. Here
  515. Hist
  516. Hiya
  517. Hmmm
  518. Hmph
  519. Honk
  520. Hunh
  521. Jeez
  522. Jinx
  523. Like
  524. Lord
  525. Meow
  526. Mwah
  527. Nome
  528. Nyet
  529. Okay
  530. Oops
  531. Ouch
  532. Phew
  533. Phut
  534. Poof
  535. Pooh
  536. Pugh
  537. Shoo
  538. Snap
  540. Sure
  541. Tara
  542. This
  543. Urgh
  544. Wall
  545. Waly
  546. Wham
  547. Whoa
  548. Word
  549. Yuck
  550.  

Here is the output of DATA lines I made with it. I noticed that the last word has a comma but I don't believe that will hurt anything.
Code: QB64: [Select]
  1. DATA Area, Army, Baby, Back, Ball, Band, Bank, Base, Bill, Body
  2. DATA Book, Call, Card, Care, Case, Cash, City, Club, Cost, Date
  3. DATA Deal, Door, Duty, East, Edge, Face, Fact, Farm, Fear, Fig
  4. DATA File, Film, Fire, Firm, Fish, Food, Foot, Form, Fund, Game
  5. DATA Girl, Goal, Gold, Hair, Half, Hall, Hand, Head, Help, Hill
  6. DATA Home, Hope, Hour, Idea, Jack, John, Kind, King, Lack, Lady
  7. DATA Land, Life, Line, List, Look, Lord, Loss, Love, Mark, Mary
  8. DATA Mind, Miss, Move, Name, Need, News, Note, Page, Pain, Pair
  9. DATA Park, Part, Past, Path, Paul, Plan, Play, Post, Race, Rain
  10. DATA Rate, Rest, Rise, Risk, Road, Rock, Role, Room, Rule, Sale
  11. DATA Seat, Shop, Show, Side, Sign, Site, Size, Skin, Sort, Star
  12. DATA Step, Task, Team, Term, Test, Text, Time, Tour, Town, Tree
  13. DATA Turn, Type, Unit, User, View, Wall, Week, West, Wife, Will
  14. DATA Wind, Wine, Wood, Word, Work, Year, Dese, Enuf, Feel, Hern
  15. DATA Hers, Many, Mine, Mine, Much, Nada, Nish, None, Nowt, Ours
  16. DATA Same, Self, Some, Such, That, Thee, Them, They, This, Thon
  17. DATA Thor, Thou, Thou, Tone, What, When, Whom, Yere, Your, Bear
  18. DATA Beat, Blow, Burn, Call, Care, Cast, Come, Cook, Cope, Cost
  19. DATA Dare, Deal, Deny, Draw, Drop, Earn, Face, Fail, Fall, Fear
  20. DATA Feel, Fill, Find, Form, Gain, Give, Grow, Hang, Hate, Have
  21. DATA Head, Hear, Help, Hide, Hold, Hope, Hurt, Join, Jump, Keep
  22. DATA Kill, Know, Land, Last, Lead, Lend, Lift, Like, Link, Live
  23. DATA Look, Lose, Love, Make, Mark, Meet, Mind, Miss, Move, Must
  24. DATA Name, Need, Note, Open, Pass, Pick, Plan, Play, Pray, Pull
  25. DATA Push, Read, Rely, Rest, Ride, Ring, Rise, Risk, Roll, Rule
  26. DATA Save, Seek, Seem, Sell, Send, Shed, Show, Shut, Sign, Sing
  27. DATA Slip, Sort, Stay, Step, Stop, Suit, Take, Talk, Tell, Tend
  28. DATA Test, Turn, Vary, View, Vote, Wait, Wake, Walk, Want, Warn
  29. DATA Wash, Wear, Will, Wish, Work, Able, Back, Bare, Bass, Blue
  30. DATA Bold, Busy, Calm, Cold, Cool, Damp, Dark, Dead, Deaf, Dear
  31. DATA Deep, Dual, Dull, Dumb, Easy, Evil, Fair, Fast, Fine, Firm
  32. DATA Flat, Fond, Foul, Free, Full, Glad, Good, Grey, Grim, Half
  33. DATA Hard, Head, High, Holy, Huge, Just, Keen, Kind, Last, Late
  34. DATA Lazy, Like, Live, Lone, Long, Loud, Main, Male, Mass, Mean
  35. DATA Mere, Mild, Nazi, Near, Neat, Next, Nice, Okay, Only, Open
  36. DATA Oral, Pale, Past, Pink, Poor, Pure, Rare, Real, Rear, Rich
  37. DATA Rude, Safe, Same, Sick, Slim, Slow, Soft, Sole, Sore, Sure
  38. DATA Tall, Then, Thin, Tidy, Tiny, Tory, True, Ugly, Vain, Vast
  39. DATA Very, Vice, Warm, Wary, Weak, Wide, Wild, Wise, Zero, Both
  40. DATA Else, Ergo, Lest, Like, Once, Only, Plus, Save, Sith, Than
  41. DATA That, Then, Thou, Till, Unto, When, Some, Ably, Afar, Anew
  42. DATA Away, Back, Damn, Dead, Deep, Down, Duly, Easy, Else, Even
  43. DATA Ever, Fair, Fast, Flat, Full, Good, Half, Hard, Here, High
  44. DATA Home, Idly, Just, Late, Like, Live, Long, Loud, Much, Near
  45. DATA Nice, Okay, Once, Only, Over, Part, Past, Real, Slow, Solo
  46. DATA Soon, Sure, That, Then, This, Thus, Very, When, Wide, Ajax
  47. DATA Amid, Anti, Apud, Atop, Bout, Chez, Come, Dahn, Doon, Down
  48. DATA From, Gain, Half, Into, Like, Mang, Mong, Near, Nigh, Offa
  49. DATA Onto, Outa, Over, Past, Post, Save, Than, Thro, Thru, Till
  50. DATA Unto, Upon, Vice, Whiz, With, Ahem, Ahoy, Alas, Amen, Bang
  51. DATA Blah, Ciao, Crud, Damn, Darn, Egad, Eina, Fact, Flip, Fore
  52. DATA Gosh, Heck, Hell, Here, Hist, Hiya, Hmmm, Hmph, Honk, Hunh
  53. DATA Jeez, Jinx, Like, Lord, Meow, Mwah, Nome, Nyet, Okay, Oops
  54. DATA Ouch, Phew, Phut, Poof, Pooh, Pugh, Shoo, Snap, Stop, Sure
  55. DATA Tara, This, Urgh, Wall, Waly, Wham, Whoa, Word, Yuck,
  56.  

13
Programs / LCD Clock With Speech And Bouncing Ball
« on: January 27, 2022, 06:55:28 pm »
Using an old LCD clock I made a few years ago, I added a woman's voice to it when you click it, and a ball that bounces around. The speech reads the title of the month, not the number of the month, as well as the date and time.

Edit: You will need to add this LCD.TTF font file to your folder, or Windows Fonts folder. I think you can just add it to your QB64 folder where you save this app anyway. If not, put it in your Windows Fonts folder that has the rest of your fonts. 

Code: QB64: [Select]
  1. 'By SierraKen on January 27, 2022.
  2. _Title "Digital Time and Date - Click to Listen."
  3.  
  4. Screen _NewImage(400, 200, 32)
  5. rootpath$ = Environ$("SYSTEMROOT") 'normally "C:\WINDOWS"
  6. fontfile$ = rootpath$ + "\Fonts\Lcd.ttf" 'TTF file in Windows
  7. style$ = "bold" 'font style is not case sensitive
  8. f& = _LoadFont(fontfile$, 72, style$)
  9. _Font f& '
  10. ballx = 200: bally = 100
  11. redo:
  13. dx = (Rnd * 5) - 5
  14. dy = (Rnd * 5) - 5
  15. If dx = 0 And dy = 0 Then GoTo redo:
  16. If dx < .25 And dx > -.25 Then GoTo redo:
  17. If dy < .25 And dy > -.25 Then GoTo redo:
  18.  
  19.  
  20. Dim message As String
  21. Dim message2 As String
  23.     _Limit 30
  24.  
  25.     t$ = Time$
  26.     hour$ = Left$(t$, 2)
  27.     h = Val(hour$)
  28.     If h > 11 Then pmam$ = " PM"
  29.     If h < 12 Then pmam$ = " AM"
  30.     If h > 12 Then h = h - 12: hour$ = Str$(h)
  31.     minute$ = Mid$(t$, 4, 2)
  32.     second$ = Right$(t$, 2)
  33.     Color _RGB32(127, 255, 127), _RGB32(0, 0, 0)
  34.     _PrintString (10, 10), hour$ + ":" + minute$ + ":" + second$ + pmam$
  35.     _PrintString (10, 100), Date$
  36.     ball ballx, bally, dx, dy
  38.         mouseX = _MouseX
  39.         mouseY = _MouseY
  40.         mouseLeftButton = _MouseButton(1)
  41.     Loop
  42.     If mouseLeftButton = -1 Then
  43.         mouseLeftButton = 0
  44.         If Left$(Date$, 2) = "01" Then month$ = "January"
  45.         If Left$(Date$, 2) = "02" Then month$ = "February"
  46.         If Left$(Date$, 2) = "03" Then month$ = "March"
  47.         If Left$(Date$, 2) = "04" Then month$ = "April"
  48.         If Left$(Date$, 2) = "05" Then month$ = "May"
  49.         If Left$(Date$, 2) = "06" Then month$ = "June"
  50.         If Left$(Date$, 2) = "07" Then month$ = "July"
  51.         If Left$(Date$, 2) = "08" Then month$ = "August"
  52.         If Left$(Date$, 2) = "09" Then month$ = "September"
  53.         If Left$(Date$, 2) = "10" Then month$ = "October"
  54.         If Left$(Date$, 2) = "11" Then month$ = "November"
  55.         If Left$(Date$, 2) = "12" Then month$ = "December"
  56.         day$ = Mid$(Date$, 4, 2)
  57.         year$ = Right$(Date$, 4)
  58.         message = "The time is " + hour$ + minute$ + pmam$ + " and " + second$ + " seconds."
  59.         speak message
  60.         message = "The date today is " + month$ + " " + day$ + " " + year$
  61.         speak message
  62.     End If
  63.  
  64.  
  65.  
  66.     _Display
  67.     Cls
  69.  
  70.  
  71. Sub ball (ballx, bally, dx, dy)
  73.     _Limit 100
  74.  
  75.     ballx = ballx + dx
  76.     bally = bally + dy
  77.     more:
  78.     If ballx < 0 Then dx = 5: dy = (Rnd * 5) - 5
  79.     If ballx > 400 Then dx = -5: dy = (Rnd * 5) - 5
  80.     If bally < 0 Then dy = 5: dx = (Rnd * 5) - 5
  81.     If bally > 200 Then dy = -5: dx = (Rnd * 5) - 5
  82.     If dx = 0 And dy = 0 Then GoTo more:
  83.     If dx < .25 And dx > -.25 Then GoTo more:
  84.     If dy < .25 And dy > -.25 Then GoTo more:
  85.  
  86.     r = 15
  87.     c = _RGB(0, 0, 255)
  88.     cx = ballx
  89.     cy = bally
  90.     fillCircle cx, cy, r, c
  91.  
  92.     _Display
  93.     Line (0, 0)-(_Width, _Height), _RGB32(0, 0, 0, 20), BF
  94.  
  96.  
  97. 'from Steve Gold standard
  98. Sub fillCircle (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
  99.     Dim Radius As Integer, RadiusError As Integer
  100.     Dim X As Integer, Y As Integer
  101.     Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
  102.     If Radius = 0 Then PSet (CX, CY), C: Exit Sub
  103.     Line (CX - X, CY)-(CX + X, CY), C, BF
  104.     While X > Y
  105.         RadiusError = RadiusError + Y * 2 + 1
  106.         If RadiusError >= 0 Then
  107.             If X <> Y + 1 Then
  108.                 Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  109.                 Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  110.             End If
  111.             X = X - 1
  112.             RadiusError = RadiusError - X * 2
  113.         End If
  114.         Y = Y + 1
  115.         Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  116.         Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  117.     Wend
  119.  
  120. 'Windows only, I think
  121. Sub speak (message As String)
  122.     out$ = "Powershell -Command " + Chr$(34)
  123.     out$ = out$ + "Add-Type -AssemblyName System.Speech; "
  124.     out$ = out$ + "$Speech = New-Object System.Speech.Synthesis.SpeechSynthesizer; "
  125.     out$ = out$ + "$Speech.SelectVoice('Microsoft Zira Desktop'); "
  126.     out$ = out$ + "$Speech.Speak('" + message + "');" + Chr$(34)
  127.     Shell _Hide out$
  129.  

14
Programs / 60 Or Less Pasted Sentences At-Once Text To Speech Reader
« on: January 25, 2022, 08:06:32 pm »
Using B+'s and Steve's text-to-speech code, I added it with Steve's text pasting code and now we got a text-to-speech reader that reads almost any text that you can paste. There is a 60 sentence, or so, limit, because I didn't want people to accidentally copy a whole book and have it read all at once. There really isn't a way to stop the speech either because it uses Windows Power Shell, besides turning your computer off. This is probably a Windows-only app. I tested it with about 58 sentences from the Bible and it worked fine. I did run into a small problem that I fixed, which was that it stopped working altogether when it saw a quotation mark. So before it runs, I have it scan all of the text and delete anything before or after the text and number ASCII code numbers. Between the numbers and text there's a couple of punctuation marks and a few I added like the question mark, period, and comma, and a couple others. I haven't tried every possibility but it should work OK. Feel free to play around with it. Thank you to B+ and Steve (SMCNeil) for their very hard work. Hopefully people can make use of this app. Have fun!

Code: QB64: [Select]
  1. 'Thanks to B+ for the audio code and Steve (SMCNeil) for the paste code!
  3. _Title "Text Reader"
  4. Screen _NewImage(800, 600, 32)
  5. start:
  6. Print "CTRL-V to paste text and then press Enter to read through your speakers (Around a 60 sentence limit at a time.): "
  7. ExtendedInput information$
  9. Dim t(3000) As String
  10. For x = 1 To Len(information$)
  11.     If Asc(Mid$(information$, x, x)) < 40 Or Asc(Mid$(information$, x, x)) > 122 Then Mid$(information$, x, x) = " "
  13. t(i) = information$
  14. If Len(information$) > 10000 Then Print: Print "Too much text to read at once. Try again with less.": GoTo start:
  16. Print t(i)
  17. speak t(i)
  19. Print "Again (Y/N)";
  21.     ag$ = InKey$
  22.     If ag$ = "Y" Or ag$ = "y" Then Cls: GoTo start:
  23.     If ag$ = "N" Or ag$ = "n" Then End
  25.  
  26. Sub speak (message As String)
  27.     Shell _Hide "Powershell -Command " + Chr$(34) + "Add-Type -AssemblyName System.Speech; (New-Object System.Speech.Synthesis.SpeechSynthesizer).Speak('" + message + "');" + Chr$(34)
  29.  
  30. Sub ExtendedInput (out$)
  31.     PCopy 0, 1
  32.     A = _AutoDisplay: X = Pos(0): Y = CsrLin
  33.     CP = 0: OldCP = 0 'Cursor Position
  34.     _KeyClear
  35.     Do
  36.         PCopy 1, 0
  37.         If _KeyDown(100307) Or _KeyDown(100308) Then AltDown = -1 Else AltDown = 0
  38.         k = _KeyHit
  39.         If AltDown Then
  40.             Select Case k 'ignore all keypresses except ALT-number presses
  41.                 Case 48 TO 57: AltWasDown = -1: alt$ = alt$ + Chr$(k)
  42.             End Select
  43.         Else
  44.             Select Case k 'without alt, add any keypresses to our input
  45.                 Case 8
  46.                     oldin$ = in$
  47.                     If CP > 0 Then OldCP = CP: CP = CP - 1
  48.                     in$ = Left$(in$, CP) + Mid$(in$, CP + 2) 'backspace to erase input
  49.                 Case 9
  50.                     oldin$ = in$
  51.                     in$ = Left$(in$, CP) + Space$(4) + Mid$(in$, CP + 1) 'four spaces for any TAB entered
  52.                     OldCP = CP
  53.                     CP = CP + 4
  54.                 Case 32 TO 128
  55.                     If _KeyDown(100305) Or _KeyDown(100306) Then
  56.                         If k = 118 Or k = 86 Then
  57.                             oldin$ = in$
  58.                             in$ = Left$(in$, CP) + _Clipboard$ + Mid$(in$, CP + 1) 'ctrl-v paste
  59.                             'CTRL-V leaves cursor in position before the paste, without moving it after.
  60.                             'Feel free to modify that behavior here, if you want it to move to after the paste.
  61.                             'CP = CP + LEN(_CLIPBOARD$)
  62.                         End If
  63.                         If k = 122 Or k = 90 Then Swap in$, oldin$: Swap OldCP, CP 'ctrl-z undo
  64.                     Else
  65.                         oldin$ = in$
  66.                         in$ = Left$(in$, CP) + Chr$(k) + Mid$(in$, CP + 1) 'add input to our string
  67.                         OldCP = CP
  68.                         CP = CP + 1
  69.                     End If
  70.                 Case 18176 'Home
  71.                     CP = 0
  72.                 Case 20224 'End
  73.                     CP = Len(in$)
  74.                 Case 21248 'Delete
  75.                     oldin$ = in$
  76.                     in$ = Left$(in$, CP) + Mid$(in$, CP + 2)
  77.                 Case 19200 'Left
  78.                     CP = CP - 1
  79.                     If CP < 0 Then CP = 0
  80.                 Case 19712 'Right
  81.                     CP = CP + 1
  82.                     If CP > Len(in$) Then CP = Len(in$)
  83.             End Select
  84.         End If
  85.         alt$ = Right$(alt$, 3)
  86.         If AltWasDown = -1 And AltDown = 0 Then
  87.             v = Val(alt$)
  88.             If v >= 0 And v <= 255 Then in$ = in$ + Chr$(v)
  89.             alt$ = "": AltWasDown = 0
  90.         End If
  91.         blink = (blink + 1) Mod 30
  92.         Locate Y, X
  93.         Print Left$(in$, CP);
  94.         If blink \ 15 Then Print " "; Else Print "_";
  95.         Print Mid$(in$, CP + 1)
  96.  
  97.         _Display
  98.         _Limit 30
  99.     Loop Until k = 13
  100.  
  101.     PCopy 1, 0
  102.     Locate Y, X: Print in$
  103.     out$ = in$
  106.  
  107.  

15
Programs / Optical Illusion Clock
« on: January 22, 2022, 07:38:43 pm »
I used old code I had from my older analog clocks and added another hand to it which is 1/60 of a second and changed the colors. I also added an optical illusion design that also has a bit of moving color. The clock gongs the hour every hour too. The _Limit command is at 400 so the fast hand will have a smoother animation. Tell me what you think.

Code: QB64: [Select]
  1. _Title "Optical Illusion Clock"
  2. Screen _NewImage(350, 350, 32)
  3. i = _NewImage(350, 350, 32)
  4. ' ----------------------------------------
  5. ' Draw clock here and use  _DEST i and _DEST 0
  7. Circle (175, 175), 170, _RGB32(255, 255, 255)
  8.  
  9. For ls = 1 To 60
  10.     ss = (60 - ls) * 6 + 180
  11.     x = Int(Sin(ss / 180 * 3.141592) * 75) + 175
  12.     y = Int(Cos(ss / 180 * 3.141592) * 75) + 175
  13.     Line (x, y)-(x * 1.5, y * 1.5), _RGB32(255, 255, 255)
  14. Next ls
  15.  
  17. '-----------------------------------------
  18.  
  19.  
  21.     _Limit 400
  22.     hours = Timer \ 3600
  23.     minutes = Timer \ 60 - hours * 60
  24.     seconds = (Timer - hours * 3600 - minutes * 60)
  25.     qseconds = (seconds * 60)
  26.     ho$ = Left$(Time$, 2): hou = Val(ho$)
  27.     min$ = Mid$(Time$, 4, 2): minu = Val(min$)
  28.     seco$ = Right$(Time$, 2): secon = Val(seco$)
  29.     '1/60 of a second.
  30.     qs = (60 - qseconds) * 6 + 180
  31.     x = Int(Sin(qs / 180 * 3.141592) * 125) + 175
  32.     y = Int(Cos(qs / 180 * 3.141592) * 125) + 175
  33.     For b = -5 To 5 Step .5
  34.         Line (175 + b, 175)-(x, y), _RGB32(255, 255, 255)
  35.         Line (175, 175 + b)-(x, y), _RGB32(255, 255, 255)
  36.     Next b
  37.     x2 = Int(Sin(qs / 180 * 3.141592) * 170) + 175
  38.     y2 = Int(Cos(qs / 180 * 3.141592) * 170) + 175
  39.     For sz = .1 To 5 Step .1
  40.         Circle (x2, y2), sz, _RGB32(255, 255, 255)
  41.     Next sz
  42.     x2 = Int(Sin(qs / 180 * 3.141592) * 75) + 175
  43.     y2 = Int(Cos(qs / 180 * 3.141592) * 75) + 175
  44.     Line (x2, y2)-(x2 * 1.5, y2 * 1.5), _RGB32(127, 255, 127)
  45.     'Seconds
  46.     s = (60 - seconds) * 6 + 180
  47.     x = Int(Sin(s / 180 * 3.141592) * 125) + 175
  48.     y = Int(Cos(s / 180 * 3.141592) * 125) + 175
  49.     For b = -5 To 5 Step .5
  50.         Line (175 + b, 175)-(x, y), _RGB32(0, 255, 255)
  51.         Line (175, 175 + b)-(x, y), _RGB32(0, 255, 255)
  52.     Next b
  53.     x = Int(Sin(s / 180 * 3.141592) * 170) + 175
  54.     y = Int(Cos(s / 180 * 3.141592) * 170) + 175
  55.     For sz = .1 To 5 Step .1
  56.         Circle (x, y), sz, _RGB32(0, 255, 255)
  57.     Next sz
  58.     'Minutes
  59.     m = 180 - minutes * 6
  60.     xx = Int(Sin(m / 180 * 3.141592) * 120) + 175
  61.     yy = Int(Cos(m / 180 * 3.141592) * 120) + 175
  62.     For b = -5 To 5 Step .5
  63.         Line (175 + b, 175)-(xx, yy), _RGB32(127, 255, 127)
  64.         Line (175, 175 + b)-(xx, yy), _RGB32(127, 255, 127)
  65.     Next b
  66.     xx = Int(Sin(m / 180 * 3.141592) * 170) + 175
  67.     yy = Int(Cos(m / 180 * 3.141592) * 170) + 175
  68.     For sz = .1 To 5 Step .1
  69.         Circle (xx, yy), sz, _RGB32(127, 255, 127)
  70.     Next sz
  71.     'Hours
  72.     h = 360 - hours * 30 + 180
  73.     xxx = Int(Sin(h / 180 * 3.141592) * 50) + 175
  74.     yyy = Int(Cos(h / 180 * 3.141592) * 50) + 175
  75.     For b = -5 To 5 Step .5
  76.         Line (175 + b, 175)-(xxx, yyy), _RGB32(255, 122, 0)
  77.         Line (175, 175 + b)-(xxx, yyy), _RGB32(255, 122, 0)
  78.     Next b
  79.     xxx = Int(Sin(h / 180 * 3.141592) * 170) + 175
  80.     yyy = Int(Cos(h / 180 * 3.141592) * 170) + 175
  81.     For sz = .1 To 5 Step .1
  82.         Circle (xxx, yyy), sz, _RGB32(255, 122, 0)
  83.     Next sz
  84.  
  85.     For sz = .1 To 5
  86.         Circle (175, 175), sz, _RGB32(255, 255, 127)
  87.     Next sz
  88.  
  89.     'Chimes
  90.     If minu = 0 And secon = 0 Then
  91.         hour2 = hou
  92.         If hour2 > 12 Then hour2 = hour2 - 12
  93.         If hour2 = 0 Then hour2 = 12
  94.         For chimes = 1 To hour2
  95.             ttt = 0
  96.             Do
  97.                 'queue some sound
  98.                 Do While _SndRawLen < 0.1 'you may wish to adjust this
  99.                     sample = Sin(ttt * 340 * Atn(1) * 8) '340Hz sine wave (ttt * 440 * 2p)
  100.                     sample = sample * Exp(-ttt * 3) 'fade out eliminates clicks after sound
  101.                     _SndRaw sample
  102.                     ttt = ttt + 1 / _SndRate 'sound card sample frequency determines time
  103.                 Loop
  104.                 'do other stuff, but it may interrupt sound
  105.             Loop While ttt < 2 'play for 2 seconds
  106.             Do While _SndRawLen > 0 'Finish any left over queued sound!
  107.             Loop
  108.         Next chimes
  109.     End If
  110.     two:
  111.     _Display
  112.     Cls
  113.     _PutImage (0, 0)-(350, 350), i
  115.  

Pages: [1] 2 3 ... 11