DECLARE FUNCTION irand! (i!)
DECLARE SUB drawrandomchange ()
DECLARE SUB reduce ()
DECLARE SUB amplify ()
DECLARE SUB extend ()
DECLARE SUB compress ()
DECLARE SUB mirror ()
DECLARE SUB negate ()
DECLARE SUB drawrandom ()
DECLARE SUB mainmenu ()
DECLARE SUB deffun ()
DECLARE SUB drawpolygon ()
DECLARE SUB drawsegment (niters!, ax!, ay!, bx!, by!)
DECLARE SUB exitprogram ()

DIM SHARED nfun, fun
nfun = 40
fun = 1
DIM SHARED fdesc(nfun) AS STRING

DIM SHARED Pi, xmax, ymax, xmid, ymid, niters, nsides, zoom
DIM SHARED colscheme, ncolscheme, ncolors, constcolor
DIM SHARED boxscheme, nboxscheme
DIM SHARED alliters
DIM SHARED npoints
DIM SHARED px(20), py(20)
Pi = ATN(1) * 4
xmax = 480
ymax = 480
xmid = xmax / 2
ymid = ymax / 2
niters = 1
nsides = 1
zoom = .5
colscheme = 1
ncolscheme = 6
ncolors = 15
constcolor = ncolors
nboxscheme = 3
boxscheme = 1
alliters = -1

SCREEN 12
RANDOMIZE TIMER
CALL deffun

DO
        CALL mainmenu
LOOP

SUB amplify
        FOR i = 2 TO npoints - 1
                py(i) = py(i) * 2
        NEXT i
END SUB

SUB compress
        FOR i = 2 TO npoints - 1
                IF px(i) <> 0 AND px(i) <> 1 THEN px(i) = (px(i) + .5) / 2
        NEXT i
END SUB

SUB deffun

fdesc(1) = "tooth"
fdesc(2) = "tooth"
fdesc(3) = "tooth"
fdesc(4) = "tooth"
fdesc(5) = "twotooth"
fdesc(6) = "twotooth"
fdesc(7) = "triangle"
fdesc(8) = "triangles"
fdesc(9) = "square"
fdesc(10) = "square"
fdesc(11) = "twist"
fdesc(12) = "square"
fdesc(13) = "squares"
fdesc(14) = "boxes"
fdesc(15) = "twist"
fdesc(16) = "diamond"
fdesc(17) = "diamond"
fdesc(18) = "diamond"
fdesc(19) = "zigzag"
fdesc(20) = "zigzag"
fdesc(21) = "zigzag"
fdesc(22) = "zigzag"
fdesc(23) = "zigzag"
fdesc(24) = "zigzag"
fdesc(25) = "zigzag"
fdesc(26) = "zigzag"
fdesc(27) = "line"
fdesc(28) = "line"
fdesc(29) = "half hexagon"
fdesc(30) = "hexagon"
fdesc(31) = "weaving"
fdesc(32) = "line"
fdesc(33) = "T"
fdesc(34) = "cross"
fdesc(35) = "pentagon"
fdesc(36) = "star"
fdesc(37) = "notch"
fdesc(38) = "wings"
fdesc(39) = "zigzag"
fdesc(40) = "twotooth"

px(1) = 0
py(1) = 0

SELECT CASE fun

CASE 1 'tooth
npoints = 5
px(2) = 1 / 3
py(2) = 0
px(3) = 1 / 2
py(3) = SQR(3) / 6
px(4) = 2 / 3
py(4) = 0

CASE 2 'tooth
npoints = 3
px(2) = .5
py(2) = SQR(3) / 3

CASE 3 'tooth
npoints = 4
px(2) = .5
py(2) = .5
px(3) = .5
py(3) = 0

CASE 4 'tooth
npoints = 5
px(2) = .25
py(2) = 0
px(3) = .25
py(3) = .25
px(4) = .5
py(4) = 0

CASE 5 'twotooth
npoints = 5
px(2) = .25
py(2) = .25
px(3) = .5
py(3) = 0
px(4) = .75
py(4) = .25

CASE 6 'twotooth
npoints = 7
px(2) = .25
py(2) = 0
px(3) = .25
py(3) = .25
px(4) = .5
py(4) = 0
px(5) = .75
py(5) = .25
px(6) = .75
py(6) = 0

CASE 7 'triangle
npoints = 6
px(2) = .5
py(2) = 0
px(3) = .25
py(3) = SQR(3) / 4
px(4) = .75
py(4) = SQR(3) / 4
px(5) = .5
py(5) = 0

CASE 8 'triangles
npoints = 9
px(2) = .5
py(2) = 0
px(3) = .25
py(3) = SQR(3) / 4
px(4) = .75
py(4) = SQR(3) / 4
px(5) = .5
py(5) = 0
px(6) = .25
py(6) = -SQR(3) / 4
px(7) = .75
py(7) = -SQR(3) / 4
px(8) = .5
py(8) = 0

CASE 9 'square
npoints = 6
px(2) = 1 / 3
py(2) = 0
px(3) = 1 / 3
py(3) = 1 / 3
px(4) = 2 / 3
py(4) = 1 / 3
px(5) = 2 / 3
py(5) = 0

CASE 10 'square
npoints = 4
px(2) = 0
py(2) = .5
px(3) = 1
py(3) = .5

CASE 11 'twist
npoints = 9
px(2) = 1 / 4
py(2) = 0
px(3) = 1 / 4
py(3) = 1 / 4
px(4) = 1 / 2
py(4) = 1 / 4
px(5) = 1 / 2
py(5) = 0
px(6) = 1 / 2
py(6) = -1 / 4
px(7) = 3 / 4
py(7) = -1 / 4
px(8) = 3 / 4
py(8) = 0

CASE 12 'square
npoints = 8
px(2) = 1 / 3
py(2) = 0
px(3) = 1 / 3
py(3) = 1 / 3
px(4) = 2 / 3
py(4) = 1 / 3
px(5) = 2 / 3
py(5) = 0
px(6) = 1 / 3
py(6) = 0
px(7) = 2 / 3
py(7) = 0

CASE 13 'squares
npoints = 10
px(2) = 1 / 3
py(2) = 0
px(3) = 1 / 3
py(3) = 1 / 3
px(4) = 2 / 3
py(4) = 1 / 3
px(5) = 2 / 3
py(5) = 0
px(6) = 1 / 3
py(6) = 0
px(7) = 1 / 3
py(7) = -1 / 3
px(8) = 2 / 3
py(8) = -1 / 3
px(9) = 2 / 3
py(9) = 0

CASE 14 'boxes
npoints = 8
px(2) = 0
py(2) = .5
px(3) = 1
py(3) = .5
px(4) = 1
py(4) = 0
px(5) = 1
py(5) = -.5
px(6) = 0
py(6) = -.5
px(7) = 0
py(7) = 0

CASE 15 'twist
npoints = 8
px(2) = 0
py(2) = .25
px(3) = .75
py(3) = .25
px(4) = .75
py(4) = 0
px(5) = .25
py(5) = 0
px(6) = .25
py(6) = -.25
px(7) = 1
py(7) = -.25

CASE 16 'diamond
npoints = 7
px(2) = .5
py(2) = 0
px(3) = .25
py(3) = .25
px(4) = .5
py(4) = .5
px(5) = .75
py(5) = .25
px(6) = .5
py(6) = 0

CASE 17 'diamond
npoints = 6
px(2) = 1
py(2) = 0
px(3) = .5
py(3) = SQR(3) / 6
px(4) = 0
py(4) = 0
px(5) = .5
py(5) = -SQR(3) / 6

CASE 18 'diamond
npoints = 8
px(2) = 1 / 3
py(2) = 0
px(3) = .5
py(3) = SQR(3) / 6
px(4) = 2 / 3
py(4) = 0
px(5) = .5
py(5) = -SQR(3) / 6
px(6) = 1 / 3
py(6) = 0
px(7) = 2 / 3
py(7) = 0

CASE 19 'zigzag
npoints = 4
px(2) = .25
py(2) = .25
px(3) = .75
py(3) = -.25

CASE 20 'zigzag
npoints = 4
px(2) = .5
py(2) = .5
px(3) = .5
py(3) = -.5

CASE 21 'zigzag
npoints = 4
px(2) = 1 / 3
py(2) = 1 / 3
px(3) = 2 / 3
py(3) = -1 / 3

CASE 22 'zigzag
npoints = 4
px(2) = 0
py(2) = SQR(3) / 6
px(3) = 1
py(3) = -SQR(3) / 6

CASE 23 'zigzag
npoints = 4
px(2) = 2 / 3
py(2) = SQR(3) / 6
px(3) = 1 / 3
py(3) = -SQR(3) / 6

CASE 24 'zigzag
npoints = 6
px(2) = .25
py(2) = 0
px(3) = .25
py(3) = .25
px(4) = .75
py(4) = -.25
px(5) = .75
py(5) = 0

CASE 25 'zigzag
npoints = 6
px(2) = 1 / 3
py(2) = 0
px(3) = .5
py(3) = .5
px(4) = .5
py(4) = -.5
px(5) = 2 / 3
py(5) = 0

CASE 26 'zigzag
npoints = 5
px(2) = .25
py(2) = .25
px(3) = .5
py(3) = -.25
px(4) = .75
py(4) = .25

CASE 27 'lines
npoints = 7
px(2) = .5
py(2) = 0
px(3) = .5
py(3) = .5
px(4) = .5
py(4) = 0
px(5) = .5
py(5) = -.5
px(6) = .5
py(6) = 0

CASE 28 'lines
npoints = 8
px(2) = .5
py(2) = 0
px(3) = .5
py(3) = .5
px(4) = .25
py(4) = .5
px(5) = .75
py(5) = .5
px(6) = .5
py(6) = .5
px(7) = .5
py(7) = 0

CASE 29 'half hexagon
npoints = 4
px(2) = .25
py(2) = SQR(3) / 4
px(3) = .75
py(3) = SQR(3) / 4

CASE 30 'hexagon
npoints = 9
px(2) = .25
py(2) = SQR(3) / 4
px(3) = .75
py(3) = SQR(3) / 4
px(4) = 1
py(4) = 0
px(5) = .75
py(5) = -SQR(3) / 4
px(6) = .25
py(6) = -SQR(3) / 4
px(7) = 0
py(7) = 0
px(8) = .5
py(8) = 0

CASE 31 'weaving
npoints = 6
px(2) = 1
py(2) = .5
px(3) = 1
py(3) = -.5
px(4) = 0
py(4) = .5
px(5) = 0
py(5) = -.5

CASE 32 'line
npoints = 5
px(2) = .5
py(2) = 0
px(3) = .5
py(3) = .5
px(4) = .5
py(4) = 0

CASE 33 'T
npoints = 10
px(2) = .4
py(2) = 0
px(3) = .4
py(3) = .2
px(4) = .2
py(4) = .2
px(5) = .2
py(5) = .4
px(6) = .8
py(6) = .4
px(7) = .8
py(7) = .2
px(8) = .6
py(8) = .2
px(9) = .6
py(9) = 0

CASE 34 'cross
npoints = 14
px(2) = 3 / 7
py(2) = 0
px(3) = 3 / 7
py(3) = 1 / 7
px(4) = 2 / 7
py(4) = 1 / 7
px(5) = 2 / 7
py(5) = 2 / 7
px(6) = 3 / 7
py(6) = 2 / 7
px(7) = 3 / 7
py(7) = 3 / 7
px(8) = 4 / 7
py(8) = 3 / 7
px(9) = 4 / 7
py(9) = 2 / 7
px(10) = 5 / 7
py(10) = 2 / 7
px(11) = 5 / 7
py(11) = 1 / 7
px(12) = 4 / 7
py(12) = 1 / 7
px(13) = 4 / 7
py(13) = 0

CASE 35 'pentagon
npoints = 7
px(2) = .4
py(2) = .5
px(3) = 1
py(3) = .3
px(4) = 1
py(4) = -.3
px(5) = .4
py(5) = -.5
px(6) = 0
py(6) = 0

CASE 36 'star
npoints = 7
px(2) = 1
py(2) = .3
px(3) = .4
py(3) = -.5
px(4) = .4
py(4) = .5
px(5) = 1
py(5) = -.3
px(6) = 0
py(6) = 0

CASE 37 'notch
npoints = 6
px(2) = 1 / 3
py(2) = 1 / 3
px(3) = 1 / 3
py(3) = 0
px(4) = 2 / 3
py(4) = 0
px(5) = 2 / 3
py(5) = 1 / 3

CASE 38 'wings
npoints = 8
px(2) = 1 / 3
py(2) = 1 / 3
px(3) = 1 / 3
py(3) = -1 / 3
px(4) = 0
py(4) = 0
px(5) = 1
py(5) = 0
px(6) = 2 / 3
py(6) = 1 / 3
px(7) = 2 / 3
py(7) = -1 / 3

CASE 39 'zigzag
npoints = 7
px(2) = 1 / 4
py(2) = 0
px(3) = 3 / 8
py(3) = SQR(3) / 8
px(4) = 1 / 2
py(4) = 0
px(5) = 5 / 8
py(5) = -SQR(3) / 8
px(6) = 3 / 4
py(6) = 0

CASE 40 'twotooth
npoints = 7
px(2) = 1 / 4
py(2) = 0
px(3) = 3 / 8
py(3) = SQR(3) / 8
px(4) = 1 / 2
py(4) = 0
px(5) = 5 / 8
py(5) = SQR(3) / 8
px(6) = 3 / 4
py(6) = 0

END SELECT

px(npoints) = 1
py(npoints) = 0

END SUB

SUB drawpolygon

CLS

k = niters
IF alliters = 1 THEN k = 1

FOR j = k TO niters
IF nsides = 1 THEN
        CALL drawsegment(j, xmid - xmid * zoom, ymid, xmid + xmid * zoom, ymid)
ELSE
arc = 2 * Pi / nsides
FOR i = 1 TO nsides
        CALL drawsegment(j, xmid + xmid * COS((i - 1) * arc) * zoom, ymid + ymid * SIN((i - 1) * arc) * zoom, xmid + xmid * COS(i * arc) * zoom, ymid + ymid * SIN(i * arc) * zoom)
NEXT i
END IF
NEXT j

END SUB

SUB drawrandom
c = .8
DO
        niters = irand(3)
        nsides = irand(6)
        fun = irand(nfun)
        colscheme = irand(ncolscheme)
        constcolor = irand(ncolors)
        IF RND > .6 THEN boxscheme = irand(2) + 1 ELSE boxscheme = 1
        CALL deffun
        IF RND > c THEN CALL negate
        IF RND > c THEN CALL mirror
        IF RND > c THEN CALL amplify
        IF RND > c THEN CALL reduce
        IF RND > c THEN CALL extend
        IF RND > c THEN CALL compress
        IF RND > .5 THEN alliters = -alliters
        CALL drawpolygon
        SLEEP 1
        a$ = INKEY$
LOOP WHILE a$ <> CHR$(27) 'esc
END SUB

SUB drawrandomchange
DO
        r = irand(13)
        SELECT CASE r
        CASE 1
                niters = irand(3)
        CASE 2
                nsides = irand(6)
        CASE 3
                fun = irand(nfun)
                CALL deffun
        CASE 4
                colscheme = irand(ncolscheme)
        CASE 5
                constcolor = irand(ncolors)
        CASE 6
                boxscheme = irand(3)
        CASE 7
                CALL negate
        CASE 8
                CALL mirror
        CASE 9
                CALL amplify
        CASE 10
                CALL reduce
        CASE 11
                CALL extend
        CASE 12
                CALL compress
        CASE 13
                alliters = -alliters
        END SELECT
        CALL drawpolygon
        SLEEP 1
        a$ = INKEY$
LOOP WHILE a$ <> CHR$(27) 'esc
END SUB

SUB drawsegment (n, ax, ay, bx, by)
IF n <= 0 THEN
        SELECT CASE colscheme
        CASE 1
        col = constcolor
        CASE 2
        col = irand(ncolors)
        CASE 3
        col = ((ax + ay) / 100) MOD ncolors + 1
        CASE 4
        col = ((ax * ay) / 5000) MOD ncolors + 1
        CASE 5
        col = (ax * bx + ay * by) / 5000 MOD ncolors + 1
        CASE 6
        col = (ax * by + ay * bx) / 5000 MOD ncolors + 1
        'CASE 7
        'IF ay = 0 THEN col = 1 ELSE col = (ax / ay + 8) MOD ncolors + 1
        END SELECT
        SELECT CASE boxscheme
        CASE 1
        LINE (ax, ymax - ay)-(bx, ymax - by), col
        CASE 2
        LINE (ax, ymax - ay)-(bx, ymax - by), col, B
        CASE 3
        LINE (ax, ymax - ay)-(bx, ymax - by), col, BF
        END SELECT
ELSE
        r = SQR((bx - ax) * (bx - ax) + (by - ay) * (by - ay))
        IF bx - ax = 0 THEN
                IF by - ay > 0 THEN
                        theta = Pi / 2
                ELSE
                        theta = -Pi / 2
                END IF
        ELSE
                theta = ATN((by - ay) / (bx - ax))
        END IF
        IF bx - ax < 0 THEN theta = theta + Pi
        FOR i = 1 TO npoints - 1
                 pxi = ax + r * (px(i) * COS(theta) - py(i) * SIN(theta))
                 pyi = ay + r * (px(i) * SIN(theta) + py(i) * COS(theta))
                 pxi1 = ax + r * (px(i + 1) * COS(theta) - py(i + 1) * SIN(theta))
                 pyi1 = ay + r * (px(i + 1) * SIN(theta) + py(i + 1) * COS(theta))
                 CALL drawsegment(n - 1, pxi, pyi, pxi1, pyi1)
        NEXT i
END IF
END SUB

SUB exitprogram
        'PRINT "You have exited the program."
        'PRINT "To return to Windows, press any key, then press Alt, F, X."
        'END
        SYSTEM
END SUB

SUB extend
        FOR i = 2 TO npoints - 1
                IF px(i) <> 0 AND px(i) <> 1 THEN px(i) = 2 * px(i) - .5
        NEXT i
END SUB

FUNCTION irand (i)
irand = INT(RND * i + 1)
END FUNCTION

SUB mainmenu

CLS

PRINT , "Fractal Pattern Generator"
PRINT
PRINT , "Press Enter to draw the picture."
PRINT , "Press P to draw random Pictures."
PRINT , "Press G to draw random pictures that change Gradually."
PRINT
PRINT "S = "; nsides, "Press S to change the number of polygon Sides."
PRINT "T = "; niters, "Press T to change the number of iTerations."
PRINT "F = "; fun, "Press F to change the drawing Function."
PRINT "L = "; colscheme, "Press L to change the coLor scheme."
PRINT "X = "; constcolor, "Press X to change the fiXed color."
PRINT "B = "; boxscheme, "Press B to change the Box scheme."
PRINT "Z = "; zoom, "Press Z to change the Zoom factor."
PRINT , "Press I to zoom In."
PRINT , "Press O to zoom Out."
PRINT
PRINT , "Press N to Negate   the sign of the function."
PRINT , "Press M to Mirror   the function."
PRINT , "Press A to Amplify  the height of the pattern."
PRINT , "Press R to Reduce   the height of the pattern."
PRINT , "Press E to Extend   the width  of the pattern."
PRINT , "Press C to Compress the width  of the pattern."
PRINT , "Press D to Draw     all iterations."
PRINT
PRINT , "Press Esc to exit the program."
PRINT

a$ = ""
DO
        a$ = INKEY$
LOOP WHILE a$ = ""

SELECT CASE a$
CASE CHR$(27) 'esc
        CALL exitprogram
CASE CHR$(13) 'enter
        CALL drawpolygon
        PRINT "Press any key to continue."
        a$ = ""
        DO
                a$ = INKEY$
        LOOP WHILE a$ = ""
CASE "p"
        CALL drawrandom
CASE "g"
        CALL drawrandomchange
CASE "s"
        maxsides = 100
        DO
                PRINT "Enter the number of sides to the polygon (1 to "; maxsides; ")."
                INPUT nsides
                IF nsides < 1 OR nsides > maxsides THEN PRINT "The polygon must have 1 to "; maxsides; " sides."
        LOOP WHILE nsides < 1 OR nsides > maxsides
CASE "t"
        maxiters = 5
        DO
                PRINT "Enter the number of iterations (0 to "; maxiters; ")."
                INPUT niters
                IF niters < 0 OR niters > maxiters THEN PRINT "The number of iterations must be 0 to "; maxiters; "."
        LOOP WHILE niters < 0 OR niters > maxiters
CASE "f"
        CLS
        FOR i = 1 TO nfun
                PRINT i, fdesc(i),
                IF i MOD 2 = 0 THEN PRINT
        NEXT i
        PRINT
        PRINT "The current function is"; fun; fdesc(fun)
        DO
                PRINT "Enter the function number (1 to "; nfun; ")."
                INPUT fun
                IF fun < 1 OR fun > nfun THEN PRINT "The function number must be from 1 to "; nfun; "."
        LOOP WHILE fun < 1 OR fun > nfun
        CALL deffun
CASE "n"
        CALL negate
        PRINT "negated"
        SLEEP 1
CASE "m"
        CALL mirror
        PRINT "mirrored"
        SLEEP 1
CASE "a"
        CALL amplify
        PRINT "amplified"
        SLEEP 1
CASE "r"
        CALL reduce
        PRINT "reduced"
        SLEEP 1
CASE "e"
        CALL extend
        PRINT "extended"
        SLEEP 1
CASE "c"
        CALL compress
        PRINT "compressed"
        SLEEP 1
CASE "d"
        alliters = -alliters
        IF alliters = 1 THEN PRINT "all iterations are drawn" ELSE PRINT "only last iteration is drawn"
        SLEEP 1
CASE "i"
        zoom = zoom * 2
CASE "o"
        zoom = zoom / 2
CASE "z"
        PRINT "Enter zoom factor (1 = no zoom)."
        INPUT zoom
CASE "l"
        DO
                PRINT "Enter color scheme (1 to "; ncolscheme; ")."
                INPUT colscheme
                IF colscheme < 1 OR colscheme > ncolscheme OR colscheme <> INT(colscheme) THEN PRINT "Color scheme must be an integer 1 to "; ncolscheme; "."
        LOOP WHILE colscheme < 1 OR colscheme > ncolscheme OR colscheme <> INT(colscheme)
CASE "x"
        DO
                PRINT "Enter fixed color (1 to "; ncolors; ")."
                INPUT constcolor
                IF constcolor < 1 OR constcolor > ncolors OR constcolor <> INT(constcolor) THEN PRINT "Fixed color must be an integer 1 to "; ncolors; "."
        LOOP WHILE constcolor < 1 OR constcolor > ncolors OR constcolor <> INT(constcolor)
CASE "b"
        DO
                PRINT "Enter Box scheme (1 to "; nboxscheme; ")."
                INPUT boxscheme
                IF boxscheme < 1 OR boxscheme > nboxscheme OR boxscheme <> INT(boxscheme) THEN PRINT "Box scheme must be an integer 1 to "; nboxscheme; "."
        LOOP WHILE boxscheme < 1 OR boxscheme > nboxscheme OR boxscheme <> INT(boxscheme)
CASE ELSE
        BEEP
END SELECT

END SUB

SUB mirror
        FOR i = 1 TO npoints
                px(i) = 1 - px(i)
        NEXT i
END SUB

SUB negate
        FOR i = 2 TO npoints - 1
                py(i) = -py(i)
        NEXT i
END SUB

SUB reduce
        FOR i = 2 TO npoints - 1
                py(i) = py(i) / 2
        NEXT i
END SUB