Analog clocks code

[bplus]

But will the lines fit?

Code: QB64: [Select]

1. _TITLE "49+ Analog Clocks in 38 Lines of Code for QB64 B+ 2018-10-02"
2. SCREEN _NEWIMAGE(720, 720, 32)
3. _SCREENMOVE 300, 10
4. WHILE 1
5.     CLS
6.     FOR i = 0 TO 11
7.         clock 360 + 258 * COS(_PI(2 * i / 12)), 360 + 258 * SIN(_PI(2 * i / 12)), 65
8.         clock 360 + 149 * COS(_PI(2 * i / 12)), 360 + 149 * SIN(_PI(2 * i / 12)), 37
9.         clock 360 + 86 * COS(_PI(2 * i / 12)), 360 + 86 * SIN(_PI(2 * i / 12)), 20
10.         clock 360 + 50 * COS(_PI(2 * i / 12)), 360 + 50 * SIN(_PI(2 * i / 12)), 12
11.     NEXT
12.     clock 360, 360, 340
13.     clock 700, 700, 865
14.     _DISPLAY
15.     _LIMIT 2
16. WEND
17. SUB clock (x, y, r)
18.     FOR a = 0 TO 359 STEP 6
19.         IF a MOD 30 = 0 THEN r1 = 1 / 30 * r ELSE r1 = 1 / 75 * r
20.         CIRCLE (x + r * COS(_D2R(a)), y + r * SIN(_D2R(a))), r1
21.         PAINT (x + r * COS(_D2R(a)), y + r * SIN(_D2R(a))), _RGB32(100, 100, 100), _RGB32(255, 255, 255)
22.     NEXT
23.     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)
24.     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(255, 0, 0)
25.     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(0, 0, 255)
26.     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)
27.     CIRCLE (x, y), 1 / 10 * r, _RGB32(255, 255, 255)
28.     PAINT (x + 1 / 75 * r, y + 1 / 75 * r), _RGB32(100, 100, 100), _RGB32(255, 255, 255)
29.     CIRCLE (x, y), 1 / 30 * r, _RGB32(0, 0, 0)
30. END SUB
31. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
32.     a& = _NEWIMAGE(1, 1, 32)
33.     _DEST a&
34.     PSET (0, 0), K
35.     _DEST 0
36.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
37.     _FREEIMAGE a& '<<< this is important!
38. END SUB
39.  

EDIT: Some paints were part off / part on screen.

[bplus]

Hated triangle arms plus wanted to change colors of face and hands but mainly wanted transparent clocks.

Here is all that:

Code: QB64: [Select]

1. _TITLE "Clock code for QB64 B+ 2018-10-02"
2. RANDOMIZE TIMER
3. SCREEN _NEWIMAGE(720, 720, 32)
4. _SCREENMOVE 300, 10
5.  
6. CONST PI = 3.141492653589793
7. CONST PI2 = 1.570796326794897
8.  
9. 'check scaling
10. _TITLE "Scale Test:  Press m for more, l for less clock size, esc for next test..."
11. sz = 4
12. WHILE _KEYDOWN(27) = 0
13.     K$ = INKEY$
14.     IF K$ = "m" AND INT(sz * 1.25) < 360 THEN sz = INT(sz * 1.25)
15.     IF K$ = "l" AND INT(sz / 1.25) > 3 THEN sz = INT(sz / 1.25)
16.     CLS
17.     clock 360, 360, sz, _RGB32(0, 0, 80), _RGB32(200, 155, 255), _RGB32(60, 30, 45)
18.     PRINT sz
19.     _DISPLAY
20.     _LIMIT 30
21. WEND
22. _KEYCLEAR
23. CLS
24. _DELAY 2
25.  
26. 'transparency tests, first some background picture
27. bgrd& = _NEWIMAGE(720, 720, 32) 'draw background
28. _DEST bgrd&
29. FOR I = 1 TO 100 'draw background
30.     LINE (RND * 720, RND * 720)-STEP(RND * 90, RND * 90), _RGB32(RND * 255, RND * 255, RND * 255), BF
31. NEXT
32. LINE (350, 350)-STEP(100, 50), _RGB32(255, 255, 0), BF
33. _DEST 0
34.  
35. _TITLE "Transparency Test: press m for more opaqueness press l for less opaqueness, esc for next test..."
36. sz = 200
37. _KEYCLEAR
38. t = 15
39. WHILE _KEYDOWN(27) = 0
40.     CLS
41.     K$ = INKEY$
42.     IF K$ = "m" AND (t + 10 <= 255) THEN t = t + 10
43.     IF K$ = "l" AND (t - 10 >= 15) THEN t = t - 10
44.     _PUTIMAGE , bgrd&
45.     clock 360, 360, sz, _RGBA32(60, 30, 10, t), _RGBA32(128, 196, 255, t), _RGBA32(60, 30, 10, t)
46.     COLOR _RGB32(255, 255, 255)
47.     PRINT t
48.     _DISPLAY
49.     _LIMIT 30
50. WEND
51.  
52. 'random tests
53. DIM SHARED nClocks
54. nClocks = 15
55. DIM SHARED cx(nClocks), cy(nClocks), cr(nClocks), ccb(nClocks) AS _UNSIGNED LONG, ccf(nClocks) AS _UNSIGNED LONG, cch(nClocks) AS _UNSIGNED LONG
56.  
57. ON TIMER(4) newClocks
58. TIMER ON
59. newClocks
60. _TITLE "Random clocks test,  press q to quit..."
61. WHILE K$ <> "q"
62.     CLS
63.     K$ = INKEY$
64.     _PUTIMAGE , bgrd&
65.     FOR I = 1 TO 15
66.         clock cx(I), cy(I), cr(I), ccf(I), ccb(I), cch(I)
67.     NEXT
68.     _DISPLAY
69.     _LIMIT 30
70. WEND
71. TIMER OFF
72. _FREEIMAGE bgrd&
73. END
74.  
75. SUB newClocks
76.     FOR i = 1 TO nClocks
77.         cr(i) = RND * 200 + 10
78.         cx(i) = RND * 720 - .5 * cr(i)
79.         cy(i) = RND * 720 - .5 * cr(i)
80.         t = RND * 255
81.         ccb(i) = _RGBA32(RND * 255, RND * 255, RND * 255, t)
82.         ccf(i) = _RGBA32(RND * 255, RND * 255, RND * 255, t)
83.         cch(i) = _RGBA32(RND * 255, RND * 255, RND * 255, t)
84.     NEXT
85. END SUB
86.  
87. SUB clock (x, y, rr, fc AS _UNSIGNED LONG, bc AS _UNSIGNED LONG, hc AS _UNSIGNED LONG)
88.     clockFace x, y, rr, fc, bc
89.     r = .9 * rr
90.     hrs = VAL(LEFT$(TIME$, 2)) + (VAL(MID$(TIME$, 4, 2)) / 60)
91.     IF hrs >= 12 THEN hrs = hrs - 12
92.     hrs = hrs * _PI(1 / 6) - PI2
93.     ms = VAL(MID$(TIME$, 4, 2)) * PI / 30 - PI2
94.     ss = VAL(RIGHT$(TIME$, 2)) * PI / 30 - PI2
95.     x3 = x + r * COS(ms): y3 = y + r * SIN(ms)
96.     x4 = x + r / 10 * COS(ms - PI): y4 = y + r / 10 * SIN(ms - PI)
97.     thic x3, y3, x4, y4, r / 15, hc
98.     x3 = x + 3 / 4 * r * COS(hrs): y3 = y + 3 / 4 * r * SIN(hrs)
99.     x4 = x + r / 10 * COS(hrs - PI): y4 = y + r / 10 * SIN(hrs - PI)
100.     thic x3, y3, x4, y4, r / 15, hc
101.     LINE (x, y)-(x + r * COS(ss), y + r * SIN(ss)), hc
102.     fcirc x, y, r / 15, hc
103.     CIRCLE (x, y), r / 30, bc
104. END SUB
105.  
106. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
107.     a& = _NEWIMAGE(1, 1, 32)
108.     _DEST a&
109.     PSET (0, 0), K
110.     _DEST 0
111.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
112.     _FREEIMAGE a&
113. END SUB
114.  
115. SUB clockFace (x, y, r, fc AS _UNSIGNED LONG, bc AS _UNSIGNED LONG)
116.     b& = _NEWIMAGE(2 * r + 1, 2 * r + 1, 32)
117.     _DEST b&
118.     fcirc r, r, r, bc
119.     FOR a = 0 TO 359 STEP 6
120.         IF a MOD 30 = 0 THEN
121.             r1 = 1 / 30 * r
122.         ELSE
123.             IF r / 60 > 1 THEN r1 = r / 60 ELSE r1 = 0
124.         END IF
125.         IF r1 THEN fcirc r + .9 * r * COS(_D2R(a)), r + .9 * r * SIN(_D2R(a)), r1, fc
126.     NEXT
127.     _PUTIMAGE (x - r, y - r)-(x + r, y + r), b&, 0
128.     _DEST 0
129.     _FREEIMAGE b&
130. END SUB
131.  
132. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
133. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG, K AS _UNSIGNED LONG)
134.     DIM subRadius AS LONG, RadiusError AS LONG
135.     DIM X AS LONG, Y AS LONG
136.  
137.     subRadius = ABS(R)
138.     RadiusError = -subRadius
139.     X = subRadius
140.     Y = 0
141.  
142.     IF subRadius = 0 THEN PSET (CX, CY), K: EXIT SUB
143.  
144.     ' Draw the middle span here so we don't draw it twice in the main loop,
145.     ' which would be a problem with blending turned on.
146.     LINE (CX - X, CY)-(CX + X, CY), K, BF
147.  
148.     WHILE X > Y
149.         RadiusError = RadiusError + Y * 2 + 1
150.         IF RadiusError >= 0 THEN
151.             IF X <> Y + 1 THEN
152.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), K, BF
153.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), K, BF
154.             END IF
155.             X = X - 1
156.             RadiusError = RadiusError - X * 2
157.         END IF
158.         Y = Y + 1
159.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), K, BF
160.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), K, BF
161.     WEND
162. END SUB
163.  
164. SUB thic (x1, y1, x2, y2, thick, K AS _UNSIGNED LONG)
165.     t2 = thick / 2
166.     IF t2 < 1 THEN t2 = 1
167.     a = _ATAN2(y2 - y1, x2 - x1)
168.     x3 = x1 + t2 * COS(a + PI2)
169.     y3 = y1 + t2 * SIN(a + PI2)
170.     x4 = x1 + t2 * COS(a - PI2)
171.     y4 = y1 + t2 * SIN(a - PI2)
172.     x5 = x2 + t2 * COS(a + PI2)
173.     y5 = y2 + t2 * SIN(a + PI2)
174.     x6 = x2 + t2 * COS(a - PI2)
175.     y6 = y2 + t2 * SIN(a - PI2)
176.     ftri x6, y6, x4, y4, x3, y3, K
177.     ftri x3, y3, x5, y5, x6, y6, K
178. END SUB
179.  
180.  

[bplus]

The above code was cleaned up and optimized (same day as original post) also used a ON TIMER for first time for testing Random clocks.