'Hoppy's Teressal mandelbrot program.
'*** MUST RUN QBASIC /AH ***
'it uses a big array (>64k is a big array......)
'*** if not enough memory then reduce size
'Yes, mem management in qbasic is dire!

DECLARE SUB jobbyb (x1%, y1%, x2%, y2%)
DECLARE SUB jobbya (x1%, y1%, x2%, y2%)
'$DYNAMIC  :'for big array you need this for some stupid reason

SCREEN 13

DIM SHARED s%(319, 199), r, p, q, xs, ys, ref%, sym%
DIM SHARED real, imag, xmin, xmax, ymin, ymax, iter%

xmin = -2.5     'fractal coords
xmax = 1.5
ymin = -1.5
ymax = 1.5
iter% = 150
xs = (xmax - xmin) / 319
ys = (ymax - ymin) / 199

xaxis% = -ymin / ys
IF xaxis% > 0 AND xaxis% < 199 THEN sym% = 1 ELSE xaxis% = 199: ' there is some symmetry!
IF xaxis% < 100 THEN bottom% = 1
ref% = 2 * xaxis% + 1: 'symmetry detection
jobbya 0, 0, 319, xaxis%:  'call the recursive function
IF bottom% THEN sym% = 0: jobbya 0, 1 + 2 * xaxis%, 319, 199: 'call recursive function if symmetry needed
SLEEP

REM $STATIC
SUB jobbya (x1%, y1%, x2%, y2%)
IF x2% - x1% > 1 AND y2% - y1% > 1 THEN GOSUB echeck ELSE GOTO fillit
IF plop% = 1 THEN EXIT SUB
xm% = (x1% + x2%) \ 2
ym% = (y1% + y2%) \ 2
jobbyb x1%, y1%, xm%, y2%
jobbyb xm%, y1%, x2%, y2%
EXIT SUB

fillit:
FOR x% = x1% TO x2%
FOR y% = y1% TO y2%
GOSUB mand
PSET (x%, y%), it%
IF sym% = 1 THEN PSET (x%, ref% - y%), it%
NEXT y%
NEXT x%
EXIT SUB

echeck:
x% = x1%: y% = y1%: GOSUB mand: theone% = it%

FOR x% = x1% TO x2%
y% = y1%: GOSUB mand: IF it% <> theone% THEN RETURN
y% = y2%: GOSUB mand: IF it% <> theone% THEN RETURN
NEXT x%

FOR y% = y1% TO y2%
x% = x1%: GOSUB mand: IF it% <> theone% THEN RETURN
x% = x2%: GOSUB mand: IF it% <> theone% THEN RETURN
NEXT y%

LINE (x1%, y1%)-(x2%, y2%), theone%, BF
IF sym% = 1 THEN LINE (x1%, ref% - y1%)-(x2%, ref% - y2%), theone%, BF
plop% = 1
RETURN




mand:
IF s%(x%, y%) THEN it% = s%(x%, y%): RETURN
real = xs * x% + xmin
imag = ys * y% + ymin
p = 0: q = 0
FOR it% = 1 TO iter%
r = p * p - q * q + real
q = 2 * p * q + imag
IF r * r + q * q > 4 THEN EXIT FOR
p = r
NEXT it%
s%(x%, y%) = it%
RETURN

END SUB

SUB jobbyb (x1%, y1%, x2%, y2%)

IF x2% - x1% > 1 AND y2% - y1% > 1 THEN GOSUB echeckb ELSE GOTO fillitb
IF plop% = 1 THEN EXIT SUB
xm% = (x1% + x2%) \ 2
ym% = (y1% + y2%) \ 2
jobbya x1%, y1%, x2%, ym%
jobbya x1%, ym%, x2%, y2%
EXIT SUB

fillitb:
FOR x% = x1% TO x2%
FOR y% = y1% TO y2%
GOSUB mandb
PSET (x%, y%), it%
IF sym% = 1 THEN PSET (x%, ref% - y%), it%
NEXT y%
NEXT x%
EXIT SUB

echeckb:
x% = x1%: y% = y1%: GOSUB mandb: theone% = it%

FOR x% = x1% TO x2%
y% = y1%: GOSUB mandb: IF it% <> theone% THEN RETURN
y% = y2%: GOSUB mandb: IF it% <> theone% THEN RETURN
NEXT x%

FOR y% = y1% TO y2%
x% = x1%: GOSUB mandb: IF it% <> theone% THEN RETURN
x% = x2%: GOSUB mandb: IF it% <> theone% THEN RETURN
NEXT y%

LINE (x1%, y1%)-(x2%, y2%), theone%, BF
IF sym% = 1 THEN LINE (x1%, ref% - y1%)-(x2%, ref% - y2%), theone%, BF
plop% = 1
RETURN




mandb:
IF s%(x%, y%) THEN it% = s%(x%, y%): RETURN
real = xs * x% + xmin
imag = ys * y% + ymin
p = 0: q = 0
FOR it% = 1 TO iter%
r = p * p - q * q + real
q = 2 * p * q + imag
IF r * r + q * q > 4 THEN EXIT FOR
p = r
NEXT it%
s%(x%, y%) = it%
RETURN

END SUB