Simulation of a unique clock I did in hardware

[Richard Frost]

Code: QB64: [Select]

1. ' 10 digit clock, with wave
2.  
3. DEFINT A-Z
4. DIM segment(7, 4), number$(9)
5. GOSUB Init
6.  
7. DO: _LIMIT 20
8.     t1$ = TIME$: d1$ = DATE$: toggle = 1 - toggle
9.     IF toggle = 0 THEN ' military time & date
10.         t2$ = LEFT$(t1$, 2) + MID$(t1$, 4, 2) + RIGHT$(t1$, 2)
11.         t2$ = t2$ + " " + LEFT$(d1$, 2) + MID$(d1$, 4, 2)
12.     ELSE ' civilian time & day of week
13.         t2$ = LEFT$(t1$, 2): t2 = VAL(t2$)
14.         IF t2 > 12 THEN t2$ = RIGHT$("00" + LTRIM$(STR$(t2 - 12)), 2)
15.         t2$ = t2$ + MID$(t1$, 4, 2) + RIGHT$(t1$, 2)
16.         m = VAL(MID$(d1$, 1, 2)) ' month
17.         y = VAL(MID$(d1$, 7, 4)) ' year
18.         d = VAL(MID$(d1$, 4, 2)) ' day
19.         f& = y: f& = f& * 365 + 31 * (m - 1) + d
20.         IF m < 3 THEN
21.             f& = f& + (y - 1) \ 4 - (.75 * (y - 1) \ 100 + 1)
22.         ELSE
23.             f& = f& - INT(.4 * m + 2.3) + (y \ 4) - (.75 * (y - 1) \ 100 + 1)
24.         END IF
25.         dow = f& MOD 7 ' real
26.         dw$ = MID$("SUMOTUWETHFRSA", dow * 2 + 1, 2)
27.         t2$ = t2$ + " " + dw$
28.     END IF
29.     FOR i = 1 TO 11
30.         IF (i > 7) AND (toggle = 1) THEN ' show letters (day of week)
31.             RESTORE dowseg
32.             c$ = "Z": dow$ = " "
33.             WHILE dow$ <> dw$: READ dow$: WEND
34.             DO
35.                 READ let$
36.                 IF let$ = "x" THEN GOTO done
37.                 FOR j = 1 TO LEN(let$)
38.                     seg$ = MID$(let$, j, 1)
39.                     GOSUB plot
40.                 NEXT j
41.                 i = i + 1
42.             LOOP
43.         ELSE ' regular time or date
44.             c$ = MID$(t2$, i, 1)
45.             n = VAL(c$)
46.             FOR j = 1 TO LEN(number$(n))
47.                 seg$ = MID$(number$(n), j, 1)
48.                 GOSUB plot
49.             NEXT j
50.         END IF
51.     NEXT i
52.  
53.     done:
54.     GOSUB delay
55.     GOSUB wave
56. LOOP
57. ' ------------------------------------------------------------------------
58. Init:
59. SCREEN 12
60. FOR i = 1 TO 7
61.     READ g$
62.     FOR j = 1 TO 4
63.         READ segment(i, j)
64.     NEXT j
65. NEXT i
66. FOR i = 0 TO 9
67.     READ g$, number$(i)
68. NEXT i
69. s = 28
70. y0 = 220
71. xxx = -32
72. q = 3
73. GOSUB showdow ' optional
74. RETURN
75. ' ------------------------------------------------------------------------
76. plot:
77. segn = ASC(seg$) - ASC("a") + 1
78. x0 = i * s * 2 + xxx
79. IF i < 5 THEN c = 12 ELSE c = 10 ' red for hour & minute, rest green
80. 'c = 10
81. x1 = x0 + segment(segn, 1) * s: y1 = y0 + segment(segn, 2) * s
82. x2 = x0 + segment(segn, 3) * s: y2 = y0 + segment(segn, 4) * s
83. IF c$ <> " " THEN GOSUB doseg
84. RETURN
85. ' ------------------------------------------------------------------------
86. doseg:
87. x3 = (x2 + x1) / 2
88. y3 = (y2 + y1) / 2
89. FOR z = -4 TO 4 STEP 8
90.     x4 = x3 + z * (x1 = x2)
91.     y4 = y3 + z * (x1 <> x2)
92.     LINE (x1, y1)-(x4, y4), c
93.     LINE -(x2, y2), c
94. NEXT z
95. PAINT (x4 + 2, y4 + 2), c, c
96. RETURN
97. ' ------------------------------------------------------------------------
98. wave:
99. n = 0
100. DO
101.     LINE (0, 150)-(639, 230), 0, BF
102.     FOR j = 1 TO 11
103.         n = n + 1
104.         IF j < 5 THEN c = 12 ELSE c = 10
105.         'c = 10
106.         x0 = j * s * 2 + xxx
107.         z3 = n MOD 10 + 1
108.         t$ = MID$("aaggddggaaggddgg", z3, 1)
109.         segn = ASC(t$) - ASC("a") + 1
110.         FOR z = 0 TO q
111.             x1 = x0 + segment(segn, 1) * s + z: y1 = y0 + segment(segn, 2) * s + z
112.             x2 = x0 + segment(segn, 3) * s + z: y2 = y0 + segment(segn, 4) * s + z
113.             IF j <> 7 THEN GOSUB doseg
114.         NEXT z
115.     NEXT j
116.     wu! = TIMER + .004: WHILE TIMER < wu!: WEND
117.     LINE (0, 150)-(639, 230), 0, BF
118. LOOP UNTIL n > 280
119. RETURN
120. ' ------------------------------------------------------------------------
121. delay:
122. wu! = TIMER + 1
123. DO
124.     i$ = INKEY$
125. LOOP UNTIL LEN(i$) OR (TIMER > wu!)
126. IF i$ = CHR$(27) THEN END
127. RETURN
128. ' ------------------------------------------------------------------------
129. showdow:
130. RESTORE dowseg
131. FOR p = 1 TO 7
132.     READ g$
133.     IF p < 4 THEN xxx = -300 ELSE xxx = -20
134.     IF p < 4 THEN y0 = p * 86 + 50 ELSE y0 = (p - 3) * 86 + 50
135.     i = 7
136.     DO
137.         READ let$
138.         IF let$ = "x" THEN EXIT DO
139.         FOR j = 1 TO LEN(let$)
140.             seg$ = MID$(let$, j, 1)
141.             GOSUB plot
142.         NEXT j
143.         i = i + 1
144.     LOOP
145. NEXT p
146. FOR z = 0 TO 1
147.     GOSUB delay
148. NEXT
149. xxx = -32: y0 = 220: CLS
150. RETURN
151. ' ------------------------------------------------------------------------
152.  
153. DATA a,0,-2,1,-2,b,1,-2,1,-1,c,1,-1,1,0,d,0,0,1,0
154. DATA e,0,-1,0,0,f,0,-2,0,-1,g,0,-1,1,-1
155.  
156. DATA 0,abcdef,1,bc,2,abged,3,abgcd,4,fgbc
157. DATA 5,afgcd,6,afedcg,7,abc,8,abcdefg,9,abgfcd
158.  
159. dowseg:
160. DATA SU,afgcd,fedcb,x,MO,feb,fe,abcdef,x,TU,abc,a,fedcb,x
161. DATA WE,fec,fe,afged,x,TH,abc,a,febcg,x,FR,afeg,x,SA,afgcd,abcgfe,x
162.  

[STxAxTIC]

Dang, has [banned user] met this guy?