Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: Richard Frost on February 29, 2020, 11:24:03 am

Title: Clock variation one billion and something....
Post by: Richard Frost on February 29, 2020, 11:24:03 am
This type of watch had a unique hand style.  No doubt someone can make it prettier. 
Comment out the  $EXEICON to skip downloading the attachment.

Code: QB64: [Select]
  1. _TITLE "Wittnauer Watch"
  2. $EXEICON:'c1.ico'
  3.  
  4. DEFINT A-Z
  5. q = 31000: z = 10
  6. DIM g1(q), g2(q), hx(z), hy(z), r!(z), p(13, 4)
  7. FOR n = 0 TO 10
  8.     READ g$
  9.     FOR i = 0 TO 4
  10.         READ z
  11.         p(n, i) = z * 4096
  12.     NEXT i
  14.  
  15. SCREEN 12 '                                      640*480*16
  18. FOR i = 5 TO 15 '                                make shades of red
  19.     p& = i * 4 + 3
  20.     PALETTE i, p&
  22. p& = CDBL(30) * 256 '                            green, less bright than default
  23. PALETTE 2, p&
  24. q = 32 '                                         background
  25. p& = 65536 * CDBL(q) + 256 * CDBL(q) + q
  26. PALETTE 4, p&
  27. CLS , 4
  28. pi! = 4 * ATN(1): lm = -1
  29. hc = 10: mc = 2: sc = 1 '                        colors hour, minute, second
  30. xc = 320: yc = 220 '                             center
  31. FOR a = 0 TO 360 STEP 6 '                        clock face
  32.     x2 = xc + 192 * SIN(_D2R(a))
  33.     y2 = yc - 192 * COS(_D2R(a))
  34.     IF (a MOD 30) = 0 THEN '                     hour
  35.         FOR d = 0 TO 10
  36.             CIRCLE (x2, y2), d, 15 - d
  37.             CIRCLE (x2 + 1, y2), d, 15 - d
  38.         NEXT d
  39.     ELSE '                                       minute or second
  40.         CIRCLE (x2, y2), 1, 1
  41.         PSET (x2, y2), 1
  42.     END IF
  44. s = 175
  45. nx1 = xc - s: nx2 = xc + s
  46. ny1 = yc - s: ny2 = yc + s
  47. GET (nx1, ny1)-(nx2, ny2), g1(0)
  49.     t$ = TIME$
  50.     GOSUB timetext
  51.     IF lm > -1 THEN PUT (nx1, ny1), g2(0), PSET
  52.     m = VAL(MID$(t$, 4, 2))
  53.     IF m <> lm THEN
  54.         PUT (nx1, ny1), g1(0), PSET
  55.         h = VAL(MID$(t$, 1, 2)): h = h + (h > 12) * 12
  56.         a = (h + m / 60) * 30 - 90: r! = _D2R(a): GOSUB hour
  57.         a = m * 6 - 90: r! = _D2R(a): GOSUB minute
  58.         lm = m: GET (nx1, ny1)-(nx2, ny2), g2(0)
  59.     END IF
  60.     a = VAL(MID$(t$, 7, 2)) * 6 - 90: r! = _D2R(a): GOSUB second
  61.     DO: _LIMIT 10
  62.         i$ = INKEY$
  63.         IF i$ = CHR$(27) THEN SYSTEM
  64.     LOOP UNTIL t$ <> TIME$
  66. second:
  67. tx = xc + 170 * COS(r!)
  68. ty = yc + 170 * SIN(r!)
  69. FOR ta2! = a - 4 TO a + 4 STEP .25
  70.     r! = _D2R(ta2! + 180)
  71.     x = xc + 45 * COS(r!)
  72.     y = yc + 45 * SIN(r!)
  73.     LINE (tx, ty)-(x, y), sc
  74.     LINE (tx, ty)-(x + 1, y), sc
  75. NEXT ta2!
  76. r! = r! + pi!
  77. tx = xc - 70 * COS(r!)
  78. ty = yc - 70 * SIN(r!)
  79. FOR ta2! = a + 5 TO a + 16 STEP .25
  80.     x = xc - 40 * COS(_D2R(ta2!))
  81.     y = yc - 40 * SIN(_D2R(ta2!))
  82.     LINE (tx, ty)-(x, y), sc
  83. NEXT ta2!
  85. minute:
  86. FOR ta2! = a - 4 TO a STEP .25
  87.     x = xc + 130 * COS(_D2R(ta2!))
  88.     y = yc + 130 * SIN(_D2R(ta2!))
  89.     LINE (xc, yc)-(x, y), mc
  90.     LINE (xc + 1, yc)-(x, y), mc
  91.     LINE (xc, yc)-(x + 1, y), mc
  92. NEXT ta2!
  93. tx = xc + 160 * COS(r!)
  94. ty = yc + 160 * SIN(r!)
  95. FOR ta2! = a TO a + 6 STEP .25
  96.     x = xc + 120 * COS(_D2R(ta2!))
  97.     y = yc + 120 * SIN(_D2R(ta2!))
  98.     LINE (tx, ty)-(x, y), mc
  99.     LINE (tx + 1, ty)-(x, y), mc
  100.     LINE (tx, ty)-(x + 1, y), mc
  101. NEXT ta2!
  102. FOR x = 1 TO 8
  103.     IF x > 6 THEN tc = mc ELSE tc = 0
  104.     CIRCLE (xc, yc), x, tc
  105.     CIRCLE (xc + 1, yc), x, tc
  106.     CIRCLE (xc, yc + 1), x, tc
  109. hour:
  110. FOR c = 0 TO 1 '                                 near and far of diamond, 0 and 2
  111.     i = c * 2
  112.     r!(i) = _D2R(a)
  113.     hx(i) = xc + (100 + (c - .5) * 70) * COS(r!(i))
  114.     hy(i) = yc + (100 + (c - .5) * 70) * SIN(r!(i))
  116. FOR c = 0 TO 1 ' edges of diamond, 1 and 3
  117.     i = 1 + c * 2
  118.     r!(i) = _D2R(a + (c - .5) * 10)
  119.     hx(i) = xc + 100 * COS(r!(i))
  120.     hy(i) = yc + 100 * SIN(r!(i))
  122. xt = xc + 50 * COS(r!(0)) '                      hour circle center
  123. yt = yc + 50 * SIN(r!(0))
  124. FOR c = 0 TO 1 '                                 start & end angle
  125.     ta = (360 - a) MOD 360
  126.     r!(c) = _D2R(ta + (c - .5) * 22)
  127.     IF r!(c) < 0 THEN r!(c) = r!(c) + 2 * pi!
  129. FOR c = -1 TO 1 '                                draw circles
  130.     CIRCLE (xt, yt), 50 + c, hc, r!(1), r!(0)
  131.     CIRCLE (xt + 1, yt), 50 + c, hc, r!(1), r!(0)
  132.     CIRCLE (xt, yt + 1), 50 + c, hc, r!(1), r!(0)
  134. FOR i = 0 TO 2 STEP 2 '                          near and far diamond
  135.     FOR j = 1 TO 3 STEP 2 '                      diamond edges
  136.         FOR k = -1 TO 1 '                        make thicker
  137.             LINE (hx(i), hy(i))-(hx(j) + k, hy(j) + k), hc
  138.         NEXT k
  139.     NEXT j
  142. timetext: '                                      tiny font digital clock
  143. xt = 304: yt = 440: c = 15
  144. d$ = TIME$
  145. LINE (xt - 3, yt - 3)-(xt + 36, yt + 7), 0, BF
  146. FOR z = 1 TO LEN(d$)
  147.     z$ = MID$(d$, z, 1)
  148.     IF z$ = ":" THEN d = 10 ELSE d = VAL(z$)
  149.     FOR i = 0 TO 4
  150.         xt2 = xt + z * 4 - 4
  151.         LINE (xt2, yt + i)-(xt2 + 4, yt + i), c, , p(d, i)
  152.     NEXT i
  155.  
  156. DATA 0,7,5,5,5,7
  157. DATA 1,2,6,2,2,7
  158. DATA 2,7,1,7,4,7
  159. DATA 3,7,1,7,1,7
  160. DATA 4,5,5,7,1,1
  161. DATA 5,7,4,7,1,7
  162. DATA 6,7,4,7,5,7
  163. DATA 7,7,1,1,1,1
  164. DATA 8,7,5,7,5,7
  165. DATA 9,7,5,7,1,7
  166. DATA ":",0,2,0,2,0
  167.  
  168.  
Title: Re: Clock variation one billion and something....
Post by: bplus on February 29, 2020, 11:48:22 am
Quote
No doubt someone can make it prettier.

That's quite an hour hand and the other hands are cool too. Have we seen this before or deja vu?

BTW why are they called "hands" and not "arms"? Have I asked this before? ;-))

I have been curiously interested in a certain type of coloring since _vince did bplus avatar and Diagonal Eggs code from BASIC-256, so I accept your challenge :)
Title: Re: Clock variation one billion and something....
Post by: Qwerkey on February 29, 2020, 12:55:31 pm
Richard, you must be Chronos, our God of Time.
Title: Re: Clock variation one billion and something....
Post by: Richard Frost on February 29, 2020, 12:57:23 pm
Oh crap, did I post this before?  Sorry.

I did do a search for it first, but not thoroughly enough.

Title: Re: Clock variation one billion and something....
Post by: bplus on February 29, 2020, 01:01:18 pm
Quote from: Richard Frost on February 29, 2020, 12:57:23 pm
Oh crap, did I post this before?  Sorry.

I did do a search for it first, but not thoroughly enough.



Possibly under [banned user] clock thing? possibly in BIN file from IRC chat? possibly bplus mind is outside of time?

Update: another bunch found with Ken's clock, I made similar dial.
Title: Re: Clock variation one billion and something....
Post by: Richard Frost on February 29, 2020, 02:00:31 pm
Digital with color, fade, and LCD option.  I'm not too good at finding icons online,
and pick the first one that looks half decent.   Maybe the other way, loading a
regular image and using _ICON is better?  Sure get a better selection of images
when not a ready made ICO.

Code: QB64: [Select]
  1. _TITLE "Digital Clock"
  2. $EXEICON:'c8.ico'
  3.  
  4. DEFINT A-Z
  5. qs = 2200: q = qs * 10
  6. DIM gb(q), segxy(7, 4), seglit$(9), nlast(10)
  7. GOSUB init
  9.     t$ = TIME$
  10.     t$ = LEFT$(t$, 2) + MID$(t$, 4, 2) + RIGHT$(t$, 2)
  11.     x = 60
  12.     FOR i = 1 TO 6
  13.         c$ = MID$(t$, i, 1)
  14.         nu = VAL(c$)
  15.         IF nu <> nlast(i) THEN
  16.             IF invert = 0 THEN
  17.                 PUT (x, 150), gb(nu * qs), PSET
  18.             ELSE
  19.                 PUT (x, 150), gb(nu * qs), PRESET
  20.             END IF
  21.             nlast(i) = nu
  22.         END IF
  23.         x = x + 74 - (i = 2) * 40 - (i = 4) * 40
  24.     NEXT i
  25.     i$ = INKEY$
  26.     IF (i$ > "") AND (INSTR("lwrgbpy", i$) > 0) THEN GOSUB mcolor
  27.     t$ = " fs" + CHR$(13)
  28.     IF (i$ > "") AND (INSTR(t$, i$) > 0) THEN fade = 1 - fade: GOSUB init2
  29.     IF i$ = "i" THEN invert = 1 - invert: GOSUB init2
  30.     IF i$ = "z" THEN doabox = 1 - doabox: GOSUB init2
  31.     IF doabox THEN
  32.         LINE (45, 130)-(585, 310), 15, B
  33.     END IF
  34. LOOP UNTIL i$ = CHR$(27)
  36.  
  37. plot:
  38. IF fade THEN q = 11 ELSE q = 7
  39. FOR j = 1 TO LEN(seglit$(n))
  40.     sn = ASC(MID$(seglit$(n), j, 1)) - 96
  41.     x1 = 8 + segxy(sn, 1) * 40
  42.     x2 = 8 + segxy(sn, 3) * 40
  43.     y1 = 128 + segxy(sn, 2) * 60
  44.     y2 = 128 + segxy(sn, 4) * 60
  45.     IF y1 = y2 THEN ' horizontal
  46.         x1 = x1 + 1: x2 = x2 - 1
  47.         FOR k = -q TO q
  48.             IF fade THEN c = 15 - ABS(k) ELSE c = 15
  49.             LINE (x1 + ABS(k), y1 + k)-(x2 - ABS(k), y2 + k), c
  50.         NEXT k
  51.     ELSE ' vertical
  52.         y1 = y1 + 1: y2 = y2 - 1
  53.         FOR k = -q TO q
  54.             IF fade THEN c = 15 - ABS(k) ELSE c = 15
  55.             LINE (x1 + k, y1 + ABS(k))-(x2 + k, y2 - ABS(k)), c
  56.         NEXT k
  57.     END IF
  60.  
  61. init:
  63.  
  64. FOR i = 1 TO 7
  65.     READ g$
  66.     FOR j = 1 TO 4
  67.         READ segxy(i, j)
  68.     NEXT j
  70. FOR i = 0 TO 9
  71.     READ g$, seglit$(i)
  73. fade = 1 '                                                      segment effect on
  74. sc$ = "b" '                                                     blue for initial state
  75.  
  76. init2:
  77. FOR i = 1 TO 15
  78.     PALETTE i, 0
  80. FOR n = 0 TO 9
  81.     GOSUB plot
  82.     i = n * qs
  83.     GET (0, 0)-(56, 136), gb(i)
  84.     CLS
  85.     nlast(n) = -1
  87. i$ = sc$
  88.  
  89. t$ = "red green blue yellow purple white lcd fade invert"
  90. tc = 40 - LEN(t$) \ 2
  91. LOCATE 29, tc: PRINT t$;
  92.  
  93. mcolor:
  94. r = 0: ri = 0: g = 0: gi = 0: B = 0: bi = 0
  95. IF INSTR("rwpy", i$) THEN ri = 4 '                              red white purple yellow
  96. IF INSTR("gwy", i$) THEN gi = 4 '                               green white yellow
  97. IF INSTR("bwp", i$) THEN bi = 4 '                               blue white purple
  98. FOR i = 0 TO 15
  99.     p& = CDBL(B) * 65536 + CDBL(g) * 256 + r
  100.     PALETTE i, p&
  101.     r = r + ri: g = g + gi: B = B + bi
  103.  
  104. IF i$ = "l" THEN ' LCD
  105.     q = 30
  106.     p& = CDBL(q) * 65536 + CDBL(q) * 256 + q
  107.     PALETTE 0, p&
  108.     PALETTE 15, 0
  110.  
  111. sc$ = i$
  113.  
  114. DATA a,0,-2,1,-2,b,1,-2,1,-1,c,1,-1,1,0,d,0,0,1,0
  115. DATA e,0,-1,0,0,f,0,-2,0,-1,g,0,-1,1,-1
  116.  
  117. DATA 0,abcdef,1,bc,2,abged,3,abgcd,4,fgbc
  118. DATA 5,acdfg,6,acdefg,7,abc,8,abcdefg,9,abcdfg
  119.  
  120.  
Title: Re: Clock variation one billion and something....
Post by: bplus on February 29, 2020, 02:47:48 pm
Well I know we worked on these (Digitals) just in January:
my best:  https://www.qb64.org/forum/index.php?topic=2102.msg113456#msg113456

thread starts: https://www.qb64.org/forum/index.php?topic=2102.msg113336#msg113336
Title: Re: Clock variation one billion and something....
Post by: Richard Frost on February 29, 2020, 03:19:57 pm
Aye, way back when.

Having the option to change the colors ain't much of a change, is it?

And why am I still using SCREEN 12?  Can you say "senile"?
Title: Re: Clock variation one billion and something....
Post by: bplus on February 29, 2020, 03:46:38 pm
Quote
And why am I still using SCREEN 12?  Can you say "senile"?

I am trying a mod and WTH? why isn't anything working?

Oh Screen 12 and DEFINT A-Z heh-heh
Text Only | Text with Attachments