Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: bplus on January 23, 2022, 05:10:52 pm

Title: Passing Time
Post by: bplus on January 23, 2022, 05:10:52 pm
More fun with RotoZoom3
Code: QB64: [Select]
  2. _Title "Does anyone really know what time it is?" ' b+ 2022-01-23
  3. Type obj
  4.     As Single X, Y, ScaleX, ScaleY, RotXY, DScaleX, DScaleY, DRotXY, ScaleLimit
  6.  
  7. Const SW = 1025, SH = 721, NClocks = 40
  8. Screen _NewImage(SW, SH, 32)
  9. _ScreenMove 150, 10
  12. Dim midP, i
  13. c& = _NewImage(313, 313, 32)
  15. midP = Int((313 - 1) / 2)
  16. clock midP, midP, 149
  17. 'Line (0, 0)-(311, 311), , B ' check centering
  19. _ClearColor &HFF000000, c&
  20. Dim Shared Clocks(1 To NClocks) As obj
  21. For i = 1 To NClocks
  22.     newClock i, 1
  25.     Cls
  26.     _Title "Does anyone really know what time it is? Sure " + Time$
  27.     _Dest c&
  28.     Line (0, 0)-(311, 311), &HFF000000, BF ' blank out fro redraw
  29.     midP = Int((313 - 1) / 2)
  30.     clock midP, midP, 149
  31.     _Dest 0
  32.     _ClearColor &HFF000000, c&
  33.     For i = 1 To NClocks
  34.         RotoZoom3 Clocks(i).X, Clocks(i).Y, c&, Clocks(i).ScaleX, Clocks(i).ScaleY, Clocks(i).RotXY
  35.         Clocks(i).Y = Clocks(i).Y + 1
  36.         If Clocks(i).Y > _Height + 150 Then
  37.             newClock i, 0
  38.         Else
  39.             'updates
  40.             Clocks(i).ScaleX = Clocks(i).ScaleX + Clocks(i).DScaleX
  41.             If Clocks(i).ScaleX < -Clocks(i).ScaleLimit Then Clocks(i).DScaleX = -Clocks(i).DScaleX: Clocks(i).ScaleX = -Clocks(i).ScaleLimit
  42.             If Clocks(i).ScaleX > Clocks(i).ScaleLimit Then Clocks(i).DScaleX = -Clocks(i).DScaleX: Clocks(i).ScaleX = Clocks(i).ScaleLimit
  43.             Clocks(i).ScaleY = Clocks(i).ScaleY + Clocks(i).DScaleY
  44.             If Clocks(i).ScaleY < -Clocks(i).ScaleLimit Then Clocks(i).DScaleY = -Clocks(i).DScaleY: Clocks(i).ScaleY = -Clocks(i).ScaleLimit
  45.             If Clocks(i).ScaleY > Clocks(i).ScaleLimit Then Clocks(i).DScaleY = -Clocks(i).DScaleY: Clocks(i).ScaleY = Clocks(i).ScaleLimit
  46.             Clocks(i).RotXY = Clocks(i).RotXY + Clocks(i).DRotXY
  47.         End If
  48.     Next
  49.     _Display
  50.     _Limit 60
  52.  
  53. Sub newClock (i, initTF)
  54.     Clocks(i).X = Rnd * SW
  55.     If initTF Then Clocks(i).Y = rrnd(-150, SH) Else Clocks(i).Y = -150
  56.     Clocks(i).ScaleLimit = 1
  57.     Clocks(i).ScaleX = rrnd(-Clocks(i).ScaleLimit, Clocks(i).ScaleLimit)
  58.     Clocks(i).ScaleY = rrnd(-Clocks(i).ScaleLimit, Clocks(i).ScaleLimit)
  59.     Clocks(i).DScaleX = rrnd(-.005 * Clocks(i).ScaleLimit, .005 * Clocks(i).ScaleLimit)
  60.     Clocks(i).DScaleY = rrnd(-.005 * Clocks(i).ScaleLimit, .005 * Clocks(i).ScaleLimit)
  61.     Clocks(i).RotXY = _Pi(2) * Rnd
  62.     Clocks(i).DRotXY = rrnd(-.005 * _Pi, .005 * _Pi)
  64.  
  65. Sub clock (x, y, r)
  66.     Dim a, r1, hrs
  67.     For a = 0 To 359 Step 6
  68.         If a Mod 30 = 0 Then r1 = 1 / 30 * r Else r1 = 1 / 75 * r
  69.         Circle (x + r * Cos(_D2R(a)), y + r * Sin(_D2R(a))), r1
  70.         Paint (x + r * Cos(_D2R(a)), y + r * Sin(_D2R(a))), _RGB32(100, 100, 100), _RGB32(255, 255, 255)
  71.     Next
  72.     If Val(Left$(Time$, 2)) + (Val(Mid$(Time$, 4, 2)) / 60) >= 12 Then hrs = Val(Left$(Time$, 2)) + (Val(Mid$(Time$, 4, 2)) / 60) - 12 Else hrs = Val(Left$(Time$, 2)) + (Val(Mid$(Time$, 4, 2)) / 60)
  73.     ftri0 x + 1 / 15 * r * Cos(Val(Mid$(Time$, 4, 2)) * _Pi(1 / 30) - _Pi(1 / 2) + _Pi(1 / 2)), y + 1 / 15 * r * Sin(Val(Mid$(Time$, 4, 2)) * _Pi(1 / 30) - _Pi(1 / 2) + _Pi(1 / 2)), x + 1 / 15 * r * Cos(Val(Mid$(Time$, 4, 2)) * _Pi(1 / 30) - _Pi(1 / 2) - _Pi(1 / 2)), y + 1 / 15 * r * Sin(Val(Mid$(Time$, 4, 2)) * _Pi(1 / 30) - _Pi(1 / 2) - _Pi(1 / 2)), x + r * Cos(Val(Mid$(Time$, 4, 2)) * _Pi(1 / 30) - _Pi(1 / 2)), y + r * Sin(Val(Mid$(Time$, 4, 2)) * _Pi(1 / 30) - _Pi(1 / 2)), _RGB32(255, 0, 0)
  74.     ftri0 x + 1 / 10 * r * Cos(hrs * _Pi(1 / 6) - _Pi(1 / 2) + _Pi(1 / 2)), y + 1 / 10 * r * Sin(hrs * _Pi(1 / 6) - _Pi(1 / 2) + _Pi(1 / 2)), x + 1 / 10 * r * Cos(hrs * _Pi(1 / 6) - _Pi(1 / 2) - _Pi(1 / 2)), y + 1 / 10 * r * Sin(hrs * _Pi(1 / 6) - _Pi(1 / 2) - _Pi(1 / 2)), x + 2 / 3 * r * Cos(hrs * _Pi(1 / 6) - _Pi(1 / 2)), y + 2 / 3 * r * Sin(hrs * _Pi(1 / 6) - _Pi(1 / 2)), _RGB32(0, 0, 255)
  75.     Line (x, y)-(x + r * Cos(Val(Right$(Time$, 2)) * _Pi(1 / 30) - _Pi(1 / 2)), y + r * Sin(Val(Right$(Time$, 2)) * _Pi(1 / 30) - _Pi(1 / 2))), _RGB32(255, 255, 0)
  76.     Circle (x, y), 1 / 10 * r, _RGB32(255, 255, 255)
  77.     Paint (x + 1 / 75 * r, y + 1 / 75 * r), _RGB32(100, 100, 100), _RGB32(255, 255, 255)
  78.     Circle (x, y), 1 / 30 * r, _RGB32(0, 0, 0)
  80.  
  81. Sub ftri0 (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
  82.     Dim D As Long, a&
  83.     D = _Dest
  84.     a& = _NewImage(1, 1, 32)
  85.     _Dest a&
  86.     PSet (0, 0), K
  87.     _Dest D
  88.     _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
  89.     _FreeImage a& '<<< this is important!
  91.  
  92. Sub RotoZoom3 (X As Long, Y As Long, Image As Long, xScale As Single, yScale As Single, radianRotation As Single) ' 0 at end means no scaling of x or y
  93.     Dim px(3) As Single: Dim py(3) As Single
  94.     Dim W&, H&, sinr!, cosr!, i&, x2&, y2&
  95.     W& = _Width(Image&): H& = _Height(Image&)
  96.     px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
  97.     px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
  98.     sinr! = Sin(-radianRotation): cosr! = Cos(-radianRotation)
  99.     For i& = 0 To 3
  100.         x2& = xScale * (px(i&) * cosr! + sinr! * py(i&)) + X: y2& = yScale * (py(i&) * cosr! - px(i&) * sinr!) + Y
  101.         px(i&) = x2&: py(i&) = y2&
  102.     Next
  103.     _MapTriangle _Seamless(0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
  104.     _MapTriangle _Seamless(0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
  106.  
  107. Function rrnd (n1, n2) 'return real number (_single, double, _float depending on default / define setup)
  108.     rrnd = (n2 - n1) * Rnd + n1
  110.  
  111.  
Title: Re: Passing Time
Post by: SierraKen on January 23, 2022, 06:59:21 pm
LOL incredible! I thought of something like this but I'm no genius like you guys are. lol
Title: Re: Passing Time
Post by: johnno56 on January 24, 2022, 06:44:18 am
Reminded me of the intro to The Time Machine (1960)... Cool...
Title: Re: Passing Time
Post by: bplus on January 24, 2022, 11:21:20 am
Thanks guys. I have been considering putting in different clocks.
Title: Re: Passing Time
Post by: SMcNeill on January 24, 2022, 01:33:37 pm
I see your passing time and scoff at it!  Behold the simplicity of the Time Clicker!

Title: Re: Passing Time
Post by: bplus on January 24, 2022, 02:00:39 pm
@SMcNeill

Nice and Simple as you say. That would make a great addition to any clock app, just click and presto an audio announcement!

Looking at Johnno's ref of Time Machine 1960 Movie opening, I became aware that every (visual) clock assumes an orientation to viewer.

Wouldn't it be cool to show all those different clocks with the correct time, despite how the code orientates it. Mine above could be showing anytime even though the clock image is updated 60 times a sec.
Title: Re: Passing Time
Post by: bplus on January 24, 2022, 11:20:34 pm
Lot's of updates!
Added Steve's Time announcer, here just press spacebar...
I moved all the oggs into a subfolder for my easier use of Windows navigator.
Then I modified Steve's Click Time app into a sub that can be used in any ones clock code.
Then I found a really cool back side of a time piece, looks like clock mechanism but look closer!
So now when the clock turns around it doesn't show mirror image of clock but the back side.
Made some changes on clock image too.

Code: QB64: [Select]
  2. _Title "Does anyone really know what time it is?" ' b+ 2022-01-23
  3. ' 2022-01-24 now with Steve's audio time announcer! Press spacebar.
  4. ' And now with customImage load of a wonderful back side of a Time piece.
  5. ' Made a number of modifications to SayTime sub and Clock drawing
  6.  
  7. Type obj
  8.     As Single X, Y, ScaleX, ScaleY, RotXY, DScaleX, DScaleY, DRotXY, ScaleLimit
  10.  
  11. Const SW = 1025, SH = 721, NClocks = 40
  12. Screen _NewImage(SW, SH, 32)
  13. _ScreenMove 150, 10
  15.  
  16. Dim Shared Clocks(1 To NClocks) As obj
  17. Dim As Long c, b, midP, i, bl
  18. Dim k$
  19.  
  20. '  check clock drawing
  21. c = _NewImage(351, 351, 32) ' for the c=clock face conatiner
  22. midP = Int((351 - 1) / 2)
  23. 'fcirc midP, midP, 165, &HFF114422
  24. 'clock midP, midP, 150
  25. 'Line (0, 0)-(351, 351), , B ' check centering
  26. 'Sleep
  27.  
  28. ' create back of clock image
  29. bl = LoadCustomImage("Clock Back") ' pretty cool image!!!
  30. b = _NewImage(351, 351, 32)
  31. _PutImage , bl, b
  32. _ClearColor _RGB(0, 128, 0), b
  33. ' check our image
  34. 'Cls , &HFFFFFFFF
  35. '_PutImage (0, 0), b, 0
  36. 'Line (0, 0)-(351, 351), &HFF000000, B
  37. 'Sleep
  38.  
  39. For i = 1 To NClocks
  40.     newClock i, 1
  43.     Cls
  44.     _Title "Does anyone really know what time it is? Sure just press the spacebar."
  45.     k$ = InKey$
  46.     If k$ = " " Then sayTime
  47.     _Dest c&
  48.     Line (0, 0)-(351, 351), &HFF000000, BF ' blank out fro redraw
  49.     For i = 165 To 0 Step -1
  50.         fcirc midP, midP, i, _RGB32(220 - i)
  51.     Next
  52.     clock midP, midP, 150
  53.     _Dest 0
  54.     _ClearColor &HFF000000, c
  55.     For i = 1 To NClocks
  56.         If (Clocks(i).ScaleX > 0 And Clocks(i).ScaleY > 0) Or (Clocks(i).ScaleX < 0 And Clocks(i).ScaleY < 0) Then
  57.             RotoZoom3 Clocks(i).X, Clocks(i).Y, c, Clocks(i).ScaleX, Clocks(i).ScaleY, Clocks(i).RotXY
  58.         Else
  59.             RotoZoom3 Clocks(i).X, Clocks(i).Y, b, Clocks(i).ScaleX, Clocks(i).ScaleY, Clocks(i).RotXY
  60.         End If
  61.         Clocks(i).Y = Clocks(i).Y + 1
  62.         If Clocks(i).Y > _Height + 150 Then
  63.             newClock i, 0
  64.         Else
  65.             'updates
  66.             Clocks(i).ScaleX = Clocks(i).ScaleX + Clocks(i).DScaleX
  67.             If Clocks(i).ScaleX < -Clocks(i).ScaleLimit Then Clocks(i).DScaleX = -Clocks(i).DScaleX: Clocks(i).ScaleX = -Clocks(i).ScaleLimit
  68.             If Clocks(i).ScaleX > Clocks(i).ScaleLimit Then Clocks(i).DScaleX = -Clocks(i).DScaleX: Clocks(i).ScaleX = Clocks(i).ScaleLimit
  69.             Clocks(i).ScaleY = Clocks(i).ScaleY + Clocks(i).DScaleY
  70.             If Clocks(i).ScaleY < -Clocks(i).ScaleLimit Then Clocks(i).DScaleY = -Clocks(i).DScaleY: Clocks(i).ScaleY = -Clocks(i).ScaleLimit
  71.             If Clocks(i).ScaleY > Clocks(i).ScaleLimit Then Clocks(i).DScaleY = -Clocks(i).DScaleY: Clocks(i).ScaleY = Clocks(i).ScaleLimit
  72.             Clocks(i).RotXY = Clocks(i).RotXY + Clocks(i).DRotXY
  73.         End If
  74.     Next
  75.     _Display
  76.     _Limit 60
  78.  
  79. Sub newClock (i, initTF)
  80.     Clocks(i).X = Rnd * SW
  81.     If initTF Then Clocks(i).Y = rrnd(-150, SH) Else Clocks(i).Y = -150
  82.     Clocks(i).ScaleLimit = 1
  83.     Clocks(i).ScaleX = rrnd(-Clocks(i).ScaleLimit, Clocks(i).ScaleLimit)
  84.     Clocks(i).ScaleY = rrnd(-Clocks(i).ScaleLimit, Clocks(i).ScaleLimit)
  85.     Clocks(i).DScaleX = rrnd(-.005 * Clocks(i).ScaleLimit, .005 * Clocks(i).ScaleLimit)
  86.     Clocks(i).DScaleY = rrnd(-.005 * Clocks(i).ScaleLimit, .005 * Clocks(i).ScaleLimit)
  87.     Clocks(i).RotXY = _Pi(2) * Rnd
  88.     Clocks(i).DRotXY = rrnd(-.005 * _Pi, .005 * _Pi)
  90.  
  91. Sub clock (x, y, r)
  92.     Dim a, r1, hrs, clr~&
  93.     For a = 0 To 359 Step 6
  94.         clr~& = &HFF888888
  95.         If a Mod 30 = 0 Then r1 = 1 / 30 * r Else r1 = 1 / 75 * r
  96.         If a Mod 360 = 270 Then r1 = 1 / 15 * r: clr~& = &HFFFFFFFF
  97.         Circle (x + r * Cos(_D2R(a)), y + r * Sin(_D2R(a))), r1
  98.         fcirc x + r * Cos(_D2R(a)), y + r * Sin(_D2R(a)), r1 - 2, clr~& ' _RGB32(255, 255, 255)
  99.     Next
  100.     If Val(Left$(Time$, 2)) + (Val(Mid$(Time$, 4, 2)) / 60) >= 12 Then hrs = Val(Left$(Time$, 2)) + (Val(Mid$(Time$, 4, 2)) / 60) - 12 Else hrs = Val(Left$(Time$, 2)) + (Val(Mid$(Time$, 4, 2)) / 60)
  101.     ftri x + 1 / 15 * r * Cos(Val(Mid$(Time$, 4, 2)) * _Pi(1 / 30) - _Pi(1 / 2) + _Pi(1 / 2)), y + 1 / 15 * r * Sin(Val(Mid$(Time$, 4, 2)) * _Pi(1 / 30) - _Pi(1 / 2) + _Pi(1 / 2)), x + 1 / 15 * r * Cos(Val(Mid$(Time$, 4, 2)) * _Pi(1 / 30) - _Pi(1 / 2) - _Pi(1 / 2)), y + 1 / 15 * r * Sin(Val(Mid$(Time$, 4, 2)) * _Pi(1 / 30) - _Pi(1 / 2) - _Pi(1 / 2)), x + r * Cos(Val(Mid$(Time$, 4, 2)) * _Pi(1 / 30) - _Pi(1 / 2)), y + r * Sin(Val(Mid$(Time$, 4, 2)) * _Pi(1 / 30) - _Pi(1 / 2)), _RGB32(128)
  102.     ftri x + 1 / 10 * r * Cos(hrs * _Pi(1 / 6) - _Pi(1 / 2) + _Pi(1 / 2)), y + 1 / 10 * r * Sin(hrs * _Pi(1 / 6) - _Pi(1 / 2) + _Pi(1 / 2)), x + 1 / 10 * r * Cos(hrs * _Pi(1 / 6) - _Pi(1 / 2) - _Pi(1 / 2)), y + 1 / 10 * r * Sin(hrs * _Pi(1 / 6) - _Pi(1 / 2) - _Pi(1 / 2)), x + 2 / 3 * r * Cos(hrs * _Pi(1 / 6) - _Pi(1 / 2)), y + 2 / 3 * r * Sin(hrs * _Pi(1 / 6) - _Pi(1 / 2)), _RGB32(128)
  103.     Line (x, y)-(x + r * Cos(Val(Right$(Time$, 2)) * _Pi(1 / 30) - _Pi(1 / 2)), y + r * Sin(Val(Right$(Time$, 2)) * _Pi(1 / 30) - _Pi(1 / 2))), _RGB32(100)
  104.     Circle (x, y), 1 / 10 * r, _RGB32(255, 255, 255)
  105.     Paint (x + 1 / 75 * r, y + 1 / 75 * r), &HFF888888, _RGB32(255, 255, 255)
  106.     Circle (x, y), 1 / 30 * r, _RGB32(0, 0, 0)
  108.  
  109. Sub ftri0 (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
  110.     Dim D As Long, a&
  111.     D = _Dest
  112.     a& = _NewImage(1, 1, 32)
  113.     _Dest a&
  114.     PSet (0, 0), K
  115.     _Dest D
  116.     _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
  117.     _FreeImage a& '<<< this is important!
  119.  
  120. Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
  121.     Dim D As Long
  122.     Static a&
  123.     D = _Dest
  124.     If a& = 0 Then a& = _NewImage(1, 1, 32)
  125.     _Dest a&
  126.     _DontBlend a& '  '<<<< new 2019-12-16 fix
  127.     PSet (0, 0), K
  128.     _Blend a& '<<<< new 2019-12-16 fix
  129.     _Dest D
  130.     _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
  132.  
  133. Sub RotoZoom3 (X As Long, Y As Long, Image As Long, xScale As Single, yScale As Single, radianRotation As Single) ' 0 at end means no scaling of x or y
  134.     Dim px(3) As Single: Dim py(3) As Single
  135.     Dim W&, H&, sinr!, cosr!, i&, x2&, y2&
  136.     W& = _Width(Image&): H& = _Height(Image&)
  137.     px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
  138.     px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
  139.     sinr! = Sin(-radianRotation): cosr! = Cos(-radianRotation)
  140.     For i& = 0 To 3
  141.         x2& = xScale * (px(i&) * cosr! + sinr! * py(i&)) + X: y2& = yScale * (py(i&) * cosr! - px(i&) * sinr!) + Y
  142.         px(i&) = x2&: py(i&) = y2&
  143.     Next
  144.     _MapTriangle _Seamless(0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
  145.     _MapTriangle _Seamless(0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
  147.  
  148. Function rrnd (n1, n2) 'return real number (_single, double, _float depending on default / define setup)
  149.     rrnd = (n2 - n1) * Rnd + n1
  151.  
  152. Sub sayTime ' modified to show Time as well
  153.     Static As Long Tyme(59), beenHere, fnt, SF
  154.     Dim file$, t$
  155.     Dim As Long i, h, m
  156.     If beenHere = 0 Then
  157.         fnt = _LoadFont("Arial.ttf", 128, "MONOSPACE") ' << font size chosen to fit this app's screen size
  158.         For i = 0 To 59
  159.             file$ = "/Oggs/" + _Trim$(Str$(i)) + ".ogg"
  160.             Tyme(i) = _SndOpen("./" + file$)
  161.         Next
  162.         beenHere = -1
  163.     End If
  164.     SF = _Font
  165.     _Font fnt
  166.     Cls
  167.     t$ = Time$
  168.     _PrintString ((_Width - _PrintWidth(t$)) / 2, (_Height - _FontHeight(fnt)) / 2), t$
  169.     _Display
  170.     h = Val(Left$(t$, 2)) Mod 12
  171.     m = Val(Mid$(t$, 4, 2))
  172.     _SndPlay Tyme(h)
  173.     While _SndPlaying(Tyme(h)): _Limit 30: Wend
  174.     If Mid$(t$, 4, 1) = "0" Then
  175.         _SndPlay Tyme(0)
  176.         While _SndPlaying(Tyme(0)): _Limit 30: Wend
  177.     End If
  178.     _SndPlay Tyme(m)
  179.     While _SndPlaying(Tyme(m)): _Limit 30: Wend
  180.     _Font SF
  182.  
  183. Sub fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
  184.     Dim Radius As Long, RadiusError As Long
  185.     Dim X As Long, Y As Long
  186.     Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
  187.     If Radius = 0 Then PSet (CX, CY), C: Exit Sub
  188.     Line (CX - X, CY)-(CX + X, CY), C, BF
  189.     While X > Y
  190.         RadiusError = RadiusError + Y * 2 + 1
  191.         If RadiusError >= 0 Then
  192.             If X <> Y + 1 Then
  193.                 Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  194.                 Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  195.             End If
  196.             X = X - 1
  197.             RadiusError = RadiusError - X * 2
  198.         End If
  199.         Y = Y + 1
  200.         Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  201.         Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  202.     Wend
  204.  
  205. ' Function returns Image Handle& (like _LoadFile)
  206. Function LoadCustomImage& (fileLoadBaseName$) ' reverse the Save
  207.     Dim As Long w, h
  208.     Open fileLoadBaseName$ + ".CI_DIM" For Input As #1 ' get dimensions of custom image
  209.     Input #1, w
  210.     Input #1, h
  211.     Close #1
  212.     Dim imgHdl&: imgHdl& = _NewImage(w, h, 32) 'setup space and handle for it
  213.     Dim M As _MEM: M = _MemImage(imgHdl&) ' put data into handle space reserved
  214.     Dim screenGrab$: screenGrab$ = Space$(M.SIZE)
  215.     Open fileLoadBaseName$ + ".CI" For Binary As #1 ' get data
  216.     screenGrab$ = Space$(LOF(1))
  217.     Get #1, , screenGrab$
  218.     Close #1
  219.     screenGrab$ = _Inflate$(screenGrab$) ' fixed ?
  220.     _MemPut M, M.OFFSET, screenGrab$
  221.     LoadCustomImage& = imgHdl& ' finally assign the function
  223.  
  224.  

 


Here is a zip with Oggs, Image Editor I used to fix up the image and saved for CustomLoad and test for SayTime sub but I further modified it in Time Passing code.

OK see Best Answer for improved SayTime sub routine for more natural sound Time announcement.
Title: Re: Passing Time
Post by: SMcNeill on January 25, 2022, 03:23:47 am
You might want this sound file rather than the ZERO for the time:   [ This attachment cannot be displayed inline in 'Print Page' view ]  

It's the sound file for "OH", rather than for "ZERO", which sounds much more natural to me.  "Twelve Oh-Four", for instance, for 12:04.  "Twelve Zero Four" just sounds off somehow to me, though that might just be a regional thing perhaps??  How does the rest of the world read that time?  "Twelve Four"?  "Twelve Oh Four"?  "Twelve Zero Four"?  I dunno!
Title: Re: Passing Time
Post by: bplus on January 25, 2022, 08:57:39 am
@SMcNeill  Thanks again!

Perfect, yes 11, 3 sounded wrong, which is why I added the zero but not quite right either! Around my parts everyone says 11, oh 3.
Title: Re: Passing Time
Post by: SMcNeill on January 25, 2022, 09:39:21 am
You may need to convert to .ogg format for it to work in QB64.  Most wav files fail to load and work for me.  (Or grab the archive I posted in General Discussion, as it has the files all converted in it already.)
Title: Re: Passing Time
Post by: bplus on January 25, 2022, 11:52:20 am
Quote from: SMcNeill on January 25, 2022, 09:39:21 am
You may need to convert to .ogg format for it to work in QB64.  Most wav files fail to load and work for me.  (Or grab the archive I posted in General Discussion, as it has the files all converted in it already.)

Yeah I just tested O.wav and it failed to load, sounds fine directly in Windows.
Title: Re: Passing Time
Post by: bplus on January 25, 2022, 01:22:54 pm
OK I updated the Oggs with the "O.ogg" it works for putting "oh" sound in for single digit minutes so it's more natural sounding at least in USA.

The SayTime demo is updated also with PassTime.bas source so here is the updated .zip the last will be deleted as soon as I test download from here (and it's OK).

Title: Re: Passing Time
Post by: bplus on January 25, 2022, 09:03:03 pm
Ohhhh crap! Screwing around with all those Ogg files, on Windows I coulda just used this to SayTime:

Code: QB64: [Select]
  1. _Title "SayTime test" 'b+ 2022-01-25 mod to much much simpler way!!!
  2.  
  3. 'for quick test
  6.     k$ = InKey$
  7.     If Len(k$) Then SayTime: Print Time$: _KeyClear
  8.     _Limit 30
  10.  
  11. Sub SayTime
  12.     Dim As String t, message, m, s
  13.     Dim As Long h
  14.     t = Time$
  15.     't = "23:03:05"  ' test single digit minutes and seconds
  16.     h = Val(Left$(t, 2)) Mod 12
  17.     m = Mid$(t, 4, 2)
  18.     If Left$(m, 1) = "0" Then m = "O " + Right$(m, 1)
  19.     s = Str$(Val(Mid$(t, 7, 2)))
  20.     message = Str$(h) + "   " + m + "  and " + s + "  seconds"
  21.     Shell _Hide "Powershell -Command " + Chr$(34) + "Add-Type -AssemblyName System.Speech; (New-Object System.Speech.Synthesis.SpeechSynthesizer).Speak('" + message + "');" + Chr$(34)
  23.  
  24.  

Smack!  Sooooo... simple!
Title: Re: Passing Time
Post by: SMcNeill on January 25, 2022, 09:06:40 pm
You could've, but it wouldn't have been cross-platform compatible.  :P
Title: Re: Passing Time
Post by: bplus on January 25, 2022, 09:22:15 pm
For Windows Only! no fuss with all those oggs, AND (almost) no interruption of program flow while announcing the time!!

Code: QB64: [Select]
  2. _Title "Does anyone really know what time it is?" ' b+ 2022-01-23
  3. ' 2022-01-24 now with Steve's audio time announcer! Press spacebar.
  4. ' And now with customImage load of a wonderful back side of a Time piece.
  5. ' Made a number of modifications to SayTime sub and Clock drawing
  6.  
  7. Type obj
  8.     As Single X, Y, ScaleX, ScaleY, RotXY, DScaleX, DScaleY, DRotXY, ScaleLimit
  10.  
  11. Const SW = 1025, SH = 721, NClocks = 40
  12. Screen _NewImage(SW, SH, 32)
  13. _ScreenMove 150, 10
  15.  
  16. Dim Shared Clocks(1 To NClocks) As obj
  17. Dim As Long c, b, midP, i, bl
  18. Dim k$
  19.  
  20. '  check clock drawing
  21. c = _NewImage(351, 351, 32) ' for the c=clock face conatiner
  22. midP = Int((351 - 1) / 2)
  23. 'fcirc midP, midP, 165, &HFF114422
  24. 'clock midP, midP, 150
  25. 'Line (0, 0)-(351, 351), , B ' check centering
  26. 'Sleep
  27.  
  28. ' create back of clock image
  29. bl = LoadCustomImage("Clock Back") ' pretty cool image!!!
  30. b = _NewImage(351, 351, 32)
  31. _PutImage , bl, b
  32. _ClearColor _RGB(0, 128, 0), b
  33. ' check our image
  34. 'Cls , &HFFFFFFFF
  35. '_PutImage (0, 0), b, 0
  36. 'Line (0, 0)-(351, 351), &HFF000000, B
  37. 'Sleep
  38.  
  39. For i = 1 To NClocks
  40.     newClock i, 1
  43.     Cls
  44.     _Title "Does anyone really know what time it is? Sure just press the spacebar."
  45.     k$ = InKey$
  46.     If k$ = " " Then SayTime
  47.     _Dest c&
  48.     Line (0, 0)-(351, 351), &HFF000000, BF ' blank out fro redraw
  49.     For i = 165 To 0 Step -1
  50.         fcirc midP, midP, i, _RGB32(220 - i)
  51.     Next
  52.     clock midP, midP, 150
  53.     _Dest 0
  54.     _ClearColor &HFF000000, c
  55.     For i = 1 To NClocks
  56.         If (Clocks(i).ScaleX > 0 And Clocks(i).ScaleY > 0) Or (Clocks(i).ScaleX < 0 And Clocks(i).ScaleY < 0) Then
  57.             RotoZoom3 Clocks(i).X, Clocks(i).Y, c, Clocks(i).ScaleX, Clocks(i).ScaleY, Clocks(i).RotXY
  58.         Else
  59.             RotoZoom3 Clocks(i).X, Clocks(i).Y, b, Clocks(i).ScaleX, Clocks(i).ScaleY, Clocks(i).RotXY
  60.         End If
  61.         Clocks(i).Y = Clocks(i).Y + 1
  62.         If Clocks(i).Y > _Height + 150 Then
  63.             newClock i, 0
  64.         Else
  65.             'updates
  66.             Clocks(i).ScaleX = Clocks(i).ScaleX + Clocks(i).DScaleX
  67.             If Clocks(i).ScaleX < -Clocks(i).ScaleLimit Then Clocks(i).DScaleX = -Clocks(i).DScaleX: Clocks(i).ScaleX = -Clocks(i).ScaleLimit
  68.             If Clocks(i).ScaleX > Clocks(i).ScaleLimit Then Clocks(i).DScaleX = -Clocks(i).DScaleX: Clocks(i).ScaleX = Clocks(i).ScaleLimit
  69.             Clocks(i).ScaleY = Clocks(i).ScaleY + Clocks(i).DScaleY
  70.             If Clocks(i).ScaleY < -Clocks(i).ScaleLimit Then Clocks(i).DScaleY = -Clocks(i).DScaleY: Clocks(i).ScaleY = -Clocks(i).ScaleLimit
  71.             If Clocks(i).ScaleY > Clocks(i).ScaleLimit Then Clocks(i).DScaleY = -Clocks(i).DScaleY: Clocks(i).ScaleY = Clocks(i).ScaleLimit
  72.             Clocks(i).RotXY = Clocks(i).RotXY + Clocks(i).DRotXY
  73.         End If
  74.     Next
  75.     _Display
  76.     _Limit 60
  78.  
  79. Sub newClock (i, initTF)
  80.     Clocks(i).X = Rnd * SW
  81.     If initTF Then Clocks(i).Y = rrnd(-150, SH) Else Clocks(i).Y = -150
  82.     Clocks(i).ScaleLimit = 1
  83.     Clocks(i).ScaleX = rrnd(-Clocks(i).ScaleLimit, Clocks(i).ScaleLimit)
  84.     Clocks(i).ScaleY = rrnd(-Clocks(i).ScaleLimit, Clocks(i).ScaleLimit)
  85.     Clocks(i).DScaleX = rrnd(-.005 * Clocks(i).ScaleLimit, .005 * Clocks(i).ScaleLimit)
  86.     Clocks(i).DScaleY = rrnd(-.005 * Clocks(i).ScaleLimit, .005 * Clocks(i).ScaleLimit)
  87.     Clocks(i).RotXY = _Pi(2) * Rnd
  88.     Clocks(i).DRotXY = rrnd(-.005 * _Pi, .005 * _Pi)
  90.  
  91. Sub clock (x, y, r)
  92.     Dim a, r1, hrs, clr~&
  93.     For a = 0 To 359 Step 6
  94.         clr~& = &HFF888888
  95.         If a Mod 30 = 0 Then r1 = 1 / 30 * r Else r1 = 1 / 75 * r
  96.         If a Mod 360 = 270 Then r1 = 1 / 15 * r: clr~& = &HFFFFFFFF
  97.         Circle (x + r * Cos(_D2R(a)), y + r * Sin(_D2R(a))), r1
  98.         fcirc x + r * Cos(_D2R(a)), y + r * Sin(_D2R(a)), r1 - 2, clr~& ' _RGB32(255, 255, 255)
  99.     Next
  100.     If Val(Left$(Time$, 2)) + (Val(Mid$(Time$, 4, 2)) / 60) >= 12 Then hrs = Val(Left$(Time$, 2)) + (Val(Mid$(Time$, 4, 2)) / 60) - 12 Else hrs = Val(Left$(Time$, 2)) + (Val(Mid$(Time$, 4, 2)) / 60)
  101.     ftri x + 1 / 15 * r * Cos(Val(Mid$(Time$, 4, 2)) * _Pi(1 / 30) - _Pi(1 / 2) + _Pi(1 / 2)), y + 1 / 15 * r * Sin(Val(Mid$(Time$, 4, 2)) * _Pi(1 / 30) - _Pi(1 / 2) + _Pi(1 / 2)), x + 1 / 15 * r * Cos(Val(Mid$(Time$, 4, 2)) * _Pi(1 / 30) - _Pi(1 / 2) - _Pi(1 / 2)), y + 1 / 15 * r * Sin(Val(Mid$(Time$, 4, 2)) * _Pi(1 / 30) - _Pi(1 / 2) - _Pi(1 / 2)), x + r * Cos(Val(Mid$(Time$, 4, 2)) * _Pi(1 / 30) - _Pi(1 / 2)), y + r * Sin(Val(Mid$(Time$, 4, 2)) * _Pi(1 / 30) - _Pi(1 / 2)), _RGB32(128)
  102.     ftri x + 1 / 10 * r * Cos(hrs * _Pi(1 / 6) - _Pi(1 / 2) + _Pi(1 / 2)), y + 1 / 10 * r * Sin(hrs * _Pi(1 / 6) - _Pi(1 / 2) + _Pi(1 / 2)), x + 1 / 10 * r * Cos(hrs * _Pi(1 / 6) - _Pi(1 / 2) - _Pi(1 / 2)), y + 1 / 10 * r * Sin(hrs * _Pi(1 / 6) - _Pi(1 / 2) - _Pi(1 / 2)), x + 2 / 3 * r * Cos(hrs * _Pi(1 / 6) - _Pi(1 / 2)), y + 2 / 3 * r * Sin(hrs * _Pi(1 / 6) - _Pi(1 / 2)), _RGB32(128)
  103.     Line (x, y)-(x + r * Cos(Val(Right$(Time$, 2)) * _Pi(1 / 30) - _Pi(1 / 2)), y + r * Sin(Val(Right$(Time$, 2)) * _Pi(1 / 30) - _Pi(1 / 2))), _RGB32(100)
  104.     Circle (x, y), 1 / 10 * r, _RGB32(255, 255, 255)
  105.     Paint (x + 1 / 75 * r, y + 1 / 75 * r), &HFF888888, _RGB32(255, 255, 255)
  106.     Circle (x, y), 1 / 30 * r, _RGB32(0, 0, 0)
  108.  
  109. Sub ftri0 (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
  110.     Dim D As Long, a&
  111.     D = _Dest
  112.     a& = _NewImage(1, 1, 32)
  113.     _Dest a&
  114.     PSet (0, 0), K
  115.     _Dest D
  116.     _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
  117.     _FreeImage a& '<<< this is important!
  119.  
  120. Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
  121.     Dim D As Long
  122.     Static a&
  123.     D = _Dest
  124.     If a& = 0 Then a& = _NewImage(1, 1, 32)
  125.     _Dest a&
  126.     _DontBlend a& '  '<<<< new 2019-12-16 fix
  127.     PSet (0, 0), K
  128.     _Blend a& '<<<< new 2019-12-16 fix
  129.     _Dest D
  130.     _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
  132.  
  133. Sub RotoZoom3 (X As Long, Y As Long, Image As Long, xScale As Single, yScale As Single, radianRotation As Single) ' 0 at end means no scaling of x or y
  134.     Dim px(3) As Single: Dim py(3) As Single
  135.     Dim W&, H&, sinr!, cosr!, i&, x2&, y2&
  136.     W& = _Width(Image&): H& = _Height(Image&)
  137.     px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
  138.     px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
  139.     sinr! = Sin(-radianRotation): cosr! = Cos(-radianRotation)
  140.     For i& = 0 To 3
  141.         x2& = xScale * (px(i&) * cosr! + sinr! * py(i&)) + X: y2& = yScale * (py(i&) * cosr! - px(i&) * sinr!) + Y
  142.         px(i&) = x2&: py(i&) = y2&
  143.     Next
  144.     _MapTriangle _Seamless(0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
  145.     _MapTriangle _Seamless(0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
  147.  
  148. Function rrnd (n1, n2) 'return real number (_single, double, _float depending on default / define setup)
  149.     rrnd = (n2 - n1) * Rnd + n1
  151.  
  152. Sub fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
  153.     Dim Radius As Long, RadiusError As Long
  154.     Dim X As Long, Y As Long
  155.     Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
  156.     If Radius = 0 Then PSet (CX, CY), C: Exit Sub
  157.     Line (CX - X, CY)-(CX + X, CY), C, BF
  158.     While X > Y
  159.         RadiusError = RadiusError + Y * 2 + 1
  160.         If RadiusError >= 0 Then
  161.             If X <> Y + 1 Then
  162.                 Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  163.                 Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  164.             End If
  165.             X = X - 1
  166.             RadiusError = RadiusError - X * 2
  167.         End If
  168.         Y = Y + 1
  169.         Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  170.         Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  171.     Wend
  173.  
  174. ' Function returns Image Handle& (like _LoadFile)
  175. Function LoadCustomImage& (fileLoadBaseName$) ' reverse the Save
  176.     Dim As Long w, h
  177.     Open fileLoadBaseName$ + ".CI_DIM" For Input As #1 ' get dimensions of custom image
  178.     Input #1, w
  179.     Input #1, h
  180.     Close #1
  181.     Dim imgHdl&: imgHdl& = _NewImage(w, h, 32) 'setup space and handle for it
  182.     Dim M As _MEM: M = _MemImage(imgHdl&) ' put data into handle space reserved
  183.     Dim screenGrab$: screenGrab$ = Space$(M.SIZE)
  184.     Open fileLoadBaseName$ + ".CI" For Binary As #1 ' get data
  185.     screenGrab$ = Space$(LOF(1))
  186.     Get #1, , screenGrab$
  187.     Close #1
  188.     screenGrab$ = _Inflate$(screenGrab$) ' fixed ?
  189.     _MemPut M, M.OFFSET, screenGrab$
  190.     LoadCustomImage& = imgHdl& ' finally assign the function
  192.  
  193. Sub SayTime
  194.     Dim As String t, message, m, s
  195.     Dim As Long h
  196.     t = Time$
  197.     't = "23:03:05"
  198.     h = Val(Left$(t, 2)) Mod 12
  199.     m = Mid$(t, 4, 2)
  200.     If Left$(m, 1) = "0" Then m = "O " + Right$(m, 1)
  201.     s = Str$(Val(Mid$(t, 7, 2)))
  202.     message = Str$(h) + "   " + m + "  and " + s + "  seconds"
  203.     Shell _DontWait _Hide "Powershell -Command " + Chr$(34) + "Add-Type -AssemblyName System.Speech; (New-Object System.Speech.Synthesis.SpeechSynthesizer).Speak('" + message + "');" + Chr$(34)
  205.  
  206.  

Still need zip for custom image files.

BTW this one is reporting seconds also :)  it's so easy!

And Thanks to @SierraKen for reminding of that simple one liner sub! :)
Text Only | Text with Attachments