Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: Richard Frost on February 01, 2019, 11:42:30 am

Title: Simulation of a unique clock I did in hardware
Post by: Richard Frost on February 01, 2019, 11:42:30 am
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.  
  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
  57. ' ------------------------------------------------------------------------
  58. Init:
  60. FOR i = 1 TO 7
  61.     READ g$
  62.     FOR j = 1 TO 4
  63.         READ segment(i, j)
  64.     NEXT j
  66. FOR i = 0 TO 9
  67.     READ g$, number$(i)
  69. s = 28
  70. y0 = 220
  71. xxx = -32
  72. q = 3
  73. GOSUB showdow ' optional
  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
  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
  95. PAINT (x4 + 2, y4 + 2), c, c
  97. ' ------------------------------------------------------------------------
  98. wave:
  99. n = 0
  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
  120. ' ------------------------------------------------------------------------
  121. delay:
  122. wu! = TIMER + 1
  124.     i$ = INKEY$
  125. LOOP UNTIL LEN(i$) OR (TIMER > wu!)
  126. IF i$ = CHR$(27) THEN END
  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
  146. FOR z = 0 TO 1
  147.     GOSUB delay
  149. xxx = -32: y0 = 220: CLS
  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.  
Title: Re: Simulation of a unique clock I did in hardware
Post by: STxAxTIC on February 01, 2019, 01:35:31 pm
Dang, has [banned user] met this guy?
Text Only | Text with Attachments