QB64.org Forum

Active Forums => Programs => Topic started by: Richard Frost on January 06, 2020, 01:42:50 am

Title: Northern Lights
Post by: Richard Frost on January 06, 2020, 01:42:50 am

Code: QB64: [Select]

1. _TITLE "Aurora by rfrost@mail.com"
2. $CHECKING:OFF
3. DEFINT A-Z
4. nw1 = 10: nw2 = 14: ar! = ATN(1) / 45: xm = _DESKTOPWIDTH: ym = _DESKTOPHEIGHT
5. DIM r(32), g(32), b(32), sw!(1, nw2), si!(nw2), miny(1, xm), maxy(1, xm), sines(360)
6. i& = _NEWIMAGE(xm, ym, 32)
7. SCREEN i&
8. _DELAY .2 '                                           let screen stabilize
9. _FULLSCREEN: _MOUSEHIDE: _SCREENMOVE _MIDDLE
10. FOR i = 0 TO 360 '                                    color offsets
11.     sines(i) = 30 * SIN(_D2R(i))
12. NEXT i
13. FOR i = 0 TO 31 '                                     colors
14.     READ z$, r$, g$, b$
15.     r(i) = VAL(r$): g(i) = VAL(g$): b(i) = VAL(b$)
16. NEXT i
17. DO
18.     FOR i = 1 TO nw2
19.         sw!(0, i) = RND * 360 * ar! '                 sine wave
20.         sw!(1, i) = sw!(0, i) '                       duplicate
21.         si!(i) = (RND * 50 - 25) / 200 * ar! '        sine wave increment
22.     NEXT i
23.     FOR x = 0 TO xm - 1: FOR z = 0 TO 1
24.             miny(z, x) = 999
25.             maxy(z, x) = -999
26.     NEXT z: NEXT x
27.     pass = 0
28.     DO: _LIMIT 10
29.         CLS
30.         FOR x = 0 TO xm - 1
31.             FOR z = 0 TO 1 '                          two waves
32.                 t! = 0 '                              total
33.                 IF z THEN j = nw2 ELSE j = nw1
34.                 FOR i = 1 TO j '                      sum of 10 waves for top, 14 for bottom
35.                     t! = t! + (20 + RND * 10) * COS(sw!(z, i))
36.                     sw!(z, i) = sw!(z, i) + si!(i) * 5
37.                 NEXT i
38.                 y = 150 + t! + z * (70 + x / 3)
39.                 IF y < miny(z, x) THEN miny(z, x) = y
40.                 IF y > maxy(z, x) THEN maxy(z, x) = y
41.                 dd = (maxy(z, x) - miny(z, x)) \ 8
42.                 miny(z, x) = miny(z, x) + RND * dd
43.                 maxy(z, x) = maxy(z, x) - RND * dd
44.                 yd = maxy(z, x) - miny(z, x) + 1
45.                 rr = RND * 10
46.                 IF rr < 3 THEN
47.                     IF rr = 0 THEN ra = (ra + RND * 20 + 1) MOD 360
48.                     IF rr = 1 THEN ga = (ga + RND * 20 + 1) MOD 360
49.                     IF rr = 2 THEN ba = (ba + RND * 20 + 1) MOD 360
50.                 END IF
51.                 FOR y = miny(z, x) TO maxy(z, x)
52.                     i = (y - miny(z, x)) / yd * 30 + 1
53.                     j = (j + 1) MOD ((RND * 100) + 100)
54.                     IF j = 1 THEN k = RND * 3 + 1
55.                     rt = r(i) * k + sines(ra)
56.                     gt = g(i) * k + sines(ga)
57.                     bt = b(i) * k + sines(ba)
58.                     PSET (x, y), _RGB32(rt, gt, bt)
59.                 NEXT y
60.             NEXT z
61.         NEXT x
62.         IF pass > 4 THEN _DISPLAY
63.         i$ = INKEY$
64.         IF i$ = CHR$(27) THEN SYSTEM '                Esc to quit
65.         IF i$ = " " THEN SLEEP '                      spacebar to pause
66.         i = RND * (nw2 - 1) + 1
67.         si!(i) = (RND * 50 - 25) / 200 * ar!
68.         pass = pass + 1
69.     LOOP UNTIL pass > 999
70. LOOP
71. '         r    g    b
72. DATA 00," 0"," 0","25"
73. DATA 01," 0"," 0","35"
74. DATA 02," 0"," 0","45"
75. DATA 03," 0"," 0","50"
76. DATA 04," 0"," 0","55"
77. DATA 05," 0"," 0","60"
78. DATA 06," 0"," 0","63"
79. DATA 07," 0","10","40"
80. DATA 08," 0","25","30"
81. DATA 09," 0","30","20"
82. DATA 10," 0","35","10"
83. DATA 11," 0","38"," 0"
84. DATA 12," 0","40"," 0"
85. DATA 13," 0","45"," 0"
86. DATA 14," 0","50"," 0"
87. DATA 15," 0","51"," 0"
88. DATA 16," 0","52"," 0"
89. DATA 17," 0","53"," 0"
90. DATA 18," 0","54"," 0"
91. DATA 19," 0","55"," 0"
92. DATA 20," 0","56"," 0"
93. DATA 21," 0","57"," 0"
94. DATA 22," 0","58"," 0"
95. DATA 23," 0","59"," 0"
96. DATA 24," 0","60"," 0"
97. DATA 25," 0","61"," 0"
98. DATA 26," 0","62"," 0"
99. DATA 27," 0","63"," 0"
100. DATA 28,"45"," 0"," 0"
101. DATA 29,"50"," 0"," 0"
102. DATA 30,"55"," 0"," 0"
103. DATA 31,"63"," 0"," 0"
104.  

Title: Re: Northern Lights
Post by: Pete on January 06, 2020, 02:00:09 am

Experienced a sudden craving for ribbon candy.

Pete

Title: Ribbon Candy
Post by: Richard Frost on January 06, 2020, 08:30:44 am

Code: QB64: [Select]

1. _TITLE "Ribbon Candy"
2. DEFINT A-Z
3. COMMON SHARED z
4. DIM SHARED st(20), rgb(140, 2), d(3)
5. RANDOMIZE TIMER
6. SCREEN 12
7. FOR t = 0 TO 2
8.     rgb(0, t) = RND * (62 - 8) + 8
9.     d(t) = SGN(INT(RND * 8) - 4.1)
10. NEXT t
11. LINE (0, 0)-(639, 479), 15, B
12. xo = 50
13. yo = 30
14. xq! = 1.2
15. yq! = .9
16. FOR di = 3 TO 3 STEP -1
17.     GOSUB 100
18. NEXT di
19. w! = TIMER + 1
20. DO: _LIMIT 10
21.     i$ = INKEY$
22. LOOP UNTIL (i$ > "") OR (TIMER > w!)
23. IF i$ = CHR$(27) THEN END
24. DO: _LIMIT 30
25.     ShiftPalette
26.     w! = TIMER + .1
27.     WHILE TIMER < w!
28.         IF LEN(INKEY$) THEN END
29.     WEND
30. LOOP
31.  
32. 100: ho = 460: sp = 0: h = ho / 4: x = 2 * h: y = 3 * h: i = 0
33. 110: i = i + 1: x = x - h: h = h / 2: y = y + h: IF i < di THEN GOTO 110
34. ps = i: GOSUB 600
35. GOSUB 200: a = h: b = -h: GOSUB 800
36. GOSUB 300: a = -h: b = -h: GOSUB 800
37. GOSUB 400: a = -h: b = h: GOSUB 800
38. GOSUB 500: a = h: b = h: GOSUB 800
39. GOSUB 700
40. RETURN
41. 200: IF tp <= 0 THEN RETURN
42. ps = tp - 1: GOSUB 600
43. GOSUB 200: a = h: b = -h: GOSUB 800
44. GOSUB 300: a = 2 * h: b = 0: GOSUB 800
45. GOSUB 500: a = h: b = h: GOSUB 800
46. GOSUB 200: GOSUB 700
47. RETURN
48. 300: IF tp <= 0 THEN RETURN
49. ps = tp - 1: GOSUB 600
50. GOSUB 300: a = -h: b = -h: GOSUB 800
51. GOSUB 400: a = 0: b = -2 * h: GOSUB 800
52. GOSUB 200: a = h: b = -h: GOSUB 800
53. GOSUB 300: GOSUB 700
54. RETURN
55. 400: IF tp <= 0 THEN RETURN
56. ps = tp - 1: GOSUB 600
57. GOSUB 400: a = -h: b = h: GOSUB 800
58. GOSUB 500: a = -2 * h: b = 0: GOSUB 800
59. GOSUB 300: a = -h: b = -h: GOSUB 800
60. GOSUB 400: GOSUB 700
61. RETURN
62. 500: IF tp <= 0 THEN RETURN
63. ps = tp - 1: GOSUB 600
64. GOSUB 500: a = h: b = h: GOSUB 800
65. GOSUB 200: a = 0: b = 2 * h: GOSUB 800
66. GOSUB 400: a = -h: b = h: GOSUB 800
67. GOSUB 500: GOSUB 700
68. RETURN
69. 600: sp = sp + 1: st(sp) = ps: tp = ps
70. RETURN
71. 700: sp = sp - 1: tp = st(sp)
72. RETURN
73. 800:
74. x1 = x * xq! + xo
75. y1 = (y * yq!) + yo
76. x2 = (x + a) * xq! + xo
77. y2 = (y + b) * yq! + yo
78. FOR z = 1 TO 15
79.     z2 = (z - 8) * 3
80.     FOR t = 0 TO 2
81.         z3 = z2 + t
82.         px1 = x1 + z3
83.         py1 = y1 + z3
84.         px2 = x2 + z3
85.         py2 = y2 + z3
86.         DO
87.             IF POINT(px1, py1) <= z THEN PSET (px1, py1), z
88.             px1 = px1 + SGN(px2 - px1)
89.             py1 = py1 + SGN(py2 - py1)
90.         LOOP UNTIL (px1 = px2) AND (py1 = py2)
91.         _DELAY .0001
92.         IF INKEY$ = CHR$(27) THEN
93.             SCREEN 0, 0, 0, 0
94.             END
95.         END IF
96.     NEXT t
97. NEXT z
98. x = x + a: y = y + b
99. RETURN
100.  
101. SUB ShiftPalette
102.     FOR c = 15 TO 1 STEP -1
103.         OUT &H3C8, c
104.         FOR t = 0 TO 2
105.             rgb(c, t) = rgb(c - 1, t)
106.             OUT &H3C9, rgb(c, t)
107.         NEXT t
108.     NEXT c
109.     FOR t = 0 TO 2
110.         IF (rgb(0, t) < 8) OR (rgb(0, t) > 60) THEN d(t) = -d(t)
111.         rgb(0, t) = rgb(0, t) + d(t) * 2
112.     NEXT t
113. END SUB
114.  

Title: Re: Northern Lights
Post by: bplus on January 06, 2020, 12:22:03 pm

Here is mod I tried to soften lines and add white lines reaching up:

Code: QB64: [Select]

1. _TITLE "Aurora by rfrost@mail.com B+ mod massive softening of lines and adding white lines  2020-01-06"
2. $CHECKING:OFF
3. DEFINT A-Z
4. nw1 = 10: nw2 = 14: ar! = ATN(1) / 45: xm = _DESKTOPWIDTH: ym = _DESKTOPHEIGHT
5. DIM r(32), g(32), b(32), sw!(1, nw2), si!(nw2), miny(1, xm), maxy(1, xm), sines(360)
6. i& = _NEWIMAGE(xm, ym, 32)
7. SCREEN i&
8. _DELAY .2 '                                           let screen stabilize
9. _FULLSCREEN: _MOUSEHIDE: _SCREENMOVE _MIDDLE
10. FOR i = 0 TO 360 '                                    color offsets
11.     sines(i) = 30 * SIN(_D2R(i))
12. NEXT i
13. FOR i = 0 TO 31 '                                     colors
14.     READ z$, r$, g$, b$
15.     r(i) = VAL(r$): g(i) = VAL(g$): b(i) = VAL(b$)
16. NEXT i
17. DO
18.     FOR i = 1 TO nw2
19.         sw!(0, i) = RND * 360 * ar! '                 sine wave
20.         sw!(1, i) = sw!(0, i) '                       duplicate
21.         si!(i) = (RND * 50 - 25) / 200 * ar! '        sine wave increment
22.     NEXT i
23.     FOR x = 0 TO xm - 1: FOR z = 0 TO 1
24.             miny(z, x) = 999
25.             maxy(z, x) = -999
26.     NEXT z: NEXT x
27.     pass = 0
28.     DO: _LIMIT 20
29.         FOR i = 0 TO _HEIGHT
30.             LINE (0, i)-(_WIDTH, i), _RGBA32(i * 20 / _HEIGHT, 5, i * 50 / _HEIGHT + 10, 40), BF
31.         NEXT
32.         FOR x = 0 TO xm - 1
33.             FOR z = 0 TO 1 '                          two waves
34.                 t! = 0 '                              total
35.                 IF z THEN j = nw2 ELSE j = nw1
36.                 FOR i = 1 TO j '                      sum of 10 waves for top, 14 for bottom
37.                     t! = t! + (20 + RND * 10) * COS(sw!(z, i))
38.                     sw!(z, i) = sw!(z, i) + si!(i) * 5
39.                 NEXT i
40.                 y = 150 + t! + z * (70 + x / 3)
41.                 IF y < miny(z, x) THEN miny(z, x) = y
42.                 IF y > maxy(z, x) THEN maxy(z, x) = y
43.                 dd = (maxy(z, x) - miny(z, x)) \ 8
44.                 miny(z, x) = miny(z, x) + RND * dd
45.                 maxy(z, x) = maxy(z, x) - RND * dd
46.                 yd = maxy(z, x) - miny(z, x) + 1
47.                 rr = RND * 10
48.                 IF rr < 3 THEN
49.                     IF rr = 0 THEN ra = (ra + RND * 20 + 1) MOD 360
50.                     IF rr = 1 THEN ga = (ga + RND * 20 + 1) MOD 360
51.                     IF rr = 2 THEN ba = (ba + RND * 20 + 1) MOD 360
52.                 END IF
53.                 FOR y = miny(z, x) TO maxy(z, x)
54.                     i = (y - miny(z, x)) / yd * 30 + 1
55.                     j = (j + 1) MOD ((RND * 100) + 100)
56.                     IF j = 1 THEN k = RND * 3 + 1
57.                     rt = r(i) * k + sines(ra)
58.                     gt = g(i) * k + sines(ga)
59.                     bt = b(i) * k + sines(ba)
60.                     IF RND < .06 THEN
61.                         CIRCLE (x, y), 1, _RGB32(1.75 * rt, 2.0 * gt, 1.25 * bt, 10):
62.                         LINE (x, y)-STEP(50, -220 + RND * -200), &H01FFFFFF
63.                     END IF
64.                 NEXT y
65.             NEXT z
66.         NEXT x
67.         IF pass > 4 THEN _DISPLAY
68.         i$ = INKEY$
69.         IF i$ = CHR$(27) THEN SYSTEM '                Esc to quit
70.         IF i$ = " " THEN SLEEP '                      spacebar to pause
71.         i = RND * (nw2 - 1) + 1
72.         si!(i) = (RND * 50 - 25) / 200 * ar!
73.         pass = pass + 1
74.     LOOP UNTIL pass > 999
75. LOOP
76. '         r    g    b
77. DATA 00," 0"," 0","25"
78. DATA 01," 0"," 0","35"
79. DATA 02," 0"," 0","45"
80. DATA 03," 0"," 0","50"
81. DATA 04," 0"," 0","55"
82. DATA 05," 0"," 0","60"
83. DATA 06," 0"," 0","63"
84. DATA 07," 0","10","40"
85. DATA 08," 0","25","30"
86. DATA 09," 0","30","20"
87. DATA 10," 0","35","10"
88. DATA 11," 0","38"," 0"
89. DATA 12," 0","40"," 0"
90. DATA 13," 0","45"," 0"
91. DATA 14," 0","50"," 0"
92. DATA 15," 0","51"," 0"
93. DATA 16," 0","52"," 0"
94. DATA 17," 0","53"," 0"
95. DATA 18," 0","54"," 0"
96. DATA 19," 0","55"," 0"
97. DATA 20," 0","56"," 0"
98. DATA 21," 0","57"," 0"
99. DATA 22," 0","58"," 0"
100. DATA 23," 0","59"," 0"
101. DATA 24," 0","60"," 0"
102. DATA 25," 0","61"," 0"
103. DATA 26," 0","62"," 0"
104. DATA 27," 0","63"," 0"
105. DATA 28,"45"," 0"," 0"
106. DATA 29,"50"," 0"," 0"
107. DATA 30,"55"," 0"," 0"
108. DATA 31,"63"," 0"," 0"
109.  
110.  
111.  

Title: Re: Northern Lights
Post by: Pete on January 06, 2020, 01:54:55 pm

Sorry Mark, I couldn't get to yoour's. I tried Robert's, and now my keyboard is all sticky. Dammit Bill, yes, I mean the ribbon candy one!

Hey, nice ribbon candy and I actually did try the "softening" effect aurora. All good stuff to showcase what can be done with QB64, if you have the artistic ability to create it. Me, I'm still working on a fill function for blocks. Oh well...

Pete

Title: Re: Northern Lights
Post by: Qbee on January 06, 2020, 04:02:31 pm

Aurora and Ribbon Candy by rfrost@mail.com and Aurora-Mod by bplus look all interesting.

To show guests, who otherwise have to imagine the beauty directly from code,  I made a very short (a few seconds, but still takes nearly 14 MB after reducing from 74 MB) GIF-Animation from the Aurora-Mod.

Title: Re: Northern Lights
Post by: Pete on January 06, 2020, 04:25:30 pm

Interesting. I was thinking of making a gif of Marks fireworks program I have software that can record from the screen, but I'm curious, what did you use to convert to a .gif?

Pete

Title: Re: Northern Lights
Post by: Qbee on January 06, 2020, 04:27:32 pm

I use GIF Movie Gear (Full version).
It is a little bit old, supports Windows XP, but works fine with Windows 10.

Title: Re: Northern Lights
Post by: bplus on January 06, 2020, 04:39:47 pm

I really like first part of Richard Frost's ribbon candy.

It reminds me of an experiment I've been meaning to try but keep getting distracted. Stay tuned...

Title: Re: Northern Lights
Post by: Richard Frost on January 06, 2020, 05:08:42 pm

That softening Bplus did makes it way more realistic. 

But it's too dim.

Pete, shoot down the Sun.

Title: Re: Northern Lights
Post by: Pete on January 06, 2020, 05:25:51 pm

Yeah, soary bout that, varmint. Me aveetar gits carried away with the six-guns sometimez.

I agree, softening makes it more realistic, but brighter would be better.

Pete

Title: Re: Northern Lights
Post by: SierraKen on January 06, 2020, 06:07:01 pm

Really cool Robert!

Text Only | Text with Attachments