Author Topic: Passing Time (Read 6165 times)

bplus · « **on:** January 23, 2022, 05:10:52 pm »

More fun with RotoZoom3

Code: QB64: [Select]

Option _Explicit
_Title "Does anyone really know what time it is?" ' b+ 2022-01-23
Type obj
    As Single X, Y, ScaleX, ScaleY, RotXY, DScaleX, DScaleY, DRotXY, ScaleLimit
End Type
 
Const SW = 1025, SH = 721, NClocks = 40
Screen _NewImage(SW, SH, 32)
_ScreenMove 150, 10
Randomize Timer
Dim Shared c&
Dim midP, i
c& = _NewImage(313, 313, 32)
_Dest c&
midP = Int((313 - 1) / 2)
clock midP, midP, 149
'Line (0, 0)-(311, 311), , B ' check centering
_Dest 0
_ClearColor &HFF000000, c&
Dim Shared Clocks(1 To NClocks) As obj
For i = 1 To NClocks
    newClock i, 1
Next
Do
    Cls
    _Title "Does anyone really know what time it is? Sure " + Time$
    _Dest c&
    Line (0, 0)-(311, 311), &HFF000000, BF ' blank out fro redraw
    midP = Int((313 - 1) / 2)
    clock midP, midP, 149
    _Dest 0
    _ClearColor &HFF000000, c&
    For i = 1 To NClocks
        RotoZoom3 Clocks(i).X, Clocks(i).Y, c&, Clocks(i).ScaleX, Clocks(i).ScaleY, Clocks(i).RotXY
        Clocks(i).Y = Clocks(i).Y + 1
        If Clocks(i).Y > _Height + 150 Then
            newClock i, 0
        Else
            'updates
            Clocks(i).ScaleX = Clocks(i).ScaleX + Clocks(i).DScaleX
            If Clocks(i).ScaleX < -Clocks(i).ScaleLimit Then Clocks(i).DScaleX = -Clocks(i).DScaleX: Clocks(i).ScaleX = -Clocks(i).ScaleLimit
            If Clocks(i).ScaleX > Clocks(i).ScaleLimit Then Clocks(i).DScaleX = -Clocks(i).DScaleX: Clocks(i).ScaleX = Clocks(i).ScaleLimit
            Clocks(i).ScaleY = Clocks(i).ScaleY + Clocks(i).DScaleY
            If Clocks(i).ScaleY < -Clocks(i).ScaleLimit Then Clocks(i).DScaleY = -Clocks(i).DScaleY: Clocks(i).ScaleY = -Clocks(i).ScaleLimit
            If Clocks(i).ScaleY > Clocks(i).ScaleLimit Then Clocks(i).DScaleY = -Clocks(i).DScaleY: Clocks(i).ScaleY = Clocks(i).ScaleLimit
            Clocks(i).RotXY = Clocks(i).RotXY + Clocks(i).DRotXY
        End If
    Next
    _Display
    _Limit 60
Loop Until _KeyDown(27)
 
Sub newClock (i, initTF)
    Clocks(i).X = Rnd * SW
    If initTF Then Clocks(i).Y = rrnd(-150, SH) Else Clocks(i).Y = -150
    Clocks(i).ScaleLimit = 1
    Clocks(i).ScaleX = rrnd(-Clocks(i).ScaleLimit, Clocks(i).ScaleLimit)
    Clocks(i).ScaleY = rrnd(-Clocks(i).ScaleLimit, Clocks(i).ScaleLimit)
    Clocks(i).DScaleX = rrnd(-.005 * Clocks(i).ScaleLimit, .005 * Clocks(i).ScaleLimit)
    Clocks(i).DScaleY = rrnd(-.005 * Clocks(i).ScaleLimit, .005 * Clocks(i).ScaleLimit)
    Clocks(i).RotXY = _Pi(2) * Rnd
    Clocks(i).DRotXY = rrnd(-.005 * _Pi, .005 * _Pi)
End Sub
 
Sub clock (x, y, r)
    Dim a, r1, hrs
    For a = 0 To 359 Step 6
        If a Mod 30 = 0 Then r1 = 1 / 30 * r Else r1 = 1 / 75 * r
        Circle (x + r * Cos(_D2R(a)), y + r * Sin(_D2R(a))), r1
        Paint (x + r * Cos(_D2R(a)), y + r * Sin(_D2R(a))), _RGB32(100, 100, 100), _RGB32(255, 255, 255)
    Next
    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)
    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)
    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)
    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)
    Circle (x, y), 1 / 10 * r, _RGB32(255, 255, 255)
    Paint (x + 1 / 75 * r, y + 1 / 75 * r), _RGB32(100, 100, 100), _RGB32(255, 255, 255)
    Circle (x, y), 1 / 30 * r, _RGB32(0, 0, 0)
End Sub
 
Sub ftri0 (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    Dim D As Long, a&
    D = _Dest
    a& = _NewImage(1, 1, 32)
    _Dest a&
    PSet (0, 0), K
    _Dest D
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
    _FreeImage a& '<<< this is important!
End Sub
 
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
    Dim px(3) As Single: Dim py(3) As Single
    Dim W&, H&, sinr!, cosr!, i&, x2&, y2&
    W& = _Width(Image&): H& = _Height(Image&)
    px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
    px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
    sinr! = Sin(-radianRotation): cosr! = Cos(-radianRotation)
    For i& = 0 To 3
        x2& = xScale * (px(i&) * cosr! + sinr! * py(i&)) + X: y2& = yScale * (py(i&) * cosr! - px(i&) * sinr!) + Y
        px(i&) = x2&: py(i&) = y2&
    Next
    _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))
    _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))
End Sub
 
Function rrnd (n1, n2) 'return real number (_single, double, _float depending on default / define setup)
    rrnd = (n2 - n1) * Rnd + n1
End Function
 
 

SierraKen · « **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

johnno56 · « **Reply #2 on:** January 24, 2022, 06:44:18 am »

Reminded me of the intro to The Time Machine (1960)... Cool...

bplus · « **Reply #3 on:** January 24, 2022, 11:21:20 am »

Thanks guys. I have been considering putting in different clocks.

SMcNeill · « **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!

bplus · « **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.

bplus · « **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]

Option _Explicit
_Title "Does anyone really know what time it is?" ' b+ 2022-01-23
' 2022-01-24 now with Steve's audio time announcer! Press spacebar.
' And now with customImage load of a wonderful back side of a Time piece.
' Made a number of modifications to SayTime sub and Clock drawing
 
Type obj
    As Single X, Y, ScaleX, ScaleY, RotXY, DScaleX, DScaleY, DRotXY, ScaleLimit
End Type
 
Const SW = 1025, SH = 721, NClocks = 40
Screen _NewImage(SW, SH, 32)
_ScreenMove 150, 10
Randomize Timer
 
Dim Shared Clocks(1 To NClocks) As obj
Dim As Long c, b, midP, i, bl
Dim k$
 
'  check clock drawing
c = _NewImage(351, 351, 32) ' for the c=clock face conatiner
midP = Int((351 - 1) / 2)
'fcirc midP, midP, 165, &HFF114422
'clock midP, midP, 150
'Line (0, 0)-(351, 351), , B ' check centering
'Sleep
 
' create back of clock image
bl = LoadCustomImage("Clock Back") ' pretty cool image!!!
b = _NewImage(351, 351, 32)
_PutImage , bl, b
_ClearColor _RGB(0, 128, 0), b
' check our image
'Cls , &HFFFFFFFF
'_PutImage (0, 0), b, 0
'Line (0, 0)-(351, 351), &HFF000000, B
'Sleep
 
For i = 1 To NClocks
    newClock i, 1
Next
Do
    Cls
    _Title "Does anyone really know what time it is? Sure just press the spacebar."
    k$ = InKey$
    If k$ = " " Then sayTime
    _Dest c&
    Line (0, 0)-(351, 351), &HFF000000, BF ' blank out fro redraw
    For i = 165 To 0 Step -1
        fcirc midP, midP, i, _RGB32(220 - i)
    Next
    clock midP, midP, 150
    _Dest 0
    _ClearColor &HFF000000, c
    For i = 1 To NClocks
        If (Clocks(i).ScaleX > 0 And Clocks(i).ScaleY > 0) Or (Clocks(i).ScaleX < 0 And Clocks(i).ScaleY < 0) Then
            RotoZoom3 Clocks(i).X, Clocks(i).Y, c, Clocks(i).ScaleX, Clocks(i).ScaleY, Clocks(i).RotXY
        Else
            RotoZoom3 Clocks(i).X, Clocks(i).Y, b, Clocks(i).ScaleX, Clocks(i).ScaleY, Clocks(i).RotXY
        End If
        Clocks(i).Y = Clocks(i).Y + 1
        If Clocks(i).Y > _Height + 150 Then
            newClock i, 0
        Else
            'updates
            Clocks(i).ScaleX = Clocks(i).ScaleX + Clocks(i).DScaleX
            If Clocks(i).ScaleX < -Clocks(i).ScaleLimit Then Clocks(i).DScaleX = -Clocks(i).DScaleX: Clocks(i).ScaleX = -Clocks(i).ScaleLimit
            If Clocks(i).ScaleX > Clocks(i).ScaleLimit Then Clocks(i).DScaleX = -Clocks(i).DScaleX: Clocks(i).ScaleX = Clocks(i).ScaleLimit
            Clocks(i).ScaleY = Clocks(i).ScaleY + Clocks(i).DScaleY
            If Clocks(i).ScaleY < -Clocks(i).ScaleLimit Then Clocks(i).DScaleY = -Clocks(i).DScaleY: Clocks(i).ScaleY = -Clocks(i).ScaleLimit
            If Clocks(i).ScaleY > Clocks(i).ScaleLimit Then Clocks(i).DScaleY = -Clocks(i).DScaleY: Clocks(i).ScaleY = Clocks(i).ScaleLimit
            Clocks(i).RotXY = Clocks(i).RotXY + Clocks(i).DRotXY
        End If
    Next
    _Display
    _Limit 60
Loop Until _KeyDown(27)
 
Sub newClock (i, initTF)
    Clocks(i).X = Rnd * SW
    If initTF Then Clocks(i).Y = rrnd(-150, SH) Else Clocks(i).Y = -150
    Clocks(i).ScaleLimit = 1
    Clocks(i).ScaleX = rrnd(-Clocks(i).ScaleLimit, Clocks(i).ScaleLimit)
    Clocks(i).ScaleY = rrnd(-Clocks(i).ScaleLimit, Clocks(i).ScaleLimit)
    Clocks(i).DScaleX = rrnd(-.005 * Clocks(i).ScaleLimit, .005 * Clocks(i).ScaleLimit)
    Clocks(i).DScaleY = rrnd(-.005 * Clocks(i).ScaleLimit, .005 * Clocks(i).ScaleLimit)
    Clocks(i).RotXY = _Pi(2) * Rnd
    Clocks(i).DRotXY = rrnd(-.005 * _Pi, .005 * _Pi)
End Sub
 
Sub clock (x, y, r)
    Dim a, r1, hrs, clr~&
    For a = 0 To 359 Step 6
        clr~& = &HFF888888
        If a Mod 30 = 0 Then r1 = 1 / 30 * r Else r1 = 1 / 75 * r
        If a Mod 360 = 270 Then r1 = 1 / 15 * r: clr~& = &HFFFFFFFF
        Circle (x + r * Cos(_D2R(a)), y + r * Sin(_D2R(a))), r1
        fcirc x + r * Cos(_D2R(a)), y + r * Sin(_D2R(a)), r1 - 2, clr~& ' _RGB32(255, 255, 255)
    Next
    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)
    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)
    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)
    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)
    Circle (x, y), 1 / 10 * r, _RGB32(255, 255, 255)
    Paint (x + 1 / 75 * r, y + 1 / 75 * r), &HFF888888, _RGB32(255, 255, 255)
    Circle (x, y), 1 / 30 * r, _RGB32(0, 0, 0)
End Sub
 
Sub ftri0 (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    Dim D As Long, a&
    D = _Dest
    a& = _NewImage(1, 1, 32)
    _Dest a&
    PSet (0, 0), K
    _Dest D
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
    _FreeImage a& '<<< this is important!
End Sub
 
Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    Dim D As Long
    Static a&
    D = _Dest
    If a& = 0 Then a& = _NewImage(1, 1, 32)
    _Dest a&
    _DontBlend a& '  '<<<< new 2019-12-16 fix
    PSet (0, 0), K
    _Blend a& '<<<< new 2019-12-16 fix
    _Dest D
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
End Sub
 
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
    Dim px(3) As Single: Dim py(3) As Single
    Dim W&, H&, sinr!, cosr!, i&, x2&, y2&
    W& = _Width(Image&): H& = _Height(Image&)
    px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
    px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
    sinr! = Sin(-radianRotation): cosr! = Cos(-radianRotation)
    For i& = 0 To 3
        x2& = xScale * (px(i&) * cosr! + sinr! * py(i&)) + X: y2& = yScale * (py(i&) * cosr! - px(i&) * sinr!) + Y
        px(i&) = x2&: py(i&) = y2&
    Next
    _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))
    _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))
End Sub
 
Function rrnd (n1, n2) 'return real number (_single, double, _float depending on default / define setup)
    rrnd = (n2 - n1) * Rnd + n1
End Function
 
Sub sayTime ' modified to show Time as well
    Static As Long Tyme(59), beenHere, fnt, SF
    Dim file$, t$
    Dim As Long i, h, m
    If beenHere = 0 Then
        fnt = _LoadFont("Arial.ttf", 128, "MONOSPACE") ' << font size chosen to fit this app's screen size
        For i = 0 To 59
            file$ = "/Oggs/" + _Trim$(Str$(i)) + ".ogg"
            Tyme(i) = _SndOpen("./" + file$)
        Next
        beenHere = -1
    End If
    SF = _Font
    _Font fnt
    Cls
    t$ = Time$
    _PrintString ((_Width - _PrintWidth(t$)) / 2, (_Height - _FontHeight(fnt)) / 2), t$
    _Display
    h = Val(Left$(t$, 2)) Mod 12
    m = Val(Mid$(t$, 4, 2))
    _SndPlay Tyme(h)
    While _SndPlaying(Tyme(h)): _Limit 30: Wend
    If Mid$(t$, 4, 1) = "0" Then
        _SndPlay Tyme(0)
        While _SndPlaying(Tyme(0)): _Limit 30: Wend
    End If
    _SndPlay Tyme(m)
    While _SndPlaying(Tyme(m)): _Limit 30: Wend
    _Font SF
End Sub
 
Sub fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
    Dim Radius As Long, RadiusError As Long
    Dim X As Long, Y As Long
    Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
    If Radius = 0 Then PSet (CX, CY), C: Exit Sub
    Line (CX - X, CY)-(CX + X, CY), C, BF
    While X > Y
        RadiusError = RadiusError + Y * 2 + 1
        If RadiusError >= 0 Then
            If X <> Y + 1 Then
                Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    Wend
End Sub
 
' Function returns Image Handle& (like _LoadFile)
Function LoadCustomImage& (fileLoadBaseName$) ' reverse the Save
    Dim As Long w, h
    Open fileLoadBaseName$ + ".CI_DIM" For Input As #1 ' get dimensions of custom image
    Input #1, w
    Input #1, h
    Close #1
    Dim imgHdl&: imgHdl& = _NewImage(w, h, 32) 'setup space and handle for it
    Dim M As _MEM: M = _MemImage(imgHdl&) ' put data into handle space reserved
    Dim screenGrab$: screenGrab$ = Space$(M.SIZE)
    Open fileLoadBaseName$ + ".CI" For Binary As #1 ' get data
    screenGrab$ = Space$(LOF(1))
    Get #1, , screenGrab$
    Close #1
    screenGrab$ = _Inflate$(screenGrab$) ' fixed ?
    _MemPut M, M.OFFSET, screenGrab$
    LoadCustomImage& = imgHdl& ' finally assign the function
End Function
 
 

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.

SMcNeill · « **Reply #7 on:** January 25, 2022, 03:23:47 am »

You might want this sound file rather than the ZERO for the time:

O.wav

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!

bplus · « **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.

SMcNeill · « **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.)

bplus · « **Reply #10 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.

bplus · « **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).

bplus · « **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]

_Title "SayTime test" 'b+ 2022-01-25 mod to much much simpler way!!!
 
'for quick test
Screen 12
Do
    k$ = InKey$
    If Len(k$) Then SayTime: Print Time$: _KeyClear
    _Limit 30
Loop
 
Sub SayTime
    Dim As String t, message, m, s
    Dim As Long h
    t = Time$
    't = "23:03:05"  ' test single digit minutes and seconds
    h = Val(Left$(t, 2)) Mod 12
    m = Mid$(t, 4, 2)
    If Left$(m, 1) = "0" Then m = "O " + Right$(m, 1)
    s = Str$(Val(Mid$(t, 7, 2)))
    message = Str$(h) + "   " + m + "  and " + s + "  seconds"
    Shell _Hide "Powershell -Command " + Chr$(34) + "Add-Type -AssemblyName System.Speech; (New-Object System.Speech.Synthesis.SpeechSynthesizer).Speak('" + message + "');" + Chr$(34)
End Sub
 
 

Smack! Sooooo... simple!

SMcNeill · « **Reply #13 on:** January 25, 2022, 09:06:40 pm »

You could've, but it wouldn't have been cross-platform compatible. :P

bplus · « **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]

Option _Explicit
_Title "Does anyone really know what time it is?" ' b+ 2022-01-23
' 2022-01-24 now with Steve's audio time announcer! Press spacebar.
' And now with customImage load of a wonderful back side of a Time piece.
' Made a number of modifications to SayTime sub and Clock drawing
 
Type obj
    As Single X, Y, ScaleX, ScaleY, RotXY, DScaleX, DScaleY, DRotXY, ScaleLimit
End Type
 
Const SW = 1025, SH = 721, NClocks = 40
Screen _NewImage(SW, SH, 32)
_ScreenMove 150, 10
Randomize Timer
 
Dim Shared Clocks(1 To NClocks) As obj
Dim As Long c, b, midP, i, bl
Dim k$
 
'  check clock drawing
c = _NewImage(351, 351, 32) ' for the c=clock face conatiner
midP = Int((351 - 1) / 2)
'fcirc midP, midP, 165, &HFF114422
'clock midP, midP, 150
'Line (0, 0)-(351, 351), , B ' check centering
'Sleep
 
' create back of clock image
bl = LoadCustomImage("Clock Back") ' pretty cool image!!!
b = _NewImage(351, 351, 32)
_PutImage , bl, b
_ClearColor _RGB(0, 128, 0), b
' check our image
'Cls , &HFFFFFFFF
'_PutImage (0, 0), b, 0
'Line (0, 0)-(351, 351), &HFF000000, B
'Sleep
 
For i = 1 To NClocks
    newClock i, 1
Next
Do
    Cls
    _Title "Does anyone really know what time it is? Sure just press the spacebar."
    k$ = InKey$
    If k$ = " " Then SayTime
    _Dest c&
    Line (0, 0)-(351, 351), &HFF000000, BF ' blank out fro redraw
    For i = 165 To 0 Step -1
        fcirc midP, midP, i, _RGB32(220 - i)
    Next
    clock midP, midP, 150
    _Dest 0
    _ClearColor &HFF000000, c
    For i = 1 To NClocks
        If (Clocks(i).ScaleX > 0 And Clocks(i).ScaleY > 0) Or (Clocks(i).ScaleX < 0 And Clocks(i).ScaleY < 0) Then
            RotoZoom3 Clocks(i).X, Clocks(i).Y, c, Clocks(i).ScaleX, Clocks(i).ScaleY, Clocks(i).RotXY
        Else
            RotoZoom3 Clocks(i).X, Clocks(i).Y, b, Clocks(i).ScaleX, Clocks(i).ScaleY, Clocks(i).RotXY
        End If
        Clocks(i).Y = Clocks(i).Y + 1
        If Clocks(i).Y > _Height + 150 Then
            newClock i, 0
        Else
            'updates
            Clocks(i).ScaleX = Clocks(i).ScaleX + Clocks(i).DScaleX
            If Clocks(i).ScaleX < -Clocks(i).ScaleLimit Then Clocks(i).DScaleX = -Clocks(i).DScaleX: Clocks(i).ScaleX = -Clocks(i).ScaleLimit
            If Clocks(i).ScaleX > Clocks(i).ScaleLimit Then Clocks(i).DScaleX = -Clocks(i).DScaleX: Clocks(i).ScaleX = Clocks(i).ScaleLimit
            Clocks(i).ScaleY = Clocks(i).ScaleY + Clocks(i).DScaleY
            If Clocks(i).ScaleY < -Clocks(i).ScaleLimit Then Clocks(i).DScaleY = -Clocks(i).DScaleY: Clocks(i).ScaleY = -Clocks(i).ScaleLimit
            If Clocks(i).ScaleY > Clocks(i).ScaleLimit Then Clocks(i).DScaleY = -Clocks(i).DScaleY: Clocks(i).ScaleY = Clocks(i).ScaleLimit
            Clocks(i).RotXY = Clocks(i).RotXY + Clocks(i).DRotXY
        End If
    Next
    _Display
    _Limit 60
Loop Until _KeyDown(27)
 
Sub newClock (i, initTF)
    Clocks(i).X = Rnd * SW
    If initTF Then Clocks(i).Y = rrnd(-150, SH) Else Clocks(i).Y = -150
    Clocks(i).ScaleLimit = 1
    Clocks(i).ScaleX = rrnd(-Clocks(i).ScaleLimit, Clocks(i).ScaleLimit)
    Clocks(i).ScaleY = rrnd(-Clocks(i).ScaleLimit, Clocks(i).ScaleLimit)
    Clocks(i).DScaleX = rrnd(-.005 * Clocks(i).ScaleLimit, .005 * Clocks(i).ScaleLimit)
    Clocks(i).DScaleY = rrnd(-.005 * Clocks(i).ScaleLimit, .005 * Clocks(i).ScaleLimit)
    Clocks(i).RotXY = _Pi(2) * Rnd
    Clocks(i).DRotXY = rrnd(-.005 * _Pi, .005 * _Pi)
End Sub
 
Sub clock (x, y, r)
    Dim a, r1, hrs, clr~&
    For a = 0 To 359 Step 6
        clr~& = &HFF888888
        If a Mod 30 = 0 Then r1 = 1 / 30 * r Else r1 = 1 / 75 * r
        If a Mod 360 = 270 Then r1 = 1 / 15 * r: clr~& = &HFFFFFFFF
        Circle (x + r * Cos(_D2R(a)), y + r * Sin(_D2R(a))), r1
        fcirc x + r * Cos(_D2R(a)), y + r * Sin(_D2R(a)), r1 - 2, clr~& ' _RGB32(255, 255, 255)
    Next
    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)
    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)
    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)
    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)
    Circle (x, y), 1 / 10 * r, _RGB32(255, 255, 255)
    Paint (x + 1 / 75 * r, y + 1 / 75 * r), &HFF888888, _RGB32(255, 255, 255)
    Circle (x, y), 1 / 30 * r, _RGB32(0, 0, 0)
End Sub
 
Sub ftri0 (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    Dim D As Long, a&
    D = _Dest
    a& = _NewImage(1, 1, 32)
    _Dest a&
    PSet (0, 0), K
    _Dest D
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
    _FreeImage a& '<<< this is important!
End Sub
 
Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    Dim D As Long
    Static a&
    D = _Dest
    If a& = 0 Then a& = _NewImage(1, 1, 32)
    _Dest a&
    _DontBlend a& '  '<<<< new 2019-12-16 fix
    PSet (0, 0), K
    _Blend a& '<<<< new 2019-12-16 fix
    _Dest D
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
End Sub
 
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
    Dim px(3) As Single: Dim py(3) As Single
    Dim W&, H&, sinr!, cosr!, i&, x2&, y2&
    W& = _Width(Image&): H& = _Height(Image&)
    px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
    px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
    sinr! = Sin(-radianRotation): cosr! = Cos(-radianRotation)
    For i& = 0 To 3
        x2& = xScale * (px(i&) * cosr! + sinr! * py(i&)) + X: y2& = yScale * (py(i&) * cosr! - px(i&) * sinr!) + Y
        px(i&) = x2&: py(i&) = y2&
    Next
    _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))
    _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))
End Sub
 
Function rrnd (n1, n2) 'return real number (_single, double, _float depending on default / define setup)
    rrnd = (n2 - n1) * Rnd + n1
End Function
 
Sub fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
    Dim Radius As Long, RadiusError As Long
    Dim X As Long, Y As Long
    Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
    If Radius = 0 Then PSet (CX, CY), C: Exit Sub
    Line (CX - X, CY)-(CX + X, CY), C, BF
    While X > Y
        RadiusError = RadiusError + Y * 2 + 1
        If RadiusError >= 0 Then
            If X <> Y + 1 Then
                Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    Wend
End Sub
 
' Function returns Image Handle& (like _LoadFile)
Function LoadCustomImage& (fileLoadBaseName$) ' reverse the Save
    Dim As Long w, h
    Open fileLoadBaseName$ + ".CI_DIM" For Input As #1 ' get dimensions of custom image
    Input #1, w
    Input #1, h
    Close #1
    Dim imgHdl&: imgHdl& = _NewImage(w, h, 32) 'setup space and handle for it
    Dim M As _MEM: M = _MemImage(imgHdl&) ' put data into handle space reserved
    Dim screenGrab$: screenGrab$ = Space$(M.SIZE)
    Open fileLoadBaseName$ + ".CI" For Binary As #1 ' get data
    screenGrab$ = Space$(LOF(1))
    Get #1, , screenGrab$
    Close #1
    screenGrab$ = _Inflate$(screenGrab$) ' fixed ?
    _MemPut M, M.OFFSET, screenGrab$
    LoadCustomImage& = imgHdl& ' finally assign the function
End Function
 
Sub SayTime
    Dim As String t, message, m, s
    Dim As Long h
    t = Time$
    't = "23:03:05"
    h = Val(Left$(t, 2)) Mod 12
    m = Mid$(t, 4, 2)
    If Left$(m, 1) = "0" Then m = "O " + Right$(m, 1)
    s = Str$(Val(Mid$(t, 7, 2)))
    message = Str$(h) + "   " + m + "  and " + s + "  seconds"
    Shell _DontWait _Hide "Powershell -Command " + Chr$(34) + "Add-Type -AssemblyName System.Speech; (New-Object System.Speech.Synthesis.SpeechSynthesizer).Speak('" + message + "');" + Chr$(34)
End Sub
 
 

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! :)

News:

Author Topic: Passing Time (Read 6165 times)

bplus

Passing Time

SierraKen

Re: Passing Time

johnno56

Re: Passing Time

bplus

Re: Passing Time

SMcNeill

Re: Passing Time

bplus

Re: Passing Time

bplus

Re: Passing Time

SMcNeill

Re: Passing Time

bplus

Re: Passing Time

SMcNeill

Re: Passing Time

bplus

Re: Passing Time

bplus

Re: Passing Time

bplus

Re: Passing Time

SMcNeill

Re: Passing Time

bplus

Re: Passing Time