One page clock

[Richard Frost]

Code: QB64: [Select]

1. DIM segxy(7, 4), seglit$(9) '                                   One page clock!  (Let's get SMALL! - Steve Martin)
2. SCREEN _NEWIMAGE(640, 480, 32): _FULLSCREEN: _MOUSEHIDE
3. FOR i = 1 TO 7: READ g$: FOR j = 1 TO 4: READ segxy(i, j): NEXT j: NEXT i
4. FOR i = 0 TO 9: READ g$, seglit$(i): NEXT i
5. RANDOMIZE TIMER: bx1 = 44: bx2 = 600: by1 = 155: by2 = 330: xi = RND * 7 + 1: yi = RND * 7 + 1
6. DO
7.     t$ = TIME$: x0 = 68: CLS
8.     FOR i = 1 TO 6
9.         n = VAL(MID$(t$, VAL(MID$("124578", i, 1)), 1)) '       pick off time digit
10.         FOR j = 1 TO LEN(seglit$(n)) '                          1 = b&c, etc.
11.             sn = ASC(MID$(seglit$(n), j, 1)) - 96 '             a=1,b=2, etc.
12.             x1 = x0 + 8 + segxy(sn, 1) * 40: y1 = 300 + segxy(sn, 2) * 60
13.             x2 = x0 + 8 + segxy(sn, 3) * 40: y2 = 300 + segxy(sn, 4) * 60
14.             FOR k = -10 TO 10
15.                 IF y1 = y2 THEN '                               horizontal segment
16.                     LINE (x1 + ABS(k) + 1, y1 + k)-(x2 - ABS(k) - 1, y2 + k), _RGB32(1, 1, b)
17.                 ELSE
18.                     LINE (x1 + k, y1 + ABS(k) + 1)-(x2 + k, y2 - ABS(k) - 1), _RGB32(1, 1, b)
19.                 END IF
20.             NEXT k
21.         NEXT j
22.         x0 = x0 + 74 - (i = 2) * 40 - (i = 4) * 40 '            additional increment to jump colons
23.     NEXT i
24.     DO: _LIMIT 10 '                                             majority time in this loop
25.         xx = xx + xi: IF (xx < 1) OR (xx > 99) THEN xi = -xi
26.         yy = yy + yi: IF (yy < 1) OR (yy > 99) THEN yi = -yi
27.         xr! = (xx + 20) / 800: yr! = (yy + 20) / 800
28.         FOR y = by1 TO by2
29.             FOR x = bx1 TO bx2
30.                 c = SQR(ABS(x * x * SIN(x * xr!) + y * y * COS(y * yr!))) MOD 150 + 100
31.                 IF _GREEN(POINT(x, y)) <> 1 THEN PSET (x, y), _RGB32(0, c, c)
32.             NEXT x
33.         NEXT y
34.         _DISPLAY: i$ = INKEY$
35.     LOOP UNTIL (t$ <> TIME$) OR (LEN(i$) > 0)
36. LOOP UNTIL i$ = CHR$(27)
37. DATA a,0,-2,1,-2,b,1,-2,1,-1,c,1,-1,1,0,d,0,0,1,0,e,0,-1,0,0,f,0,-2,0,-1,g,0,-1,1,-1
38. DATA 0,abcdef,1,bc,2,abged,3,abgcd,4,fgbc,5,acdfg,6,acdefg,7,abc,8,abcdefg,9,abcdfg

[dajan]

Cool lava clock, thanks.

[Qwerkey]

... and with proper 7-segment display with so few lines of code.  Very nice.

[bplus]

Yes, nice job on segments and condensed code. :)

[Richard Frost]

I keep messing with the colors.  This is much nicer.  Some of you might find even better color combos.
A different version has the lava alternating between the digits and background (hence var b). 

Code: QB64: [Select]

1. DIM segxy(7, 4), seglit$(9) '                                   one page!  (Let's get SMALL! - Steve Martin)
2. SCREEN _NEWIMAGE(640, 480, 32): _FULLSCREEN: _MOUSEHIDE
3. FOR i = 1 TO 7: READ g$: FOR j = 1 TO 4: READ segxy(i, j): NEXT j: NEXT i
4. FOR i = 0 TO 9: READ g$, seglit$(i): NEXT i
5. RANDOMIZE TIMER: bx1 = 44: bx2 = 600: by1 = 155: by2 = 330: xi = RND * 7 + 1: yi = RND * 7 + 1
6. DO
7.     t$ = TIME$: x0 = 68: CLS
8.     FOR i = 1 TO 6
9.         n = VAL(MID$(t$, VAL(MID$("124578", i, 1)), 1)) '       pick off time digit
10.         FOR j = 1 TO LEN(seglit$(n)) '                          1 = b&c, etc.
11.             sn = ASC(MID$(seglit$(n), j, 1)) - 96 '             a=1,b=2, etc.
12.             x1 = x0 + 8 + segxy(sn, 1) * 40: y1 = 300 + segxy(sn, 2) * 60
13.             x2 = x0 + 8 + segxy(sn, 3) * 40: y2 = 300 + segxy(sn, 4) * 60
14.             FOR k = -10 TO 10
15.                 IF y1 = y2 THEN '                               horizontal segment
16.                     LINE (x1 + ABS(k) + 1, y1 + k)-(x2 - ABS(k) - 1, y2 + k), _RGB32(1, 1, b)
17.                 ELSE
18.                     LINE (x1 + k, y1 + ABS(k) + 1)-(x2 + k, y2 - ABS(k) - 1), _RGB32(1, 1, b)
19.                 END IF
20.             NEXT k
21.         NEXT j
22.         x0 = x0 + 74 - (i = 2) * 40 - (i = 4) * 40 '            additional increment to jump colons
23.     NEXT i
24.     DO: _LIMIT 10 '                                             majority time in this loop
25.         xx = xx + xi: IF (xx < 1) OR (xx > 99) THEN xi = -xi
26.         yy = yy + yi: IF (yy < 1) OR (yy > 99) THEN yi = -yi
27.         xr! = (xx + 20) / 800: yr! = (yy + 20) / 800
28.         FOR y = by1 TO by2
29.             FOR x = bx1 TO bx2
30.                 c = SQR(ABS(x * x * SIN(x * xr!) + y * y * COS(y * yr!))) MOD 222 + 32: d = (d + 1) MOD 8
31.                 IF _GREEN(POINT(x, y)) <> 1 THEN PSET (x, y), _RGB32(c \ (d + 1), c \ (d + 1), c)
32.             NEXT x
33.         NEXT y
34.         _DISPLAY: i$ = INKEY$
35.     LOOP UNTIL (t$ <> TIME$) OR (LEN(i$) > 0)
36. LOOP UNTIL i$ = CHR$(27)
37. DATA a,0,-2,1,-2,b,1,-2,1,-1,c,1,-1,1,0,d,0,0,1,0,e,0,-1,0,0,f,0,-2,0,-1,g,0,-1,1,-1
38. DATA 0,abcdef,1,bc,2,abged,3,abgcd,4,fgbc,5,acdfg,6,acdefg,7,abc,8,abcdefg,9,abcdfg

[dajan]

Wow, that looks almost like CRT display grain simulation.

[Richard Frost]

Aye, I have weird taste.  The hurdy-gurdy is a fine musical instrument.

[bplus]

I have to admit I found this a fun challenge! Here is a version I came up with today:

Code: QB64: [Select]

1. _TITLE "Segmented Digital Clock" 'b+ 2020-01-20
2. CONST xmax = 850, ymax = 200, sq = 25, k = &HFF000000
3. CONST dat = "1110111000001101111100011111100101110111011101101001001111111111011011"
4. SCREEN _NEWIMAGE(xmax, ymax, 32)
5. last = 3599
6. 1 CLS
7. last = (last + 1) MOD 20 '<<<<<<<<<<<<<  pick any interval you want (10 * n secs of length)  or comment out 2nd mode
8. IF last = 0 THEN r = RND * RND: g = RND * RND: b = RND * RND: mode = 1 - mode
9. FOR x = 0 TO xmax 'background graphics 2 modes
10.     IF mode THEN LINE (x, 0)-STEP(0, ymax), _RGB32(127 + 127 * SIN(r * (x + last)), 127 + 127 * SIN(g * (x + last)), 127 + 127 * SIN(b * (x + last)))
11.     IF mode = 0 THEN
12.         FOR y = 0 TO ymax
13.             PSET (x, y), _RGB32(127 + 127 * SIN(.1 * r * x * y + last), 127 + 127 * SIN(.155 * g * x * y + last), 127 + 127 * SIN(2 * b * x * y + last))
14.         NEXT
15.     END IF
16. NEXT
17. FOR n = 1 TO 8 'clock digits over background
18.     IF MID$(TIME$, n, 1) = ":" THEN
19.         LINE ((n - 1) * 4 * sq + 2 * sq, sq + sq)-STEP(sq, sq), k, BF: LINE ((n - 1) * 4 * sq + 2 * sq, sq + 4 * sq)-STEP(sq, sq), k, BF
20.     ELSE
21.         drawC (n - 1) * 4 * sq + sq, sq, MID$(dat$, VAL(MID$(TIME$, n, 1)) * 7 + 1, 7)
22.     END IF
23. NEXT
24. _DISPLAY: _LIMIT 10: GOTO 1
25. SUB drawC (x, y, c$)
26.     FOR m = 1 TO 7
27.         IF VAL(MID$(c$, m, 1)) THEN
28.             SELECT CASE m
29.             CASE 1: LINE (x, y)-STEP(sq, 3 * sq), k, BF: CASE 2: LINE (x, y + 2 * sq)-STEP(sq, 4 * sq), k, BF
30.             CASE 3: LINE (x, y)-STEP(3 * sq, sq), k, BF: CASE 4: LINE (x, y + 2 * sq)-STEP(3 * sq, sq), k, BF
31.             CASE 5: LINE (x, y + 5 * sq)-STEP(3 * sq, sq), k, BF: CASE 6: LINE (x + 2 * sq, y)-STEP(sq, 3 * sq), k, BF
32.             CASE 7: LINE (x + 2 * sq, y + 2 * sq)-STEP(sq, 4 * sq), k, BF: END SELECT
33.         END IF
34.     NEXT
35. END SUB
36.  

With 35 lines, yeah I double parked ;-)), I had room to have two modes of background graphics

Update: messed around with numbers in mode 0

[Richard Frost]

Very nice, bplus, and educational.  I didn't know _LIMIT could be used in ordinary GOTO type loops.   Of
course your backgrounds are way cooler too.    34 LINES!   With 50 lines I bet you could take over Cuba.

[Richard Frost]

Combining the best math of Bplus with proper segments, and making it all small.  The icon line is optional. 
Shucks, so is the DEFINT, but maybe it helps the CPU run cooler.   Alt-Enter to make fullscreen.

Code: QB64: [Select]

1. _TITLE "Clock"
2. DEFINT A-Z
3. DIM segxy(7, 4), seglit$(9)
4. sw = 350: sh = 100: c& = _RGB32(1, 1, 1)
5. SCREEN _NEWIMAGE(sw, sh, 32)
6. f$ = "clockx.png": img& = _LOADIMAGE(f$): _ICON img&
7. _SCREENMOVE _DESKTOPWIDTH - sw - 10, _DESKTOPHEIGHT - sh - 54
8. _ALLOWFLLSCREEN _SQUAREPIXELS
9. FOR i = 1 TO 7: READ g$: FOR j = 1 TO 4: READ segxy(i, j): NEXT j: NEXT i
10. FOR i = 0 TO 9: READ g$, seglit$(i): NEXT i
11. RANDOMIZE TIMER
12. DO
13.     t$ = TIME$: showcolon! = TIMER + .5
14.     DO: _LIMIT 10
15.         z = (z + 1) MOD 50: IF z = 1 THEN r! = RND: g! = RND: b! = RND
16.         FOR y = 0 TO sh: FOR x = 0 TO sw
17.                 xy = (x - sw \ 2) * (y - sh \ 2)
18.                 PSET (x, y), _RGB32(255 * SIN(.1 * r! * xy + z), 255 * SIN(.155 * g! * xy + z), 255 * SIN(2 * b! * xy + z))
19.         NEXT x: NEXT y
20.         x0 = 12
21.         FOR i = 1 TO 6
22.             n = VAL(MID$(t$, VAL(MID$("124578", i, 1)), 1))
23.             FOR j = 1 TO LEN(seglit$(n))
24.                 sn = ASC(MID$(seglit$(n), j, 1)) - 96
25.                 x1 = x0 + segxy(sn, 1) * 32: y1 = 87 + segxy(sn, 2) * 38
26.                 x2 = x0 + segxy(sn, 3) * 32: y2 = 87 + segxy(sn, 4) * 38
27.                 FOR k = -6 TO 6
28.                     IF y1 = y2 THEN
29.                         LINE (x1 + ABS(k) + 1, y1 + k)-(x2 - ABS(k) - 1, y2 + k), c&
30.                     ELSE
31.                         LINE (x1 + k, y1 + ABS(k) + 1)-(x2 + k, y2 - ABS(k) - 1), c&
32.                     END IF
33.                 NEXT k
34.             NEXT j
35.             x0 = x0 + 50 - (i = 2) * 20 - (i = 4) * 20
36.         NEXT i
37.         IF TIMER < showcolon! THEN
38.             FOR i = 0 TO 1
39.                 x = 112 + i * 118: y = 36: yt = 20
40.                 LINE (x, y + y0)-STEP(6, 6), c&, BF
41.                 LINE (x, y + yt)-STEP(6, 6), c&, BF
42.             NEXT i
43.         END IF
44.         _DISPLAY
45.         i$ = INKEY$: IF i$ = CHR$(27) THEN SYSTEM
46.     LOOP UNTIL t$ <> TIME$
47. LOOP
48. DATA a,0,-2,1,-2,b,1,-2,1,-1,c,1,-1,1,0,d,0,0,1,0,e,0,-1,0,0,f,0,-2,0,-1,g,0,-1,1,-1
49. DATA 0,abcdef,1,bc,2,abged,3,abgcd,4,fgbc,5,acdfg,6,acdefg,7,abc,8,abcdefg,9,abcdfg

[bplus]

Hi Richard,

What version of QB64 allows line 8?

I must say _FULLSCREEN is crazy! :)

[FellippeHeitor]

That's a typo. He surely meant

Code: QB64: [Select]

1. _ALLOWFULLSCREEN

[bplus]

Thanks Fellippe, I guess my eyes didn't pickup the missing u.

Oh I guess that brings out some of the color patterns better. :)

[bplus]

Richard here is lava background effect you might be striving for?

Code: QB64: [Select]

1. _TITLE "Digital Plasmatic Clock   press spacebar for new coloring set" ' b+ 2020-01-20 translated and modified from SmallBASIC
2. 'Plasma Magnifico - updated 2015-11-26 for Android
3. 'This program creates a plasma surface, which looks oily or silky.
4.  
5. CONST xmax = 850, ymax = 200, sq = 25
6. CONST dat = "1110111000001101111100011111100101110111011101101001001111111111011011"
7.  
8. TYPE xy
9.     x AS SINGLE
10.     y AS SINGLE
11.     dx AS SINGLE
12.     dy AS SINGLE
13. END TYPE
14. SCREEN _NEWIMAGE(xmax, ymax, 32)
15. _SCREENMOVE 300, 40
16.  
17. DIM c(360) AS _UNSIGNED LONG, p(6) AS xy, f(6)
18. restart:
19. r = RND: g = RND: b = RND: i = 0
20. FOR n = 1 TO 5
21.     r1 = r: g1 = g: b1 = b
22.     DO: r = RND: LOOP UNTIL ABS(r - r1) > .2
23.     DO: g = RND: LOOP UNTIL ABS(g - g1) > .2
24.     DO: b = RND: LOOP UNTIL ABS(g - g1) > .2
25.     FOR m = 0 TO 17: m1 = 17 - m
26.         f1 = (m * r) / 18: f2 = (m * g) / 18: f3 = (m * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
27.     NEXT
28.     FOR m = 0 TO 17: m1 = 17 - m
29.         f1 = (m + m1 * r) / 18: f2 = (m + m1 * g) / 18: f3 = (m + m1 * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
30.     NEXT
31.     FOR m = 0 TO 17: m1 = 17 - m
32.         f1 = (m1 + m * r) / 18: f2 = (m1 + m * g) / 18: f3 = (m1 + m * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
33.     NEXT
34.     FOR m = 0 TO 17: m1 = 17 - m
35.         f1 = (m1 * r) / 18: f2 = (m1 * g) / 18: f3 = (m1 * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
36.     NEXT
37. NEXT
38.  
39. FOR n = 0 TO 5
40.     p(n).x = RND * xmax: p(n).y = RND * ymax: p(n).dx = RND * 2 - 1: p(n).dy = RND * 2 - 1
41.     f(n) = RND * .1
42. NEXT
43.  
44. WHILE _KEYDOWN(27) = 0
45.     IF INKEY$ = " " THEN GOTO restart
46.     FOR i = 0 TO 5
47.         p(i).x = p(i).x + p(i).dx
48.         IF p(i).x > xmax OR p(i).x < 0 THEN p(i).dx = -p(i).dx
49.         p(i).y = p(i).y + p(i).dy
50.         IF p(i).y > ymax OR p(i).y < 0 THEN p(i).dy = -p(i).dy
51.     NEXT
52.     FOR y = 0 TO ymax - 1 STEP 2
53.         FOR x = 0 TO xmax - 1 STEP 2
54.             d = 0
55.             FOR n = 0 TO 5
56.                 dx = x - p(n).x: dy = y - p(n).y
57.                 k = SQR(dx * dx + dy * dy)
58.                 d = d + (SIN(k * f(n)) + 1) / 2
59.             NEXT n: d = d * 60
60.             LINE (x, y)-STEP(2, 2), c(d), BF
61.         NEXT
62.     NEXT
63.     FOR j = 1 TO 3
64.         IF j = 1 THEN
65.             c~& = &HFFFFFFFF: offset = -2
66.         ELSEIF j = 2 THEN
67.             c~& = &HFF555555: offset = 2
68.         ELSE
69.             c~& = &HFFAAAAAA: offset = 0
70.         END IF
71.         FOR n = 1 TO 8 'clock digits over background
72.             IF MID$(TIME$, n, 1) = ":" THEN
73.                 LINE ((n - 1) * 4 * sq + 2 * sq + offset, sq + sq + offset)-STEP(sq, sq), c~&, BF
74.                 LINE ((n - 1) * 4 * sq + 2 * sq + offset, sq + 4 * sq + offset)-STEP(sq, sq), c~&, BF
75.             ELSE
76.                 drawC (n - 1) * 4 * sq + sq + offset, sq + offset, MID$(dat$, VAL(MID$(TIME$, n, 1)) * 7 + 1, 7), c~&
77.             END IF
78.         NEXT
79.     NEXT
80.     _DISPLAY
81. WEND
82.  
83. FUNCTION rgbf~& (n1, n2, n3)
84.     rgbf~& = _RGB32(n1 * 255, n2 * 255, n3 * 255)
85. END FUNCTION
86.  
87. SUB drawC (x, y, c$, c AS _UNSIGNED LONG)
88.     FOR m = 1 TO 7
89.         IF VAL(MID$(c$, m, 1)) THEN
90.             SELECT CASE m
91.                 CASE 1: LINE (x, y)-STEP(sq, 3 * sq), c, BF
92.                 CASE 2: LINE (x, y + 2 * sq)-STEP(sq, 4 * sq), c, BF
93.                 CASE 3: LINE (x, y)-STEP(3 * sq, sq), c, BF
94.                 CASE 4: LINE (x, y + 2 * sq)-STEP(3 * sq, sq), c, BF
95.                 CASE 5: LINE (x, y + 5 * sq)-STEP(3 * sq, sq), c, BF
96.                 CASE 6: LINE (x + 2 * sq, y)-STEP(sq, 3 * sq), c, BF
97.                 CASE 7: LINE (x + 2 * sq, y + 2 * sq)-STEP(sq, 4 * sq), c, BF
98.             END SELECT
99.         END IF
100.     NEXT
101. END SUB
102.  
103.  

Not so condensed and I bet it would look great with your digits!

[Richard Frost]

Oh wow, that plasma is.......mesmerizing, like LSD at age 14.

No, I wasn't striving for that effect, but I sure like it.   I notice you highlighted the digits too.

Short code can be fun.  Unless it calls a GL library, which means it's math far beyond me.