Author Topic: Simulation of a unique clock I did in hardware  (Read 3562 times)

0 Members and 1 Guest are viewing this topic.

Offline Richard Frost

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

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
Re: Simulation of a unique clock I did in hardware
« Reply #1 on: February 01, 2019, 01:35:31 pm »
Dang, has [banned user] met this guy?
You're not done when it works, you're done when it's right.