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

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Northern Lights
« Reply #1 on: January 06, 2020, 02:00:09 am »
Experienced a sudden craving for ribbon candy.

Pete
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline Richard Frost

  • Seasoned Forum Regular
  • Posts: 316
  • Needle nardle noo. - Peter Sellers
    • View Profile
Ribbon Candy
« Reply #2 on: January 06, 2020, 08:30:44 am »
Code: QB64: [Select]
  1. _TITLE "Ribbon Candy"
  2. DEFINT A-Z
  3. DIM SHARED st(20), rgb(140, 2), d(3)
  4. FOR t = 0 TO 2
  5.     rgb(0, t) = RND * (62 - 8) + 8
  6.     d(t) = SGN(INT(RND * 8) - 4.1)
  7. LINE (0, 0)-(639, 479), 15, B
  8. xo = 50
  9. yo = 30
  10. xq! = 1.2
  11. yq! = .9
  12. FOR di = 3 TO 3 STEP -1
  13.     GOSUB 100
  14. NEXT di
  15. w! = TIMER + 1
  16.     i$ = INKEY$
  17. LOOP UNTIL (i$ > "") OR (TIMER > w!)
  18. IF i$ = CHR$(27) THEN END
  19.     ShiftPalette
  20.     w! = TIMER + .1
  21.     WHILE TIMER < w!
  22.         IF LEN(INKEY$) THEN END
  23.     WEND
  24.  
  25. 100: ho = 460: sp = 0: h = ho / 4: x = 2 * h: y = 3 * h: i = 0
  26. 110: i = i + 1: x = x - h: h = h / 2: y = y + h: IF i < di THEN GOTO 110
  27. ps = i: GOSUB 600
  28. GOSUB 200: a = h: b = -h: GOSUB 800
  29. GOSUB 300: a = -h: b = -h: GOSUB 800
  30. GOSUB 400: a = -h: b = h: GOSUB 800
  31. GOSUB 500: a = h: b = h: GOSUB 800
  32. GOSUB 700
  33. 200: IF tp <= 0 THEN RETURN
  34. ps = tp - 1: GOSUB 600
  35. GOSUB 200: a = h: b = -h: GOSUB 800
  36. GOSUB 300: a = 2 * h: b = 0: GOSUB 800
  37. GOSUB 500: a = h: b = h: GOSUB 800
  38. GOSUB 200: GOSUB 700
  39. 300: IF tp <= 0 THEN RETURN
  40. ps = tp - 1: GOSUB 600
  41. GOSUB 300: a = -h: b = -h: GOSUB 800
  42. GOSUB 400: a = 0: b = -2 * h: GOSUB 800
  43. GOSUB 200: a = h: b = -h: GOSUB 800
  44. GOSUB 300: GOSUB 700
  45. 400: IF tp <= 0 THEN RETURN
  46. ps = tp - 1: GOSUB 600
  47. GOSUB 400: a = -h: b = h: GOSUB 800
  48. GOSUB 500: a = -2 * h: b = 0: GOSUB 800
  49. GOSUB 300: a = -h: b = -h: GOSUB 800
  50. GOSUB 400: GOSUB 700
  51. 500: IF tp <= 0 THEN RETURN
  52. ps = tp - 1: GOSUB 600
  53. GOSUB 500: a = h: b = h: GOSUB 800
  54. GOSUB 200: a = 0: b = 2 * h: GOSUB 800
  55. GOSUB 400: a = -h: b = h: GOSUB 800
  56. GOSUB 500: GOSUB 700
  57. 600: sp = sp + 1: st(sp) = ps: tp = ps
  58. 700: sp = sp - 1: tp = st(sp)
  59. 800:
  60. x1 = x * xq! + xo
  61. y1 = (y * yq!) + yo
  62. x2 = (x + a) * xq! + xo
  63. y2 = (y + b) * yq! + yo
  64. FOR z = 1 TO 15
  65.     z2 = (z - 8) * 3
  66.     FOR t = 0 TO 2
  67.         z3 = z2 + t
  68.         px1 = x1 + z3
  69.         py1 = y1 + z3
  70.         px2 = x2 + z3
  71.         py2 = y2 + z3
  72.         DO
  73.             IF POINT(px1, py1) <= z THEN PSET (px1, py1), z
  74.             px1 = px1 + SGN(px2 - px1)
  75.             py1 = py1 + SGN(py2 - py1)
  76.         LOOP UNTIL (px1 = px2) AND (py1 = py2)
  77.         _DELAY .0001
  78.         IF INKEY$ = CHR$(27) THEN
  79.             SCREEN 0, 0, 0, 0
  80.             END
  81.         END IF
  82.     NEXT t
  83. x = x + a: y = y + b
  84.  
  85. SUB ShiftPalette
  86.     FOR c = 15 TO 1 STEP -1
  87.         OUT &H3C8, c
  88.         FOR t = 0 TO 2
  89.             rgb(c, t) = rgb(c - 1, t)
  90.             OUT &H3C9, rgb(c, t)
  91.         NEXT t
  92.     NEXT c
  93.     FOR t = 0 TO 2
  94.         IF (rgb(0, t) < 8) OR (rgb(0, t) > 60) THEN d(t) = -d(t)
  95.         rgb(0, t) = rgb(0, t) + d(t) * 2
  96.     NEXT t
  97.  
It works better if you plug it in.

Offline bplus

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

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Northern Lights
« Reply #4 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
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline Qbee

  • Newbie
  • Posts: 27
    • View Profile
Re: Northern Lights
« Reply #5 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.

Aurora-bplus 2020-01-06 21-46-40-33-optimized.gif
* Aurora-bplus 2020-01-06 21-46-40-33-optimized.gif (Filesize: 13.64 MB, Dimensions: 1024x768, Views: 294)
« Last Edit: January 06, 2020, 04:03:35 pm by Qbee »

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Northern Lights
« Reply #6 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
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline Qbee

  • Newbie
  • Posts: 27
    • View Profile
Re: Northern Lights
« Reply #7 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.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Northern Lights
« Reply #8 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...

Offline Richard Frost

  • Seasoned Forum Regular
  • Posts: 316
  • Needle nardle noo. - Peter Sellers
    • View Profile
Re: Northern Lights
« Reply #9 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.
It works better if you plug it in.

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Northern Lights
« Reply #10 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
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Northern Lights
« Reply #11 on: January 06, 2020, 06:07:01 pm »
Really cool Robert!