Mantel Clock with hourly chime song without extra files

[Richard Frost]

I had fun modifying this. 

1) Clock continues to tick while playing sound.
2) Motion less like a electric clock (jump vs slide).
3) Markers at 5,10,15, etc. highlighted.
4) Printing of III, IV, and V offset.
5) PAINT used intead of lengthy subroutine.
6) Used _D2R function.
7) All hands different lengths.
8) Shorter code.

The colors SHOULD be _UNSIGNED LONG, but for short code like this that isn't doing comparisons, it doesn't matter.

If you wonder why I do VAL(string$) instead of just plunk in a number, it's because I like things to line up.

Code: QB64: [Select]

1. _TITLE "Mantel Clock - Press Space Bar to play hour chimes at anytime."
2. DIM black AS LONG, brown AS LONG, green AS LONG, hcol AS LONG, mcol AS LONG, scol AS LONG, c AS LONG
3.  
4. SCREEN _NEWIMAGE(800, 600, 32)
5. DO: LOOP UNTIL _SCREENEXISTS '                          good practice
6. _DELAY .3 '                                             because the move may not work without it
7. _SCREENMOVE _MIDDLE '                                   center screen in desktop
8.  
9. cx = _WIDTH \ 2 '                                       clock center x
10. cy = _HEIGHT \ 2 '                                      clock center y
11. black = _RGB32(0)
12. brown = _RGB32(183, 139, 100) '                         clock face and trim
13. green = _RGB32(0, 55, 0) '                              clock bulk
14. hcol = black '                                          hour hand color
15. mcol = black '                                          minute hand color
16. scol = _RGB32(255) '                                    second hand color
17. '     D#     B      C#     F#            F#     C#     D#     B             D#     C3     B      F#            F#     C#     D#     B
18. s$ = "311.13 246.94 277.18 185     0     185    277.18 311.13 246.94 0      311.13 277.18 246.94 185    0      185    277.18 311.13 246.94 0"
19.  
20. DO: _LIMIT 10
21.     a = _KEYHIT
22.     IF a = 27 THEN SYSTEM '                             Esc ends program
23.     GOSUB clock
24.     IF NOT (((m = 0) AND (s = 0)) OR (a = 32)) THEN _CONTINUE
25.  
26.     FOR notes = 0 TO 19
27.         note = VAL(MID$(s$, notes * 7 + 1, 6))
28.         ttt = 0
29.         DO
30.             DO WHILE _SNDRAWLEN < 0.5 '                 you may wish to adjust this
31.                 sample = SIN(ttt * note * ATN(1) * 8) ' 340Hz sine wave (ttt * 440 * 2p)
32.                 sample = sample * EXP(-ttt * 3) '       fade out eliminates clicks after sound
33.                 _SNDRAW sample
34.                 ttt = ttt + 1 / _SNDRATE '              sound card sample frequency determines time
35.             LOOP
36.         LOOP WHILE ttt < 1 '                            play for 1 second
37.         DO: LOOP UNTIL _SNDRAWLEN = 0 '                 finish any left over queued sound!
38.         GOSUB clock
39.     NEXT notes
40.  
41.     IF h = 0 THEN h = 12
42.     FOR chimes = 1 TO h
43.         ttt = 0
44.         DO
45.             DO WHILE _SNDRAWLEN < 0.1 '                 you may wish to adjust this
46.                 sample = SIN(ttt * 240 * ATN(1) * 8) '  340Hz sine wave (ttt * 440 * 2p)
47.                 sample = sample * EXP(-ttt * 3) '       fade out eliminates clicks after sound
48.                 _SNDRAW sample
49.                 ttt = ttt + 1 / _SNDRATE '              sound card sample frequency determines time
50.             LOOP
51.             GOSUB clock
52.         LOOP WHILE ttt < 2 '                            play for 2 seconds
53.         DO: LOOP UNTIL _SNDRAWLEN = 0 '                 finish any left over queued sound!
54.     NEXT chimes
55. LOOP
56.  
57. clock:
58. CLS
59. CIRCLE (cx, cy), cy, green
60. PAINT (cx, cy), green, green
61. LINE (100, cy)-(700, 600), green, BF
62. CIRCLE (cx, cy), 200, _RGB32(1)
63. PAINT (cx, cy), brown, _RGB32(1)
64. FOR lines = .2 TO 10 STEP .2
65.     CIRCLE (cx, cy), 250 + lines, brown, 2 * _PI, _PI
66. NEXT lines
67. LINE (140, cy)-(150, 760), brown, BF
68. LINE (650, cy)-(660, 760), brown, BF
69. LINE (150, _HEIGHT - 10)-(650, _HEIGHT), brown, BF
70. COLOR black, brown
71. FOR sc = 1 TO 60
72.     ss = (60 - sc) * 6 + 180
73.     x2 = cx + 140 * SIN(_D2R(ss))
74.     y2 = cy + 140 * COS(_D2R(ss))
75.     CIRCLE (x2, y2), 3, _RGB32(230)
76.     IF (sc MOD 5) = 0 THEN
77.         PAINT (x2, y2), black, _RGB32(230)
78.         z$ = MID$("I   II  III IV  V   VI  VII VIIIIX  X   XI  XII  ", (sc \ 5 - 1) * 4 + 1, 4)
79.         x3 = (cx - VAL("10")) + 160 * SIN(_D2R(ss))
80.         y3 = (cy - VAL("05")) + 160 * COS(_D2R(ss))
81.         x3 = x3 - (sc = 30) * 3 + (sc = 40) * 10 - (sc = 50) * 8
82.         _PRINTSTRING (x3, y3), RTRIM$(z$)
83.     END IF
84. NEXT sc
85. COLOR , black
86.  
87. s = VAL(MID$(TIME$, 7, 2))
88. m = VAL(MID$(TIME$, 4, 2))
89. h = VAL(MID$(TIME$, 1, 2))
90. h = h + (h > 12) * 12 + m / 60
91. FOR hand = 1 TO 3
92.     IF hand = 1 THEN t = h * VAL("30"): c = hcol: handlen = 80
93.     IF hand = 2 THEN t = m * VAL("06"): c = mcol: handlen = 100
94.     IF hand = 3 THEN t = s * VAL("06"): c = scol: handlen = 120
95.     x = cx + handlen * COS(_D2R(t - 90))
96.     y = cy + handlen * SIN(_D2R(t - 90))
97.     FOR b = -5 TO 5 STEP .1
98.         LINE (cx + b, cy)-(x, y), c
99.         LINE (cx, cy + b)-(x, y), c
100.     NEXT b
101. NEXT hand
102.  
103. CIRCLE (cx, cy), 8, _RGB32(1)
104. PAINT (cx, cy), black, _RGB32(1)
105. _DISPLAY
106. RETURN
107.