Author Topic: Passing Time  (Read 6163 times)

0 Members and 1 Guest are viewing this topic.

This topic contains a post which is marked as Best Answer. Press here if you would like to see it.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Passing Time
« on: January 23, 2022, 05:10:52 pm »
More fun with RotoZoom3
Code: QB64: [Select]
  1. _Title "Does anyone really know what time it is?" ' b+ 2022-01-23
  2. Type obj
  3.     As Single X, Y, ScaleX, ScaleY, RotXY, DScaleX, DScaleY, DRotXY, ScaleLimit
  4.  
  5. Const SW = 1025, SH = 721, NClocks = 40
  6. Screen _NewImage(SW, SH, 32)
  7. _ScreenMove 150, 10
  8. Dim midP, i
  9. c& = _NewImage(313, 313, 32)
  10. midP = Int((313 - 1) / 2)
  11. clock midP, midP, 149
  12. 'Line (0, 0)-(311, 311), , B ' check centering
  13. _ClearColor &HFF000000, c&
  14. Dim Shared Clocks(1 To NClocks) As obj
  15. For i = 1 To NClocks
  16.     newClock i, 1
  17.     Cls
  18.     _Title "Does anyone really know what time it is? Sure " + Time$
  19.     _Dest c&
  20.     Line (0, 0)-(311, 311), &HFF000000, BF ' blank out fro redraw
  21.     midP = Int((313 - 1) / 2)
  22.     clock midP, midP, 149
  23.     _Dest 0
  24.     _ClearColor &HFF000000, c&
  25.     For i = 1 To NClocks
  26.         RotoZoom3 Clocks(i).X, Clocks(i).Y, c&, Clocks(i).ScaleX, Clocks(i).ScaleY, Clocks(i).RotXY
  27.         Clocks(i).Y = Clocks(i).Y + 1
  28.         If Clocks(i).Y > _Height + 150 Then
  29.             newClock i, 0
  30.         Else
  31.             'updates
  32.             Clocks(i).ScaleX = Clocks(i).ScaleX + Clocks(i).DScaleX
  33.             If Clocks(i).ScaleX < -Clocks(i).ScaleLimit Then Clocks(i).DScaleX = -Clocks(i).DScaleX: Clocks(i).ScaleX = -Clocks(i).ScaleLimit
  34.             If Clocks(i).ScaleX > Clocks(i).ScaleLimit Then Clocks(i).DScaleX = -Clocks(i).DScaleX: Clocks(i).ScaleX = Clocks(i).ScaleLimit
  35.             Clocks(i).ScaleY = Clocks(i).ScaleY + Clocks(i).DScaleY
  36.             If Clocks(i).ScaleY < -Clocks(i).ScaleLimit Then Clocks(i).DScaleY = -Clocks(i).DScaleY: Clocks(i).ScaleY = -Clocks(i).ScaleLimit
  37.             If Clocks(i).ScaleY > Clocks(i).ScaleLimit Then Clocks(i).DScaleY = -Clocks(i).DScaleY: Clocks(i).ScaleY = Clocks(i).ScaleLimit
  38.             Clocks(i).RotXY = Clocks(i).RotXY + Clocks(i).DRotXY
  39.         End If
  40.     Next
  41.     _Display
  42.     _Limit 60
  43.  
  44. Sub newClock (i, initTF)
  45.     Clocks(i).X = Rnd * SW
  46.     If initTF Then Clocks(i).Y = rrnd(-150, SH) Else Clocks(i).Y = -150
  47.     Clocks(i).ScaleLimit = 1
  48.     Clocks(i).ScaleX = rrnd(-Clocks(i).ScaleLimit, Clocks(i).ScaleLimit)
  49.     Clocks(i).ScaleY = rrnd(-Clocks(i).ScaleLimit, Clocks(i).ScaleLimit)
  50.     Clocks(i).DScaleX = rrnd(-.005 * Clocks(i).ScaleLimit, .005 * Clocks(i).ScaleLimit)
  51.     Clocks(i).DScaleY = rrnd(-.005 * Clocks(i).ScaleLimit, .005 * Clocks(i).ScaleLimit)
  52.     Clocks(i).RotXY = _Pi(2) * Rnd
  53.     Clocks(i).DRotXY = rrnd(-.005 * _Pi, .005 * _Pi)
  54.  
  55. Sub clock (x, y, r)
  56.     Dim a, r1, hrs
  57.     For a = 0 To 359 Step 6
  58.         If a Mod 30 = 0 Then r1 = 1 / 30 * r Else r1 = 1 / 75 * r
  59.         Circle (x + r * Cos(_D2R(a)), y + r * Sin(_D2R(a))), r1
  60.         Paint (x + r * Cos(_D2R(a)), y + r * Sin(_D2R(a))), _RGB32(100, 100, 100), _RGB32(255, 255, 255)
  61.     Next
  62.     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)
  63.     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)
  64.     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)
  65.     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)
  66.     Circle (x, y), 1 / 10 * r, _RGB32(255, 255, 255)
  67.     Paint (x + 1 / 75 * r, y + 1 / 75 * r), _RGB32(100, 100, 100), _RGB32(255, 255, 255)
  68.     Circle (x, y), 1 / 30 * r, _RGB32(0, 0, 0)
  69.  
  70. Sub ftri0 (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
  71.     Dim D As Long, a&
  72.     D = _Dest
  73.     a& = _NewImage(1, 1, 32)
  74.     _Dest a&
  75.     PSet (0, 0), K
  76.     _Dest D
  77.     _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
  78.     _FreeImage a& '<<< this is important!
  79.  
  80. 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
  81.     Dim px(3) As Single: Dim py(3) As Single
  82.     Dim W&, H&, sinr!, cosr!, i&, x2&, y2&
  83.     W& = _Width(Image&): H& = _Height(Image&)
  84.     px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
  85.     px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
  86.     sinr! = Sin(-radianRotation): cosr! = Cos(-radianRotation)
  87.     For i& = 0 To 3
  88.         x2& = xScale * (px(i&) * cosr! + sinr! * py(i&)) + X: y2& = yScale * (py(i&) * cosr! - px(i&) * sinr!) + Y
  89.         px(i&) = x2&: py(i&) = y2&
  90.     Next
  91.     _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))
  92.     _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))
  93.  
  94. Function rrnd (n1, n2) 'return real number (_single, double, _float depending on default / define setup)
  95.     rrnd = (n2 - n1) * Rnd + n1
  96.  
  97.  

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Passing Time
« Reply #1 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

Offline johnno56

  • Forum Resident
  • Posts: 1270
  • Live long and prosper.
    • View Profile
Re: Passing Time
« Reply #2 on: January 24, 2022, 06:44:18 am »
Reminded me of the intro to The Time Machine (1960)... Cool...
Logic is the beginning of wisdom.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Passing Time
« Reply #3 on: January 24, 2022, 11:21:20 am »
Thanks guys. I have been considering putting in different clocks.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Passing Time
« Reply #4 on: January 24, 2022, 01:33:37 pm »
I see your passing time and scoff at it!  Behold the simplicity of the Time Clicker!

* Time Clicker.7z (Filesize: 145.9 KB, Downloads: 321)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Passing Time
« Reply #5 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.

Offline bplus

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

 
Passing Time mod.PNG


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.
« Last Edit: January 25, 2022, 01:27:32 pm by bplus »

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Passing Time
« Reply #7 on: January 25, 2022, 03:23:47 am »
You might want this sound file rather than the ZERO for the time: 

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!
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Passing Time
« Reply #8 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.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Passing Time
« Reply #9 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.)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Passing Time
« Reply #10 on: January 25, 2022, 11:52:20 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.

Marked as best answer by bplus on January 25, 2022, 08:27:42 am

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Passing Time
« Reply #11 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).

* Passing Time.zip (Filesize: 415.86 KB, Downloads: 171)

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Passing Time
« Reply #12 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
  4.     k$ = InKey$
  5.     If Len(k$) Then SayTime: Print Time$: _KeyClear
  6.     _Limit 30
  7.  
  8. Sub SayTime
  9.     Dim As String t, message, m, s
  10.     Dim As Long h
  11.     t = Time$
  12.     't = "23:03:05"  ' test single digit minutes and seconds
  13.     h = Val(Left$(t, 2)) Mod 12
  14.     m = Mid$(t, 4, 2)
  15.     If Left$(m, 1) = "0" Then m = "O " + Right$(m, 1)
  16.     s = Str$(Val(Mid$(t, 7, 2)))
  17.     message = Str$(h) + "   " + m + "  and " + s + "  seconds"
  18.     Shell _Hide "Powershell -Command " + Chr$(34) + "Add-Type -AssemblyName System.Speech; (New-Object System.Speech.Synthesis.SpeechSynthesizer).Speak('" + message + "');" + Chr$(34)
  19.  
  20.  

Smack!  Sooooo... simple!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Passing Time
« Reply #13 on: January 25, 2022, 09:06:40 pm »
You could've, but it wouldn't have been cross-platform compatible.  :P
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline bplus

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

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! :)
* Passing Time Win Only.zip (Filesize: 64.66 KB, Downloads: 175)
« Last Edit: January 25, 2022, 09:29:46 pm by bplus »