'Program DISPLAY.BAS makes sequence of 16 BMP frames
'Compile with QuickBASIC or VisualBASIC for DOS
'(c) 1996 by J. C. Sprott (sprott@juno.physics.wisc.edu)

DECLARE FUNCTION serialno$ (i%, j%)
DECLARE SUB setparams (x#, y#, z#)
DECLARE SUB advancexy (x#, y#, z#, n&)
DECLARE SUB display (x#, y#, z#, n&)
DECLARE SUB testsoln (x#, y#, z#, n&)
DECLARE SUB scn2bmp (filename$)
DECLARE FUNCTION mkhex$ (a$)

DEFDBL A-Z                                  'Use double precision
DIM a(6)                                    'Array of coefficients
DIM PAL&(255), R%(255), G%(255), B%(255)
nmax& = 160000                              'Maximum number of iterations
CLS
code$ = COMMAND$
IF code$ = "" THEN                          'Enter code
	PRINT "You must enter a 6-character case-sensitive code found from SEARCH.EXE"
	INPUT "Code$"; code$
END IF
RANDOMIZE TIMER                             'Reseed random numbers
SCREEN 13                                   'Assume VGA graphics
TWOPI = 6.283185307#
n& = 0
nc% = 254
RANB = RND: CB% = 1 + INT(3 * RND)  'Blue phase and period
RANG = RND: CG% = 1 + INT(3 * RND)  'Green phase and period
RANR = RND: CR% = 1 + INT(3 * RND)  'Red phase and period
BC% = INT(2 + nc% * RND)            'Choose random background color
FOR i% = 2 TO nc% + 1               'Redefine palette colors
	B%(i%) = INT(32 + 32 * SIN(CB% * TWOPI * (i% / nc% + RANB)))
	G%(i%) = INT(32 + 32 * SIN(CG% * TWOPI * (i% / nc% + RANG)))
	R%(i%) = INT(32 + 32 * SIN(CR% * TWOPI * (i% / nc% + RANR)))
	PAL&(i%) = 65536 * B%(i%) + 256 * G%(i%) + R%(i%)
	IF i% = BC% THEN                'Set background and shadow colors
		B%(0) = INT(B%(i%) / 2): G%(0) = INT(G%(i%) / 2): R%(0) = INT(R%(i%) / 2)
		B%(1) = INT(B%(i%) / 3): G%(1) = INT(G%(i%) / 3): R%(1) = INT(R%(i%) / 3)
		PAL&(0) = 65536 * B%(0) + 256 * G%(0) + R%(0)
		PAL&(1) = 65536 * B%(1) + 256 * G%(1) + R%(1)
	END IF
NEXT i%
CLS : PALETTE USING PAL&(0)
WHILE INKEY$ = ""                           'Loop until key is pressed
	IF n& = 0 THEN CALL setparams(x, y, z)
	CALL advancexy(x, y, z, n&)             'Advance the solution
	CALL display(x, y, z, n&)               'Display the results
	CALL testsoln(x, y, z, n&)              'Test the solution
WEND
END

SUB advancexy (x, y, z, n&)
	SHARED a(), TWOPI
	xnew = a(1) + a(2) * x + a(3) * x * x + a(4) * y + a(5) * z + a(6) * SIN(TWOPI * n& / 16)
	ynew = x
	znew = y
	x = xnew: y = ynew: z = znew
	n& = n& + 1
END SUB

SUB display (x, y, z, n&)
	SHARED code$, nmax&, nc%
	STATIC xmin, xmax, ymin, ymax, zmin, zmax, w%, h%, nthis%, xz, yz
	SELECT CASE n&
		CASE 1                                  'Initialize limits
			xmin = 1000: ymin = xmin: zmin = xmin
			xmax = -xmin: ymax = -ymin: zmax = -zmin
			pix% = 0
		CASE 2 TO 99                            'Skip these
		CASE 100 TO 999                         'Update limits
			IF x < xmin THEN xmin = x
			IF x > xmax THEN xmax = x
			IF y < ymin THEN ymin = y
			IF y > ymax THEN ymax = y
			IF z < zmin THEN zmin = z
			IF z > zmax THEN zmax = z
		CASE 1000                               'Clear the screen
			CLS
			xz = .05 * 320 / (zmax - zmin)
			yz = .05 * 200 / (zmax - zmin)
			IF CSNG(xmax) = CSNG(xmin) THEN xmax = xmin + 1
			IF CSNG(ymax) = CSNG(ymin) THEN ymax = ymin + 1
			dx = (xmax - xmin) / 10: xmin = xmin - dx: xmax = xmax + dx
			dy = (ymax - ymin) / 10: ymin = ymin - dy: ymax = ymax + dy
			w% = 320 / (xmax - xmin): h% = 200 / (ymin - ymax)
		CASE ELSE                               'Plot data
			IF n& MOD 16 <> nthis% THEN EXIT SUB
			xp% = w% * (x - xmin)
			yp% = h% * (y - ymax)
			zp% = 2 + INT(nc% + nc% * (z - zmin) / (zmax - zmin)) MOD nc%
			c% = POINT(xp%, yp%)
			IF zp% > c% THEN PSET (xp%, yp%), zp%   'Illuminate screen pixel
			xp% = xp% + xz * (z - zmin): yp% = yp% + yz * (z - zmin)
			IF POINT(xp%, yp%) = 0 THEN PSET (xp%, yp%), 1
			IF n& + 16 > nmax& THEN
				CALL scn2bmp(code$ + serialno$(nthis%, 2) + ".BMP")
				n& = 0
				nthis% = nthis% + 1
				IF nthis% > 15 THEN BEEP: END
			END IF
		END SELECT
END SUB

FUNCTION mkhex$ (a$)
	'Converts a sequence of space-delimited hexadecimal bytes to a string
	'For example, mkhex$("4A 4B 4C") evaluates to "JKL"
	bytes% = (LEN(a$) + 1) / 3
	c$ = ""
	FOR i% = 1 TO bytes%
		B$ = "&H" + MID$(a$, 3 * i% - 2, 3)
		c$ = c$ + CHR$(VAL(B$))
	NEXT i%
	mkhex$ = c$
END FUNCTION

SUB scn2bmp (filename$)
	'Captures the screen to a file filename$ in bitmaped (BMP) format
	'Palette correct in EGA and VGA color modes 13 (256 colors) only
	SHARED R%(), G%(), B%()
	x1% = 0: y1% = 0: x2% = 319: y2% = 199  'Corners of image
	sw% = 1 + x2% - x1%                     'Width of image in pixels
	sh% = 1 + y2% - y1%                     'Height of image in pixels
	sf& = sw% * CLNG(sh%)                   'Bytes in image
	f% = FREEFILE
	OPEN filename$ FOR OUTPUT AS f%
	PRINT #f%, mkhex$("42 4D");             'ASCII "BM"
	PRINT #f%, MKL$(sf& + 1078);            'Size of file in bytes
	PRINT #f%, mkhex$("00 00 00 00");       'Must be zero
	PRINT #f%, mkhex$("36 04 00 00 28 00 00 00");
	PRINT #f%, MKL$(sw%);                   'Screen width
	PRINT #f%, MKL$(sh%);                   'Screen height
	PRINT #f%, mkhex$("01 00 08 00 00 00 00 00");
	PRINT #f%, MKL$(sf&);                   'Size of image in bytes
	PRINT #f%, mkhex$("00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00");
	FOR i% = 0 TO 255
		PRINT #f%, CHR$(4 * B%(i%)); CHR$(4 * G%(i%)); CHR$(4 * R%(i%)); CHR$(0);
	NEXT i%
	FOR y% = y2% TO y1% STEP -1
		FOR x% = x1% TO x2%
			PRINT #f%, CHR$(POINT(x%, y%));
		NEXT x%
	NEXT y%
	CLOSE f%
END SUB

FUNCTION serialno$ (i%, j%)
	'Produces a serial number string of length j% corresponding to i%
	a$ = STR$(i%)
	a$ = LTRIM$(a$)
	a$ = STRING$(j%, "0") + a$
	serialno$ = RIGHT$(a$, j%)
END FUNCTION

SUB setparams (x, y, z)
	SHARED a(), code$
	x = 0: y = 0: z = 0
	FOR i% = 1 TO 6
		a(i%) = (ASC(MID$(code$, i%)) - 77) / 10#
	NEXT i%
END SUB

SUB testsoln (x, y, z, n&)
	SHARED nmax&
	IF n& = nmax& THEN n& = 0                            'Bailout value reached
	IF ABS(x) + ABS(y) + ABS(z) > 1000000# THEN n& = 0   'Solution is unbounded
END SUB