Text Only | Text with Attachments

QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: fschickel on April 08, 2020, 07:19:04 pm

Title: Modernize graphics
Post by: fschickel on April 08, 2020, 07:19:04 pm
Hi all, long time lurker, first time poster.

Decades ago I read a book on generating chaotic attractors with a PC.  Beyond playing around with it I did not do much with it.  I found out recently that the author posted the book and program he used to generate the attractors on his page.  He used BASIC and C, developing the BASIC version step-by-step in the book.  I don't have much experience with the graphics capabilities in QB64 and was wondering how hard it would be to modernize the BASIC version to QB64 graphics.

The book and code are available here: http://sprott.physics.wisc.edu/sa.htm (http://sprott.physics.wisc.edu/sa.htm)
Title: Re: Modernize graphics
Post by: bplus on April 08, 2020, 08:01:23 pm
Welcome fschickel,

Here is a glimpse of Henon (from old files):
Code: QB64: [Select]
  1. CONST xmax = 800, ymax = 600
  2. SCREEN _NEWIMAGE(xmax, ymax, 32)
  3. a = -10.1: sc = 175: ox = 400: oy = 300
  5.     CLS
  6.     FOR x = -0.1 TO 0.8 STEP 0.05
  7.         FOR y = -0.1 TO 0.8 STEP 0.05
  8.             lx = x: ly = y
  9.             FOR n = 1 TO 40
  10.                 xx = lx * COS(a) - (ly - lx * lx) * SIN(a)
  11.                 ly = lx * SIN(a) + (ly - lx * lx) * COS(a)
  12.                 lx = xx
  13.                 IF ABS(lx + ly) > 3000 THEN n = 40 'end if
  14.                 PSET (ly * sc + ox, lx * sc + oy), _RGB32(n * 5, 255 - n * 5, 128 + n * 2)
  15.             NEXT
  16.         NEXT
  17.     NEXT
  18.     _DISPLAY
  19.     a = a + 0.005
  21.  
  22.  
Title: Re: Modernize graphics
Post by: bplus on April 08, 2020, 08:49:32 pm
Here is what I come up with in little search on Internet (and fiddling with numbers):
Code: QB64: [Select]
  1. _TITLE "Lorenz Attractor Test" 'b+ 2020-04-08
  2. ' https://www.algosome.com/articles/lorenz-attractor-programming-code.html
  3. CONST xmax = 800, ymax = 600
  4. SCREEN _NEWIMAGE(xmax, ymax, 32)
  5. DEFDBL A-Z
  6. a = 170: b = 280: c = 30
  7. x = .1: y = 0: z = 0
  9.     xt = x + t * (a * (y - x))
  10.     yt = y + t * (x * (b - z) - y)
  11.     zt = z + t * (x * y - c * z)
  12.     PSET (x + 400, y + 300)
  13.     x = xt
  14.     y = yt
  15.     z = zt
  16.     t = t + .0000001
  18.  
  19.  
Title: Re: Modernize graphics
Post by: bplus on April 08, 2020, 09:26:56 pm
Here is the Movie:

Code: QB64: [Select]
  1. _TITLE "Lorenz Attractor the Movie" 'b+ 2020-04-08
  2. ' https://www.algosome.com/articles/lorenz-attractor-programming-code.html
  3. CONST xmax = 800, ymax = 600
  4. SCREEN _NEWIMAGE(xmax, ymax, 32)
  5. DEFDBL A-Z
  6. a = 100: b = 300: c = 1
  7.  
  8. restart:
  10. x = .1: y = 0: z = 0
  11. WHILE t < .001
  12.     xt = x + t * (a * (y - x))
  13.     yt = y + t * (x * (b - z) - y)
  14.     zt = z + t * (x * y - c * z)
  15.     PSET (x + 400, y + 300) '   _RGB32(z MOD 600)
  16.     x = xt
  17.     y = yt
  18.     z = zt
  19.     t = t + .0000001
  21. PRINT "        a ="; a; "        b ="; b; "        c ="; c
  24. a = RND * 200: b = RND * 300 + a: c = RND * 30: t = 0
  25. GOTO restart
  26.  
  27.  
  28.  
Title: Re: Modernize graphics
Post by: bplus on April 08, 2020, 09:37:35 pm
The Director's Cut of the Movie:

Code: QB64: [Select]
  1. _TITLE "Lorenz Attractor the Movie" 'b+ 2020-04-08
  2. ' https://www.algosome.com/articles/lorenz-attractor-programming-code.html
  3. CONST xmax = 800, ymax = 600
  4. SCREEN _NEWIMAGE(xmax, ymax, 32)
  5. DEFDBL A-Z
  6. a = 100: b = 300: c = 1
  7. restart:
  9. PRINT "        a ="; a; "        b ="; b; "        c ="; c
  10. x = .1: y = 0: z = 0
  11. WHILE t < .001
  12.     xt = x + t * (a * (y - x))
  13.     yt = y + t * (x * (b - z) - y)
  14.     zt = z + t * (x * y - c * z)
  15.     PSET (x + 400, y + 300) '   _RGB32(z MOD 600)
  16.     x = xt
  17.     y = yt
  18.     z = zt
  19.     t = t + .0000001
  20.     _LIMIT 500
  22. a = RND * 200: b = RND * 300 + a: c = RND * 30: t = 0
  24. GOTO restart
  25.  
  26.  
  27.  
Title: Re: Modernize graphics
Post by: TerryRitchie on April 08, 2020, 09:37:59 pm
It looks like Bplus is taking care of you. Just wanted to say welcome to the forum!
Title: Re: Modernize graphics
Post by: bplus on April 08, 2020, 10:06:29 pm
Ha, looks like fschickel has taken care of me :)

I just found this at SmallBASIC library and translated it, "Oh! we can do different views because it's 3D."

Code: QB64: [Select]
  1. _TITLE "Strange Attractor" ' trans from SmallBASIC b+ 2020-04-08
  2. ' Plot of the "Strange Attractor"
  3. ' Define 3 differential equations
  4. ' Set initial conditions
  5.  
  6. CONST xmax = 1280, ymax = 740
  7. SCREEN _NEWIMAGE(xmax, ymax, 32)
  8. _DELAY .25
  10.  
  11. INPUT "initial x (.5) "; x
  12. INPUT "initial y (-.5) "; y
  13. INPUT "initial z (.3) "; z
  14. INPUT "final time (50) "; tf
  15. INPUT "number of intervals (100000) "; n
  16.  
  17. ' Begin numerical integration of the d.e.q.'s
  18. h = tf / n
  20. FOR q = 1 TO n
  21.     kxt1 = h * lxt(x, y)
  22.     kyt1 = h * lyt(x, y, z)
  23.     kzt1 = h * lzt(x, y, z)
  24.     kxt2 = h * lxt(x + .5 * kxt1, y + .5 * kyt1)
  25.     kyt2 = h * lyt(x + .5 * kxt1, y + .5 * kyt1, z + .5 * kzt1)
  26.     kzt2 = h * lzt(x + .5 * kxt1, y + .5 * kyt1, z + .5 * kzt1)
  27.     kxt3 = h * lxt(x + .5 * kxt2, y + .5 * kyt2)
  28.     kyt3 = h * lyt(x + .5 * kxt2, y + .5 * kyt2, z + .5 * kzt2)
  29.     kzt3 = h * lzt(x + .5 * kxt2, y + .5 * kyt2, z + .5 * kzt2)
  30.     kxt4 = h * lxt(x + .5 * kxt3, y + .5 * kyt3)
  31.     kyt4 = h * lyt(x + .5 * kxt3, y + .5 * kyt3, z + .5 * kzt3)
  32.     kzt4 = h * lzt(x + .5 * kxt3, y + .5 * kyt3, z + .5 * kzt3)
  33.     x = x + (kxt1 + 2 * kxt2 + 2 * kxt3 + kxt4) / 6
  34.     y = y + (kyt1 + 2 * kyt2 + 2 * kyt3 + kyt4) / 6
  35.     z = z + (kzt1 + 2 * kzt2 + 2 * kzt3 + kzt4) / 6
  36.     xp = 10 * x + 900: yp = 15 * y + 400: zp = 10 * z + 100
  37.     PSET (xp, yp), _RGB32(0, 0, 255): PSET (zp, yp), _RGB32(0, 100, 0)
  40. FUNCTION lxt (x, y)
  41.     lxt = 10 * (y - x)
  43. FUNCTION lyt (x, y, z)
  44.     lyt = 28 * x - y - x * z
  46. FUNCTION lzt (x, y, z)
  47.     lzt = x * y - 8 * z / 3
  49.  
  50.  

  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Title: Re: Modernize graphics
Post by: bplus on April 08, 2020, 10:37:39 pm
Split Screen (More than 2 X's better!)

Code: QB64: [Select]
  1. _TITLE "Lorenz Attractor Split Screen" 'b+ 2020-04-08
  2. ' https://www.algosome.com/articles/lorenz-attractor-programming-code.html
  3. CONST xmax = 1280, ymax = 640
  4. SCREEN _NEWIMAGE(xmax, ymax, 32)
  6. DEFDBL A-Z
  7. a = 100: b = 300: c = 1
  8. restart:
  10. PRINT "        a ="; a; "        b ="; b; "        c ="; c
  11. x = .1: y = 0: z = 0
  12. WHILE t < .001
  13.     xt = x + t * (a * (y - x))
  14.     yt = y + t * (x * (b - z) - y)
  15.     zt = z + t * (x * y - c * z)
  16.     IF y >= -320 AND y <= 320 THEN
  17.         IF x >= -320 AND x <= 320 THEN PSET (x + 320, y + 320)
  18.         IF z >= -320 AND z <= 640 THEN PSET (z + 640, y + 320)
  19.     END IF
  20.     x = xt
  21.     y = yt
  22.     z = zt
  23.     t = t + .0000001
  24.     _LIMIT 500
  26. a = RND * 200: b = RND * 300 + a: c = RND * 30: t = 0
  28. GOTO restart
  29.  
  30.  
Title: Re: Modernize graphics
Post by: bplus on April 08, 2020, 11:23:08 pm
Now in Living Color:

Code: QB64: [Select]
  1. _TITLE "Lorenz Attractor Colorized" 'b+ 2020-04-08
  2. ' https://www.algosome.com/articles/lorenz-attractor-programming-code.html
  3. CONST xmax = 1280, ymax = 640
  4. DEFDBL A-Z
  5. DIM SHARED cN, pR, pG, pB 'plasma
  6. SCREEN _NEWIMAGE(xmax, ymax, 32)
  9. a = 100: b = 300: c = 1
  10. restart:
  11. resetPlasma
  13. COLOR &HFFBBBBBB
  14. PRINT "        a ="; a; "        b ="; b; "        c ="; c
  15. x = .1: y = 0: z = 0
  16. WHILE t < .002
  17.     xt = x + t * (a * (y - x))
  18.     yt = y + t * (x * (b - z) - y)
  19.     zt = z + t * (x * y - c * z)
  20.     IF y >= -320 AND y <= 320 THEN
  21.         IF x >= -320 AND x <= 320 THEN PSET (x + 320, y + 320), plasma
  22.         IF z >= -320 AND z <= 640 THEN PSET (z + 640, y + 320), plasma
  23.     END IF
  24.     x = xt
  25.     y = yt
  26.     z = zt
  27.     t = t + .0000001
  28.     cN = cN + .005
  29.     _LIMIT 500
  31. a = RND * 200: b = RND * 300 + a: c = RND * 30: t = 0
  32. IF c > a / 3 THEN c = a / 3 * RND
  34. GOTO restart
  35.  
  36. FUNCTION plasma~&
  37.     plasma~& = _RGB32(127 + 127 * SIN(pR * cN), 127 + 127 * SIN(pG * cN), 127 + 127 * SIN(pB * cN))
  39.  
  40. SUB resetPlasma ()
  41.     pR = RND ^ 2: pG = RND ^ 2: pB = RND ^ 2: cN = 0
  43.  
  44.  

  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Title: Re: Modernize graphics
Post by: bplus on April 08, 2020, 11:50:49 pm
And FX:

Code: QB64: [Select]
  1. _TITLE "Lorenz Attractor FX" 'b+ 2020-04-08
  2. ' https://www.algosome.com/articles/lorenz-attractor-programming-code.html
  3. CONST xmax = 1280, ymax = 640
  4. DEFDBL A-Z
  5. DIM SHARED cN, pR, pG, pB 'plasma
  6. SCREEN _NEWIMAGE(xmax, ymax, 32)
  9. a = 100: b = 300: c = 1
  10. restart:
  11. resetPlasma
  13. COLOR &HFFBBBBBB
  14. PRINT "        a ="; a; "        b ="; b; "        c ="; c
  15. x = .1: y = 0: z = 0
  16. WHILE t < .002
  17.     LINE (0, 0)-(xmax, ymax), _RGBA32(0, 0, 0, 2), BF
  18.     xt = x + t * (a * (y - x))
  19.     yt = y + t * (x * (b - z) - y)
  20.     zt = z + t * (x * y - c * z)
  21.     IF y >= -320 AND y <= 320 THEN
  22.         IF x >= -320 AND x <= 320 THEN PSET (x + 320, y + 320), plasma
  23.         IF z >= -320 AND z <= 640 THEN PSET (z + 640, y + 320), plasma
  24.     END IF
  25.     x = xt
  26.     y = yt
  27.     z = zt
  28.     t = t + .0000002
  29.     cN = cN + .005
  30.     _LIMIT 500
  32. a = RND * 200: b = RND * 300 + a: c = RND * 30: t = 0
  33. IF c > a / 3 THEN c = a / 3 * RND
  35. GOTO restart
  36.  
  37. FUNCTION plasma~&
  38.     plasma~& = _RGB32(191 + 64 * SIN(pR * cN), 191 + 64 * SIN(pG * cN), 191 + 64 * SIN(pB * cN))
  40.  
  41. SUB resetPlasma ()
  42.     pR = RND ^ 2: pG = RND ^ 2: pB = RND ^ 2: cN = 0
  44.  
  45.  
Title: Re: Modernize graphics
Post by: Ashish on April 09, 2020, 05:30:57 am
Some nice geometric patterns. :)
Title: Re: Modernize graphics
Post by: Richard Frost on April 09, 2020, 02:56:47 pm
Updated my old generator.  The _DELAY is to allow
squirrels to take over the planet.

Code: QB64: [Select]
  1. _TITLE "Henon Plots"
  2.  
  3. SCREEN _NEWIMAGE(800, 600, 32)
  4. mm# = 99999999999#
  6. FOR i = 1 TO 3
  7.     READ a#, xb#, xe#, yb#, ye#
  8.     r# = _D2R(a#): si# = SIN(r#): co# = COS(r#)
  9.     CLS: WINDOW (xb#, yb#)-(xe#, ye#)
  10.     FOR z# = xb# TO xe# \ 2 STEP (xe# - xb#) / 500
  11.         xo# = z#: yo# = z#
  12.         c& = _RGB32(RND * 255, RND * 255, RND * 255)
  13.         FOR n = 0 TO 2000
  14.             IF (ABS(xo#) > mm#) OR (ABS(yo#) > mm#) THEN EXIT FOR
  15.             tt# = yo# - xo# * xo#
  16.             xn# = xo# * co# - tt# * si#
  17.             yn# = xo# * si# + tt# * co#
  18.             PSET (xn#, yn#), c&
  19.             xo# = xn#: yo# = yn#
  20.         NEXT n
  21.         _DELAY .01
  22.     NEXT z#
  23.     SLEEP
  26.  
  27. DATA 90.3,-1.00,1.30,-1.00,1.00
  28. DATA 74,-0.80,1.30,-0.90,1.00
  29. DATA 71,-0.70,1.10,-0.80,0.80
  30.  
  31.  
Title: Re: Modernize graphics
Post by: bplus on April 09, 2020, 03:06:42 pm
Ah, that reminds me of old girlfriend Mira:

Code: QB64: [Select]
  1. 'Mira.bas for QB64 Fork (B+=MGA) 2017-05-01 from:
  2. 'Mira.bas for SmallBASIC 0.12.8 [B+=MGA] update 2017-02-20
  3.  
  4. ''update  Mira fractals from SmallBASIC
  5. '' Martin Latter
  6. '' Converted to SB from my old 1992 version in Archimedes BASIC
  7. '' - SB and modern computers thankfully plot a bit faster.
  8.  
  9. 'In most Mira all the interesting stuff happens immediately.
  10.  
  11. 'This code will stay with one display until you press a key
  12.  
  14.  
  15. CONST xmax = 1200, ymax = 700
  16. CONST xc = xmax / 2
  17. CONST yc = ymax / 2
  18. CONST dots = 10000 'for one round on Mira
  19.  
  20. SCREEN _NEWIMAGE(xmax, ymax, 32)
  21. _TITLE "Mira fractal classic translated to QB64 Fork  by bplus"
  22.  
  23. DIM ca(INT(dots / 100)) AS _UNSIGNED LONG 'for color array
  24. DIM a, b, c, x, y, z, j AS DOUBLE 'fractal calcs
  25. DIM xp, yp, red, green, blue AS INTEGER 'screen x, y and color r, g, b
  26.  
  28.     'set round
  29.     a = RND
  30.     b = RND * .008 + .993 'originally held const .9998
  31.     c = 2 - 2 * a
  32.     x = 0
  33.     j = 0
  34.     y = RND * 12 + .1
  35.  
  36.     'set palette (originally only 6 colors)
  37.     FOR pc = 0 TO INT(dots / 100)
  38.         red = INT(RND * 2) * (RND * 195 + 60)
  39.         green = INT(RND * 2) * (RND * 195 + 60)
  40.         blue = INT(RND * 2) * (RND * 195 + 60)
  41.         ca(pc) = _RGB(red, green, blue)
  42.     NEXT
  43.  
  44.     'the outer loop here waits for keypress to move out to new mira
  45.     COLOR _RGB(0, 255, 255)
  46.     PRINT "Start: a = "; a; "   b = "; b; "  Use the spacebar to toggle next random screen scene..."
  47.     WHILE _KEYHIT <> 32
  48.         _LIMIT 60
  49.         FOR i = 0 TO dots
  50.             z = x
  51.             x = b * y + j
  52.             j = a * x + c * (x ^ 2) / (1 + x ^ 2)
  53.             y = j - z
  54.             xp = (x * 20) + xc
  55.             yp = (y * 20) + yc
  56.             COLOR ca(INT(i / 100))
  57.             PSET (xp, yp)
  58.         NEXT
  59.         _DISPLAY
  60.     WEND
  61.     CLS
  63.  
  64.  
Title: Re: Modernize graphics
Post by: bplus on April 09, 2020, 03:16:51 pm
Found this guy hanging out with Mira, I am foggy why this was called a cloud:

Code: QB64: [Select]
  1. _TITLE "orbit cloud fractal.bas by bplus 2017-10-15"
  2. '
  3. ''' cloud.bas
  4. '' From "Fractals" by Hans Lauwerier
  5. '' Shows Orbits of a dynamical system
  6. '' by Tim Corcoran 2001
  7. '' modified by ML 4/1/07
  8.  
  9. CONST xmax = 800
  10. CONST ymax = 600
  11.  
  12. SCREEN _NEWIMAGE(xmax, ymax, 32)
  13. _DELAY .5 'sorry, my system needs .5 delay for _MIDDLE, yours may NOT
  14. _SCREENMOVE _MIDDLE ' not working with 32 in line above
  15.  
  16. xoffs = xmax / 2
  17. yoffs = ymax / 2
  19.     CLS
  20.     a = 3.5 'orig 3.5
  21.     b = -3 'orig -3
  22.     x = 3.14 'orig 3.21
  23.     y = 6.85 'orig 6.54
  24.     IF x > 1 THEN
  25.         w = a * x + b * (x - 1)
  26.     ELSEIF x < -1 THEN
  27.         w = a * x + b * (x + 1)
  28.     ELSE
  29.         w = a * x
  30.     END IF
  31.     plasmaR = RND ^ 2: plasmaG = RND ^ 2: plasmaB = RND ^ 2: plasmaN = 0
  32.     FOR n = 0 TO 20000
  33.         plasmaN = plasmaN + .05
  34.         COLOR _RGB(127 + 127 * SIN(plasmaR * plasmaN), 127 + 127 * SIN(plasmaG * plasmaN), 127 + 127 * SIN(plasmaB * plasmaN))
  35.  
  36.         PSET ((x * 4) + xoffs, (y * 4) + yoffs)
  37.         z = x: x = y + w
  38.         IF x > 1 THEN
  39.             w = a * x + b * (x - 1)
  40.         ELSEIF x < -1 THEN
  41.             w = a * x + b * (x + 1)
  42.         ELSE
  43.             w = a * x
  44.         END IF
  45.         y = w - z
  46.     NEXT
  47.     _LIMIT 1
  49.  

Maybe a Cubic Cloud?
Title: Re: Modernize graphics
Post by: bplus on April 09, 2020, 04:41:52 pm
Here is old favorite:

Code: QB64: [Select]
  1. _TITLE "Glitter Hopalong, any key quits" 'trans from SmallBASIC 2020-04-09
  2. 'Glitter hopalong.bas SmallBASIC 2015-05-04 modified for Bpf, B+
  3. ' color changes for the night shift
  4.  
  5. CONST xmax = 1200, ymax = 700
  6. SCREEN _NEWIMAGE(xmax, ymax, 32)
  7. _DELAY .25
  9.  
  10. xoffs = xmax * 5 / 12
  11. yoffs = ymax * 5 / 12
  13.     CLS
  14.     j = RND * 100
  15.     k = RND * 100
  16.     x = 0: y = 0: r = 0: n = 0
  17.     FOR i = 1 TO 10000000
  18.         r = RND * 4000
  19.         IF r > 3997 THEN COLOR qb(INT(RND * 15) + 1)
  20.         xx = y - SGN(x) * SQR(ABS(k * x - 1))
  21.         y = j - x
  22.         x = xx
  23.         xp = x * 3 + xoffs
  24.         yp = y * 3 + yoffs
  25.         CIRCLE (xp, yp), 1
  26.     NEXT i
  27.     _DELAY 1
  29.  
  31.     SELECT CASE n
  32.         CASE 0: qb~& = &HFF000000
  33.         CASE 1: qb~& = &HFF000088
  34.         CASE 2: qb~& = &HFF008800
  35.         CASE 3: qb~& = &HFF008888
  36.         CASE 4: qb~& = &HFF880000
  37.         CASE 5: qb~& = &HFF880088
  38.         CASE 6: qb~& = &HFF888800
  39.         CASE 7: qb~& = &HFFCCCCCC
  40.         CASE 8: qb~& = &HFF888888
  41.         CASE 9: qb~& = &HFF0000FF
  42.         CASE 10: qb~& = &HFF00FF00
  43.         CASE 11: qb~& = &HFF00FFFF
  44.         CASE 12: qb~& = &HFFFF0000
  45.         CASE 13: qb~& = &HFFFF00FF
  46.         CASE 14: qb~& = &HFFFFFF00
  47.         CASE 15: qb~& = &HFFFFFFFF
  48.     END SELECT
  50.  
  51.  
Title: Re: Modernize graphics
Post by: Richard Frost on April 10, 2020, 05:19:37 pm
VERY pretty stuff, Bplus.  It's unusual for me to see something new.

What planet are you from?  Do not shoot.  I offer cheese & crackers.

Title: Re: Modernize graphics
Post by: bplus on April 10, 2020, 06:22:30 pm
Thanks Richard Frost, some things are so old, they become new again. That should work well for QB64. :)
Text Only | Text with Attachments