Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: Richard Frost on January 19, 2020, 01:48:18 am

Title: One page clock
Post by: Richard Frost on January 19, 2020, 01:48:18 am
Code: QB64: [Select]
  1. DIM segxy(7, 4), seglit$(9) '                                   One page clock!  (Let's get SMALL! - Steve Martin)
  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
  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
Title: Re: One page clock
Post by: dajan on January 19, 2020, 06:35:02 am
Cool lava clock, thanks.
Title: Re: One page clock
Post by: Qwerkey on January 19, 2020, 07:07:18 am
... and with proper 7-segment display with so few lines of code.  Very nice.
Title: Re: One page clock
Post by: bplus on January 19, 2020, 12:24:35 pm
Yes, nice job on segments and condensed code. :)
Title: Re: One page clock
Post by: Richard Frost on January 19, 2020, 01:31:13 pm
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)
  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
  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
Title: Re: One page clock
Post by: dajan on January 19, 2020, 01:57:17 pm
Wow, that looks almost like CRT display grain simulation.
Title: Re: One page clock
Post by: Richard Frost on January 20, 2020, 12:30:56 am
Aye, I have weird taste.  The hurdy-gurdy is a fine musical instrument.
Title: Re: One page clock
Post by: bplus on January 20, 2020, 03:14:16 pm
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
  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
  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
  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
Title: Re: One page clock
Post by: Richard Frost on January 20, 2020, 05:49:54 pm
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.
Title: Re: One page clock
Post by: Richard Frost on January 20, 2020, 08:52:28 pm
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&
  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
  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$
  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
Title: Re: One page clock
Post by: bplus on January 20, 2020, 10:10:25 pm
Hi Richard,

What version of QB64 allows line 8?

I must say _FULLSCREEN is crazy! :)
Title: Re: One page clock
Post by: FellippeHeitor on January 20, 2020, 10:15:47 pm
That's a typo. He surely meant
Code: QB64: [Select]
Title: Re: One page clock
Post by: bplus on January 20, 2020, 10:32:25 pm
Thanks Fellippe, I guess my eyes didn't pickup the missing u.

Oh I guess that brings out some of the color patterns better. :)
Title: Re: One page clock
Post by: bplus on January 20, 2020, 11:40:49 pm
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
  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
  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
  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
  82.  
  83. FUNCTION rgbf~& (n1, n2, n3)
  84.     rgbf~& = _RGB32(n1 * 255, n2 * 255, n3 * 255)
  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
  102.  
  103.  

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

Title: Re: One page clock
Post by: Richard Frost on January 21, 2020, 02:20:18 am
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.

Title: Re: One page clock
Post by: dajan on January 21, 2020, 05:49:18 am
@bplus, awesome plasma, like the 3D shader effect a lot. Does the pattern repeat after a while, or it is completley random/fractaloid? I don't know a lot about this kind of math.
Title: Re: One page clock
Post by: bplus on January 21, 2020, 11:41:46 am
Quote from: dajan on January 21, 2020, 05:49:18 am
@bplus, awesome plasma, like the 3D shader effect a lot. Does the pattern repeat after a while, or it is completley random/fractaloid? I don't know a lot about this kind of math.

Hope you don't mind, I answered your question in thread where I have worked on this effect:
https://www.qb64.org/forum/index.php?topic=1451.msg113440#msg113440

To show whose shoulders I am standing on and to show my source and give credit.
Title: Re: One page clock
Post by: bplus on January 21, 2020, 08:22:25 pm
This is becoming an obsession, here I made crystal light digits and clock may be enlarged by + key and shrunk by - key, spacebar will still change color set:

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

Text Only | Text with Attachments