'===========================================================================
' Subject: 3D ATTRACTOR DEMO                  Date: Unknown Date (00:00)   
'  Author: Ian Remmler                        Code: QB, PDS                
'  Origin: 3D,ATTRACTOR,DEMO                Packet: EGAVGA.ABC
'===========================================================================
'Here's a 3D attractor demo that lets you rotate the attractor on
'the X, Y, and Z axes then view it. (like on FractInt) If you have
'a mouse you can use it to zoom in. I didn't spend time on putting
'in a keyboard equivalent, so if you don't have a mouse you can make
'a routine for the keyboard, or change the WINDOW statement manually.
'Have fun with it, and feel free to hack it to pieces.

DECLARE SUB Crsr (x!)
DECLARE SUB zoom ()
DECLARE FUNCTION MPos (Coord)
DECLARE FUNCTION MBttn ()

'$INCLUDE: 'qb.bi'
DIM SHARED Regs AS RegTypeX
DIM sine(359) AS SINGLE, cosine(359) AS SINGLE

CONST pi = 3.1415926535#

dist = 100 'This is the distance from the screen used in the
 'perspective formula.

AngleX = 0 '\
AngleY = 0 ' > angles of rotation
AngleZ = 0 '/

SCREEN 9
PRINT "Creating SIN/COS Tables..."
PRINT : PRINT "Press F1 any time to goto Main Menu."
PRINT "Press F2 any time to exit program."
PRINT : PRINT "If you have a mouse, you can use the LMB to"
PRINT "zoom in on an attractor,or the RMB to exit."
LOCATE 24, 1: PRINT "Strange Attractor Demo - By: Ian Remmler.";
twirl$ = "\-/" + CHR$(179)

FOR t = 0 TO 359 'create sine/cosine tables
LOCATE 1, 28: PRINT MID$(twirl$, t MOD 4 + 1, 1)
sine(t) = SIN(t * (pi / 180))
cosine(t) = COS(t * (pi / 180))
NEXT

KEY(1) ON            '\
KEY(2) ON            ' \ sets up event trapping on F1 & F2
ON KEY(1) GOSUB Main ' /
ON KEY(2) GOSUB Leave'/
GOSUB WhichOne

Lorenz: 'Converted from the FractInt documentation.
WINDOW (-32, -0)-(32, 35)
dt = .05
a = 3
b = 15
c = 1

Lstart:
x = 1
y = 1
z = 1

CLS
GOSUB Translate
PSET (xxx, yyy)
Crsr 1
DO
xx = x: yy = y: zz = z
x = xx + (-a * xx * dt) + (a * yy * dt)
y = yy + (b * xx * dt) - (yy * dt) - (zz * xx * dt)
z = zz + (-c * zz * dt) + (xx * yy * dt)
GOSUB Translate
Crsr 0: LINE -(xxx, yyy): Crsr 1
IF MBttn = 1 THEN zoom: GOTO Lstart
LOOP UNTIL MBttn = 2
Crsr 0
GOSUB Leave

Rossler: 'Also from FractInt docs.
WINDOW (-64, -35)-(64, 35)
dt = .05
a = .2
b = .2
c = 5.7

Rstart:
x = 1
y = 1
z = 1

CLS
GOSUB Translate
PSET (xxx, yyy)
Crsr 1
DO
xx = x: yy = y: zz = z
x = xx - yy * dt - zz * dt
y = yy + xx * dt + a * yy * dt
z = zz + b * dt + xx * zz * dt - c * zz * dt
GOSUB Translate
Crsr 0: LINE -(xxx, yyy): Crsr 1
IF MBttn = 1 THEN zoom: GOTO Rstart
LOOP UNTIL MBttn = 2
Crsr 0
GOSUB Leave

Mutant: 'Wrote this one all by myself! Pretty spiffy, huh?
WINDOW (-32, -17.5)-(32, 17.5)
dt = .02
a = 8
b = 10
c = 10

Mstart:
x = 1
y = 1
z = 1

CLS
GOSUB Translate
PSET (xxx, yyy)
Crsr 1
DO
xx = x: yy = y: zz = z
x = xx - (a * zz * dt) + (-a * yy * dt)
y = yy + (b * xx * dt) - (yy * dt) - (zz * xx * dt)
z = zz + (-c * zz * dt) - (xx * yy * dt)
GOSUB Translate
Crsr 0: LINE -(xxx, yyy): Crsr 1
IF MBttn = 1 THEN zoom: GOTO Mstart
LOOP UNTIL MBttn = 2
Crsr 0
GOSUB Leave

Translate: 'converts x,y,z coords. to x,y so they can be put on
 'the screen. We use the basic rotation formula on the
 'X axis, then Y, then Z.
za = z * sine(AngleX) - y * cosine(AngleX) '\ X rotation
ya = z * cosine(AngleX) + y * sine(AngleX) '/
za = za * sine(AngleY) - x * cosine(AngleY) '\ Y rotation
xa = za * cosine(AngleY) + x * sine(AngleY) '/
xa = ya * sine(AngleZ) - xa * cosine(AngleZ) '\ Z rotation
ya = ya * cosine(AngleZ) + xa * sine(AngleZ) '/
xxx = xa * (dist / (dist + za))
yyy = ya * (dist / (dist + za))
RETURN

Main:
KEY(1) ON
ON KEY(1) GOSUB Main
CLS : PRINT "Main Menu!"
PRINT "1. Select an Attractor."
PRINT "2. Change Parameters."
PRINT "3. Change Angles of Rotation."
PRINT
DO: q = VAL(INKEY$)
LOOP WHILE q = 0
ON q GOSUB WhichOne, Params, Angles
CLS
RETURN

WhichOne:

CLS : PRINT "Select an Attractor!"
PRINT : PRINT "1. Lorenz"
PRINT "2. Rossler"
PRINT "3. Mutant"
PRINT
DO: q = VAL(INKEY$)
LOOP WHILE q = 0
ON q GOSUB Lorenz, Rossler, Mutant

Params:
PRINT "Input New Parameters!"
PRINT
PRINT "A= "; a; " "; : INPUT a
PRINT "B= "; b; " "; : INPUT b
PRINT "C= "; c; " "; : INPUT c
PRINT "DT= "; dt; " "; : INPUT dt
CLS
RETURN

Angles:
PRINT "Change Angles of Rotation!"
PRINT
PRINT "X= "; AngleX; " "; : INPUT AngleX
PRINT "Y= "; AngleY; " "; : INPUT AngleY
PRINT "Z= "; AngleZ; " "; : INPUT AngleZ
PRINT "Perspective Distance= "; dist; " "; : INPUT dist
CLS
RETURN

Leave:
END

SUB Crsr (x) 'this sub turns the pointer on and off (Crsr 0=off)
SELECT CASE x                                     '(Crsr 1=on)
CASE 0
Regs.ax = 2
CASE 1
Regs.ax = 1
END SELECT
CALL INTERRUPTX(&H33, Regs, Regs)
END SUB

FUNCTION MBttn 'returns which buttons are currently down.
Regs.ax = 3
CALL INTERRUPTX(&H33, Regs, Regs)
MBttn = Regs.bx
END FUNCTION

FUNCTION MPos (Coord) 'returns the x,y coords. of the mouse
Regs.ax = 3
CALL INTERRUPTX(&H33, Regs, Regs)
SELECT CASE Coord
CASE 0
MPos = Regs.cx
CASE 1
MPos = Regs.dx
END SELECT
END FUNCTION

SUB zoom 'zooms in on the attractor using the mouse.
Crsr 0
PCOPY 0, 1
Crsr 1
x1 = PMAP(MPos(0), 2)
y1 = PMAP(MPos(1), 3)
DO
Crsr 0
PCOPY 1, 0
x2 = PMAP(MPos(0), 2)
y2 = PMAP(MPos(1), 3)
Crsr 1
LINE (x1, y1)-(x2, y2), , B
WHILE PMAP(MPos(0), 2) = x2 AND PMAP(MPos(1), 3) = y2: WEND
LOOP WHILE MBttn = 1
WINDOW (x1, y1)-(x2, y2)
Crsr 0
END SUB