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