Re: the MATHEMATICAL ANALOG CLOCK

[bplus]

Many are posting all these clocks with numbers, here is a break from that, plus! my smoothest clock yet.

Code: QB64: [Select]

1. _TITLE "Smooth clock modern 7" 'B+ 2019-02-28 Series tries to get all hands moving across clockface smoothly
2. ' Modified arcRing to draw complete arc around but starting opacity max at one angle to
3. ' 360 degree CCW is completely transparent.
4. ' Now with a red theme for night mode
5.  
6. CONST sq = 700 '<<<<<<<<<<<<<< everything is scaled to this
7. CONST xy0 = sq / 2
8. CONST fr = .95 * xy0
9. CONST dr = .9 * xy0
10. CONST br = 0 * xy0
11. CONST hh = .5 * xy0
12. CONST mh = .7 * xy0
13. CONST sh = .8 * xy0
14. CONST smc = .007 * xy0
15.  
16. 'pi
17. CONST pi = 3.141592653589793
18. CONST pm2 = 2 * pi
19. CONST pm3d2 = 3 * pi / 2
20. CONST pd2 = pi / 2
21. CONST pm2d12 = 2 * pi / 12
22. CONST pm2d60 = 2 * pi / 60
23. CONST pd96 = pi / 96
24.  
25. 'color
26. CONST nsc = &HFF330000
27. CONST ncf = &HFFBB0000
28. CONST nhh = &HFF990000
29. CONST nmh = &HFF770000
30. CONST nsh = &HFF550000
31.  
32. CONST dsc = &HFF440044
33. CONST dcf = &HFF00AAAA
34. CONST dhh = &HFF00BB00
35. CONST dmh = &HFF990000
36. CONST dsh = &HFF000066
37.  
38. SCREEN _NEWIMAGE(sq, sq, 32)
39. _SCREENMOVE (1200 - sq) / 2, 10
40. DIM csc AS _UNSIGNED LONG, ccf AS _UNSIGNED LONG, chh AS _UNSIGNED LONG, cmh AS _UNSIGNED LONG, csh AS _UNSIGNED LONG
41. DO
42.     t# = TIMER(.001)
43.     't# = t# + 12 * 3600 'test opposite colors
44.     hour% = INT(t# / 3600)
45.     IF hour% >= 7 AND hour% <= 23 THEN 'day mode between 7 AM to 11 PM
46.         csc = dsc: ccf = dcf: chh = dhh: cmh = dmh: csh = dsh
47.     ELSE
48.         csc = nsc: ccf = ncf: chh = nhh: cmh = nmh: csh = nsh
49.     END IF
50.     IF hour% > 12 THEN showHr# = t# / 3600 - 12 ELSE showHr# = t# / 3600
51.     min# = t# / 60 - hour% * 60
52.     sec# = t# - hour% * 3600 - INT(min#) * 60
53.     fcirc xy0, xy0, fr, csc
54.     FOR i = 0 TO 59
55.         IF i = 45 THEN
56.             r = 7 * smc
57.         ELSEIF i MOD 5 = 0 THEN
58.             r = 4 * smc
59.         ELSE
60.             r = smc
61.         END IF
62.         fcirc xy0 + dr * COS(i * pm2d60), xy0 + dr * SIN(i * pm2d60), r, ccf
63.     NEXT
64.     arcRingRotateColor xy0, xy0, hh, br, showHr# * pm2d12 - pd2, chh
65.     arcRingRotateColor xy0, xy0, mh, hh, min# * pm2d60 - pd2, cmh
66.     arcRingRotateColor xy0, xy0, sh, mh, sec# * pm2d60 - pd2, csh
67.     _DISPLAY
68.     _LIMIT 30
69. LOOP UNTIL _KEYDOWN(27)
70.  
71. 'going around in a circle draw a disk max opacity at angle a and around to complete transparencey just on other side
72. SUB arcRingRotateColor (x0, y0, outerR, innerR, raStart, colr AS _UNSIGNED LONG)
73.     DIM x AS INTEGER, y AS INTEGER
74.     r = _RED32(colr): g = _GREEN32(colr): b = _BLUE32(colr)
75.  
76.     raS = raStart
77.     WHILE raS >= pm2
78.         raS = raS - pm2
79.     WEND
80.     WHILE raS < 0
81.         raS = raS + pm2
82.     WEND
83.     raE = raS - .001
84.     IF raE < 0 THEN raE = raE + pm2
85.     IF raE > raS THEN ck1 = -1
86.     FOR y = y0 - outerR TO y0 + outerR
87.         FOR x = x0 - outerR TO x0 + outerR
88.             dist = SQR((x - x0) * (x - x0) + (y - y0) * (y - y0))
89.             IF dist >= innerR AND dist <= outerR THEN 'within 2 radii
90.                 'angle of x, y to x0, y0
91.                 IF x - x0 <> 0 AND y - y0 <> 0 THEN
92.                     ra = _ATAN2(y - y0, x - x0)
93.                     IF ra < 0 THEN ra = ra + pm2
94.                 ELSEIF x - x0 = 0 THEN
95.                     IF y >= y0 THEN ra = pd2 ELSE ra = pm3d2
96.                 ELSEIF y - y0 = 0 THEN
97.                     IF x >= x0 THEN ra = 0 ELSE ra = pi
98.                 END IF
99.                 IF ck1 THEN 'raEnd > raStart
100.                     IF ra >= raS AND ra <= raE THEN
101.                         PSET (x, y), _RGBA32(r, g, b, ABS(ra - raS) / pm2 * 255)
102.                     END IF
103.                 ELSE 'raEnd < raStart, raEnd is falls before raStart clockwise so fill through 2 * PI
104.                     IF ra >= raS AND ra < pm2 THEN
105.                         PSET (x, y), _RGBA32(r, g, b, ABS(ra - raS) / pm2 * 255)
106.                     ELSE
107.                         IF ra >= 0 AND ra <= raE THEN
108.                             PSET (x, y), _RGBA32(r, g, b, ABS(pm2 + ra - raS) / pm2 * 255)
109.                         END IF
110.                     END IF
111.                 END IF
112.             END IF
113.         NEXT
114.     NEXT
115. END SUB
116.  
117. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
118.     DIM Radius AS INTEGER, RadiusError AS INTEGER
119.     DIM X AS INTEGER, Y AS INTEGER
120.  
121.     Radius = ABS(R)
122.     RadiusError = -Radius
123.     X = Radius
124.     Y = 0
125.  
126.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
127.  
128.     ' Draw the middle span here so we don't draw it twice in the main loop,
129.     ' which would be a problem with blending turned on.
130.     LINE (CX - X, CY)-(CX + X, CY), C, BF
131.  
132.     WHILE X > Y
133.         RadiusError = RadiusError + Y * 2 + 1
134.         IF RadiusError >= 0 THEN
135.             IF X <> Y + 1 THEN
136.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
137.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
138.             END IF
139.             X = X - 1
140.             RadiusError = RadiusError - X * 2
141.         END IF
142.         Y = Y + 1
143.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
144.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
145.     WEND
146. END SUB
147.  
148.  

[petoro]

A very original and beautiful sphere in such a short portion of code... Congratulations.