Gumowski-Mira dynamic system

[vspickelen]

From the vaults, now updated for FB:

Code:

'Subject : The 1980 Gumowski-Mira dynamic system.
'Sample the beam of elementary particles in a toy accelerator ring.
'[Space] set random parameters a & b, mouse picks point in phase space
'left/right [Arrows] change a, down/up [Arrows] change b
'numeric [+] zoom in, [-] zoom out, [*] toggle volume contraction
'[Del] weakly dissipative system, [/] toggle modulo reduction
'[Ins] clear screen, [s]ave screen, re[l]oad screen
'[Enter] freeze (press any key to continue), [Esc] quit.
'Author : vspickelen
'Date   : 04-09-2005
'Code   : FreeBasic 0.12b w/gfxlib
DEFDBL A-O, Q-Z
DEFINT P-P
DECLARE SUB map(ByRef x, ByRef w, ByRef y)
DIM SHARED a, b, pb, pm '              parameters, switches
CONST da = .0005, db = 1.01 '          deltas
CONST md = 2.718281828459   '          modulus
CONST tp = 6.28318530717959 '          2pi
CONST pcx = 380, pcy = 300 '           window center
SCREEN 19, 4, 1, 1
DIM c(15) AS INTEGER
c(0) = &H000008: c(4) = &H201400: c(8) = &H2E2200: c(12) = &H392D08
c(1) = &H140B00: c(5) = &H231700: c(9) = &H322600: c(13) = &H3B2F08
c(2) = &H190E00: c(6) = &H271B00: c(10)= &H352900: c(14) = &H3D310D
c(3) = &H1D1100: c(7) = &H2A1E00: c(11)= &H372B00: c(15) = &H3F3410
PALETTE USING c(0)
RANDOMIZE TIMER
GOSUB init: pn = 0
'
DO
   map x, w, y
   GOSUB pixl
   GOSUB mous
   GOSUB keys
LOOP UNTIL MULTIKEY(&h01)
END

pixl:
px = pcx + xf * x
py = pcy - yf * y
p = POINT(px, py) + 1
IF p < 16 THEN PSET (px, py), p
RETURN

mous:
GETMOUSE px, py, , p
IF p AND 3 THEN
   w = (px - pcx) / xf
   y = 0: map x, w, y: pf = -1 '       prick phase plane
   y = (pcy - py) / yf
END IF
RETURN

keys:
IF MULTIKEY(&h1C) THEN SLEEP '         [Enter]
IF MULTIKEY(&h39) THEN GOSUB init '    [Space]
IF MULTIKEY(&h52) THEN pf = -1: CLS '  [Ins]
IF pf THEN
   pf = 0
   IF MULTIKEY(&h4E) THEN
      xf *= 2: yf *= 2: ws /= 2 '      [+] zoom in
   END IF
   IF MULTIKEY(&h4A) THEN
      xf /= 2: yf /= 2: ws *= 2 '      [-] zoom out
   END IF
   IF MULTIKEY(&h4D) THEN fi += da '    [align=right] fi >
   IF MULTIKEY(&h4B) THEN fi -= da '     [align=left] fi <
   fi -= INT(fi / tp) * tp: a = COS(fi)
   IF MULTIKEY(&h48) THEN b = b ^ (1 / db) '[Up] b >
   IF MULTIKEY(&h50) THEN b = b ^ db '    [Down] b <
   IF MULTIKEY(&h53) THEN
      b = .00000001: pb = -1 '         [Del] weak damping
   END IF
   IF MULTIKEY(&h37) THEN pb = NOT pb '[*] toggle damping
   IF MULTIKEY(&h35) THEN pm = NOT pm '[/] toggle reduction
   'print window size & parameters
   LOCATE 1, 1: PRINT CHR$(237); CINT(ws) / 100; "  "
   PRINT CHR$(224); CINT(fi * 36000 / tp) / 100; "  "
   PRINT "b 0"; SPACE$(13)
   IF pb THEN LOCATE 3, 1: PRINT "b"; CSNG(b)
   IF MULTIKEY(&h1F) THEN
      pn += 1: s$ = TRIM$(STR$(pn))
      BSAVE "GM" + s$ + ".scn", 0, 480000 ' [s]ave screen
   END IF
   IF MULTIKEY(&h26) AND pn > 0 THEN
      s$ = TRIM$(STR$(pn))
      BLOAD "GM" + s$ + ".scn", 0 '         re[l]oad screen
   END IF
END IF
WHILE INKEY$ <> "": pf = -1: WEND
RETURN

init:
DO
   fi = RND * tp
   a = COS(fi): b = RND * .1 '        random parameters
   x = 0: w = 0: y = (RND - .5) * 40
   FOR p = 1 TO 16382 '               converge
      map x, w, y
   NEXT p
   u = x: t = w: v = y
   xf = 0: yf = 0: pf = 0
   FOR p = 1 TO 2048
      map x, w, y
      IF ABS(x) > xf THEN xf = ABS(x)
      IF ABS(y) > yf THEN yf = ABS(y)
      map u, t, v: map u, t, v
      dx = u - x: dy = v - y
      z = dx * dx + dy * dy
      IF z < .000002 THEN
         pf = -1: EXIT FOR '          skip periodic cycles
      END IF
   NEXT p
LOOP WHILE pf
CLS : pf = -1
ws = SQR(xf * xf + yf * yf) * 200 '   get window size
xf = pcx / xf: yf = .9 * pcy / yf '   set window
RETURN

SUB map(ByRef x, ByRef w, ByRef y)
   t = x: x = y + w
   IF pb THEN x += b * (1 - .05 * y * y) * y
   IF pm THEN x -= FIX(x / md) * md
   w = (a + 2 * (1 - a) * x / (1 + x * x)) * x
   y = w - t
   IF pm THEN y -= FIX(y / md) * md
END SUB

GM paper
http://www.scipress.org/journals/forma/p...020121.pdf
Be welcome to visit at
http://www.home.versatel.nl/vspickelen/M...Mandel.htm

[Adigun A. Polack]

To vspickelen:

Howdy now, and such a pleasure to meet you, too!

Just now, after I tried your thing out in FB v0.12 and ran it, I was blown away by the *amazing* graphical designs you conjured up there!! Needless to say, I was impressed!!! WAY TO GO!! !

Be seeing you again, and welcome to the QBasicNews.com forums! Just keep at your coding the way you are doing, vspickelen!!! =b



PRAISING YOU ON YOUR WONDERFUL WORK IN FB,


Adigun Azikiwe Polack
One of the Founders of “Aura Flow” ::: Continuing Developer of “Frantic Journey”
Current Developer of “Star Angelic Slugger” ::: Webmaster of the “AAP Official Projects Squad”
Original Creator of the “The New FreeBASIC 8-Bit Palette Machine”

[relsoft]

Hahahaha!! Nice. I was contemplating on doing that to. :*)

Where was the site? Can't seem to remember it.

[Rattrapmax6]

He he, cool, reminds me of fosils or something, some of 'em do.. :wink: