'=========================================================================
' The Mandelbrot Dazibao - August 2002 - http://mandelbrot.dazibao.free.fr
'=========================================================================

' Subroutines declaration
DECLARE SUB LoadFrames ()         ' Loads the IFS frames parameters
DECLARE SUB Fern ()               ' Parameters for a Fern
DECLARE SUB WebFern ()            ' Parameters for a Fern seen on the Web

DECLARE SUB Graph ()              ' Selects and launches the new graphics
DECLARE SUB ViewFrames ()         ' Plots the IFS Frames
DECLARE SUB ViewFractal ()        ' Plots the Fractal

DECLARE SUB Param ()              ' Displays the layout & the Parameters
DECLARE SUB Box (L, H, Ox, Oy, C) ' Draws a box
DECLARE SUB Cell (DirCell)        ' Parameter cell management

' Arrows & Keys Management Constants
CONST Up = 72, Down = 80, Lft = 75, Rght = 77
CONST Home = 71, PgUp = 73, PgDn = 81
CONST Spacebar = " "

' Display Constants
CONST LuRef = 400, LvRef = 400
CONST Offx = 10, Offy = 40
CONST NFig = 2

' Variables parameters declaration
DIM SHARED Par(4, 7) AS INTEGER   ' Array for the IFS Frames storage
DIM SHARED Mp AS INTEGER          ' Parameter cell Row
DIM SHARED Np AS INTEGER          ' Parameter cell Line
DIM SHARED Flag AS INTEGER        ' Frames/Fractal Toggle Flag
DIM SHARED nCase AS INTEGER       ' Number of IFS Frames for the fractal
DIM SHARED Figure AS INTEGER      ' Fractal Id number
DIM SHARED Modif AS INTEGER       ' Indicates parameters modification

' Esc key to quit program
KEY 15, CHR$(0) + CHR$(1)
ON KEY(15) GOSUB Finish
KEY(15) ON

'======================================================
CLS
SCREEN 12
CALL Graph

'======================================================
DO: LOOP WHILE INKEY$ = ""
DO
KeyVal$ = INKEY$
SELECT CASE KeyVal$

CASE CHR$(13)                     ' Enter key to edit parameter
LOCATE 12, 54
INPUT xxx
IF xxx > 400 THEN xxx = 400
IF xxx < 0 THEN xxx = 0
Par(Np, Mp + 1) = xxx
Modif = 1
CALL Graph

CASE CHR$(0) + CHR$(Up)           ' Arrows to move cell
CALL Cell(Up)
CASE CHR$(0) + CHR$(Down)
CALL Cell(Down)
CASE CHR$(0) + CHR$(Lft)
CALL Cell(Lft)
CASE CHR$(0) + CHR$(Rght)
CALL Cell(Rght)

CASE CHR$(0) + CHR$(PgDn)         ' Fractal selection
Modif = 0
Figure = Figure + 1
IF Figure = NFig + 1 THEN Figure = 1
CALL Graph
CASE CHR$(0) + CHR$(PgUp)
Modif = 0
Figure = Figure - 1
IF Figure = 0 THEN Figure = NFig
CALL Graph

CASE Spacebar                      ' Toggle Frame/Fractal
Flag = -Flag
CALL Graph

END SELECT
LOOP
SYSTEM

'======================================================
Finish:                            ' Quit Program
SYSTEM
RETURN

SUB Box (Lar, Hau, Offxr, Offyr, Rcol)
' Draws a Rectangle on the screen

LINE (Offxr, Offyr)-(Offxr + Lar + 1, Offyr + Hau + 1), Rcol, B

END SUB

SUB Cell (DirCell)
' Selection Cell management in a screen array

' Erase current cell
CALL Box(32, 12, 420 + (Mp - 1) * 36, 80 + (Np - 1) * 16, 0)

' Move the cell parameters
SELECT CASE DirCell

CASE Up
Np = Np - 1
IF Np = 0 THEN Np = 1

CASE Down
Np = Np + 1
IF Np = 5 THEN Np = 4

CASE Lft
Mp = Mp - 1
IF Mp = 0 THEN Mp = 1

CASE Rght
Mp = Mp + 1
IF Mp = 7 THEN Mp = 6

CASE ELSE

END SELECT
' Draw the new cell
CALL Box(32, 12, 420 + (Mp - 1) * 36, 80 + (Np - 1) * 16, 7)

END SUB

SUB Fern
'Parameters for a Fractal Fern

Par(1, 1) = 2
Par(2, 1) = 2
Par(3, 1) = 2
Par(4, 1) = 2

Par(1, 2) = 220
Par(1, 3) = 5
Par(1, 4) = 180
Par(1, 5) = 90
Par(1, 6) = 380
Par(1, 7) = 95

Par(2, 2) = 180
Par(2, 3) = 25
Par(2, 4) = 220
Par(2, 5) = 90
Par(2, 6) = 10
Par(2, 7) = 120

Par(3, 2) = 30
Par(3, 3) = 100
Par(3, 4) = 370
Par(3, 5) = 100
Par(3, 6) = 40
Par(3, 7) = 395

Par(4, 2) = 200
Par(4, 3) = 0
Par(4, 4) = 200
Par(4, 5) = 0
Par(4, 6) = 201
Par(4, 7) = 157

nCase = 4

END SUB

SUB Graph
' Plots the new graph : Fractal or IFS Frames

CLS
IF Modif = 0 THEN CALL LoadFrames

Mp = 1
Np = 1
CALL Param

IF Flag = 0 THEN Flag = 1

IF Flag = -1 THEN
CALL ViewFrames
ELSE
CALL ViewFractal
END IF

END SUB

SUB LoadFrames
' Loads the parameters for a given Fractal

IF Figure = 0 THEN Figure = 1

SELECT CASE Figure
CASE 1
CALL WebFern
CASE 2
CALL Fern
END SELECT

END SUB

SUB Param
' Display of the screen layout and of the Fractal parameters

LOCATE 4, 54
PRINT "X0  Y0   XU  YU   XV  YV"

FOR nf = 1 TO 4
LOCATE 5 + nf, 54
PRINT USING "###"; Par(nf, 2)
LOCATE 5 + nf, 58
PRINT USING "###"; Par(nf, 3)
LOCATE 5 + nf, 63
PRINT USING "###"; Par(nf, 4)
LOCATE 5 + nf, 67
PRINT USING "###"; Par(nf, 5)
LOCATE 5 + nf, 72
PRINT USING "###"; Par(nf, 6)
LOCATE 5 + nf, 76
PRINT USING "###"; Par(nf, 7)
NEXT nf

LOCATE 14, 54
PRINT "Esc to quit"
LOCATE 15, 54
PRINT "PgDn,PgDn : Change Fractal"
LOCATE 16, 54
PRINT "Arrows : Select parameter"
LOCATE 17, 54
PRINT "Enter : Change value"
LOCATE 18, 54
PRINT "SpaceBar : Frames/Fractal"

CALL Box(LuRef, LvRef, Offx, Offy, 4)
CALL Box(216, 110, 419, 40, 4)
CALL Box(216, 30, 419, 40, 4)
CALL Box(71, 110, 491, 40, 4)
CALL Box(216, 86, 419, 204, 4)

CALL Cell(Blank)

END SUB

SUB ViewFractal
' Plots the current Fractal

LOCATE 12, 54
PRINT "Work in Progress"

x = 200
y = 200
FOR i = 1 TO 50000
R = RND
IF R < 1 AND R > .93 THEN Cas = 1
IF R <= .93 AND R > .86 THEN Cas = 2
IF R <= .86 AND R > .01 THEN Cas = 3
IF R <= .01 THEN Cas = 4

Ncol = Par(Cas, 1)
x0 = Par(Cas, 2)
y0 = Par(Cas, 3)
xu = Par(Cas, 4)
yu = Par(Cas, 5)
xv = Par(Cas, 6)
yv = Par(Cas, 7)

Xn = x0 + ((xu - x0) * x + (xv - x0) * y) / LuRef
Yn = y0 + ((yu - y0) * x + (yv - y0) * y) / LvRef
x = Xn
y = Yn

PSET (x + Offx, LvRef + Offy - y), Ncol
NEXT i

LOCATE 12, 54
PRINT "                "

CALL Param

END SUB

SUB ViewFrames
' Plots the IFS frames for the current fractal

FOR nf = 1 TO 4
Ncol = nf
ax0 = Par(nf, 2)
ay0 = Par(nf, 3)
axu = Par(nf, 4)
ayu = Par(nf, 5)
axv = Par(nf, 6)
ayv = Par(nf, 7)

LINE (Offx + ax0, LvRef + Offy - ay0)-(Offx + axu, LvRef + Offy - ayu), Ncol
LINE (Offx + ax0, LvRef + Offy - ay0)-(Offx + axv, LvRef + Offy - ayv), Ncol
LINE (Offx + axv, LvRef + Offy - ayv)-(Offx + axv + axu - ax0, LvRef + Offy - (ayu + ayv - ay0)), Ncol, , 2
LINE (Offx + axu, LvRef + Offy - ayu)-(Offx + axv + axu - ax0, LvRef + Offy - (ayu + ayv - ay0)), Ncol, , 2

NEXT nf

END SUB

SUB WebFern
' Parameters for a fern seen on the Web

Par(1, 1) = 2
Par(2, 1) = 2
Par(3, 1) = 2
Par(4, 1) = 2

Par(1, 2) = 184
Par(1, 3) = 0
Par(1, 4) = 124
Par(1, 5) = 64
Par(1, 6) = 333
Par(1, 7) = 82

Par(2, 2) = 128
Par(2, 3) = 34
Par(2, 4) = 208
Par(2, 5) = 103
Par(2, 6) = 0
Par(2, 7) = 122

Par(3, 2) = 24
Par(3, 3) = 57
Par(3, 4) = 364
Par(3, 5) = 45
Par(3, 6) = 45
Par(3, 7) = 397

Par(4, 2) = 160
Par(4, 3) = 0
Par(4, 4) = 160
Par(4, 5) = 0
Par(4, 6) = 160
Par(4, 7) = 64

nCase = 4

END SUB