Symmetric Fractals Program
DEFDBL I, X-Z
DEFINT M-N
DIM c(100), s(100)
ON ERROR GOTO errortrap
DEF fnxpix (x) = nstartx + scalex * (x + scale)
DEF fnypix (y) = npixely - scaley * (y + scale)
GOSUB initialize
GOSUB menu
loops:
GOSUB iterate
A$ = INKEY$
IF A$ = "c" THEN CLS : iterates = 1: GOSUB parameters
restart:
IF A$ = "m" THEN GOSUB menu
IF A$ = "i" THEN GOSUB parameters
x = xnew: y = ynew
PSET (fnxpix(x), fnypix(y))
iterates = iterates + 1
GOTO loops
iterate:
xnew = a11 * x + a12 * y + b1
ynew = a21 * x + a22 * y + b2
m = INT(n * RND)
x1 = xnew: y1 = ynew
xnew = c(m) * x1 - s(m) * y1
ynew = s(m) * x1 + c(m) * y1
IF conj = 0 THEN RETURN
m = INT(2 * RND)
IF m = 1 THEN ynew = -ynew
RETURN
menu:
GOSUB parameters
PRINT "Degree of symmetry"; n
PRINT " (X,y) ="; CSNG(x), CSNG(y)
PRINT "Scale = "; scale
IF conj = 0 THEN PRINT "Toggle for Dn symmetry"
IF conj = 1 THEN PRINT "Toggle for Zn symmetry"
PRINT "ESC to STOP"
PRINT "R to iterate"
1010 b$ = INKEY$
IF b$ = "" THEN 1010
IF b$ = CHR$(27) THEN STOP
IF b$ = "d" THEN INPUT "new degree of symmetry = ", n: GOSUB trig
IF b$ = "t" THEN conj = 1 - conj
IF b$ = "1" THEN INPUT "new a11 = ", a11
IF b$ = "2" THEN INPUT "new a12 = ", a12
IF b$ = "3" THEN INPUT "new a21 = ", a21
IF b$ = "4" THEN INPUT "new a22 = ", a22
IF b$ = "5" THEN INPUT "new b1 = ", b1
IF b$ = "6" THEN INPUT "new b2 = ", b2
IF b$ = "r" THEN CLS : iterates = 1: GOSUB parameters: RETURN
IF b$ = "s" THEN INPUT " new scale = ", scale: GOSUB setscreen
IF b$ = "x" THEN x = .1: y = .012343: xnew = x: ynew = y
CLS
GOTO menu
parameters:
LOCATE 1, 1
PRINT "iterates = ", iterates
PRINT USING "symmetry = !##"; d$(conj); n
PRINT "1. a11 = "; a11
PRINT "2. a12 = "; a12
PRINT "3. a21 = "; a21
PRINT "4. a22 = "; a22
PRINT "5. b1 = "; b1
PRINT "6. b2 = "; b2
a1 = a11 * a11 + a21 * a21: a2 = a12 * a12 + a22 * a22
IF a1>1 OR a2>1 OR a1+a2>1-(a11*a22-a12*a21)^2 THEN PRINT "WARNING - Affine mapping is not a contraction"
LINE (nstartx, 0)-(nstartx, npixely)
RETURN
initialize:
CLS
scale = 1
nscreen = 12: npixelx = 640: npixely = 480
nstartx = 160
SCREEN nscreen
GOSUB setscreen
pi = 355 / 113
a11 = .4: a12 = .35: a21 = .2: a22 = .4
b1 = 0!: b2 = .4: iterates = 1
x = .1: y = -.01: n = 3: conj = 1
GOSUB trig
d$(0) = "Z": d$(1) = "D"
RETURN
errortrap:
x = .0234: y = .12345
A$ = "m"
RESUME restart
initialpoint:
CLS
PRINT "Enter r to reset coordinates automatically"
PRINT "Enter x to INPUT coordinates"
3010 :
c$ = INKEY$
IF c$ <> "r" AND c$ <> "x" THEN 3010
IF c$ = "r" THEN x = .003: y = .0005345
IF c$ = "x" THEN INPUT "(x,y) coordinates =", x, y
xnew = x: ynew = y
RETURN
setscreen:
CLS
scaley = npixely / (2 * scale)
scalex = (npixelx - nstartx) / (2 * scale)
RETURN
trig:
FOR i = 0 TO n - 1
c(i) = COS(2 * pi * i / n)
s(i) = SIN(2 * pi * i / n)
NEXT i
RETURN