Square Quilts Program

        DEFDBL I, P-Q, X-Z
        DEFINT M
        ON ERROR GOTO errortrap
        DIM mcount(160, 160), mcolor(200), colord(16)
       
        DEF fnxpix (x) = nstartx + (npixelx - nstartx) * x / nperiod
        DEF fnypix (y) = npixely - npixely * y / nperiod
       
        GOSUB initialize
        GOSUB setcolors
        GOSUB menu
        iterates = 1

loops:
        GOSUB iterate
        x = xnew: y = ynew
        GOSUB plotpoints
        a$ = INKEY$
        IF a$ = "c" THEN iterates = 1: CLS : GOSUB setscreen
        IF a$ = "i" THEN LOCATE 1, 1: PRINT "iterates ="; iterates

restart:
        IF a$ = "m" THEN GOSUB menu
        iterates = iterates + 1
        GOTO loops

iterate:
        sx = SIN(p2 * x): sy = SIN(p2 * y)
        xnew = (lambda + alpha * COS(p2 * y)) * sx - omega * sy + beta * SIN(2 * p2 * x) + gamma * SIN(3 * p2 * x) * COS(2 * p2 * y) + ma * x + shift
        ynew = (lambda + alpha * COS(p2 * x)) * sy + omega * sx + beta * SIN(2 * p2 * y) + gamma * SIN(3 * p2 * y) * COS(2 * p2 * x) + ma * y + shift
        IF xnew > 1 THEN xnew = xnew - INT(xnew)
        IF ynew > 1 THEN ynew = ynew - INT(ynew)
        IF xnew < 0 THEN xnew = xnew + INT(-xnew) + 1
        IF ynew < 0 THEN ynew = ynew + INT(-ynew) + 1
        IF toggle = 0 THEN RETURN
        mxnew = xnew * (npixelx - nstartx) / nperiod: mynew = ynew * npixely / nperiod
        mcount(mxnew, mynew) = mcount(mxnew, mynew) + 1
        RETURN

menu:
        GOSUB parameters
        PRINT "No. periods = "; nperiod
        PRINT USING "(X,y)= ##.#### ##.####"; x; y
        PRINT "T to toggle coloring:";
        IF toggle = 0 THEN PRINT "  coloring off" ELSE PRINT "  coloring on"
        PRINT "ESC to exit"
        PRINT "R for RETURN"
1010    b$ = INKEY$
        iterates = 1
        IF b$ = "" THEN 1010
        IF b$ = "l" THEN INPUT "lambda = ", lambda
        IF b$ = "a" THEN INPUT "alpha =", alpha
        IF b$ = "b" THEN INPUT "beta  =", beta
        IF b$ = "g" THEN INPUT "gamma =", gamma
        IF b$ = "o" THEN INPUT "omega =", omega
        IF b$ = "m" THEN INPUT "m =", ma
        IF b$ = "t" THEN toggle = 1 - toggle
        IF b$ = "h" THEN shift = .5 - shift
        IF b$ = "n" THEN INPUT "# of periods =", nperiod: GOSUB setscreen
        IF b$ = "x" THEN GOSUB initialpoint
        IF b$ = "c" THEN INPUT nscreen: GOSUB setscreen
        IF b$ = "r" THEN iterates = 1: GOSUB setscreen: RETURN
        IF b$ = CHR$(27) THEN STOP
        CLS
        GOTO menu

parameters:
        LOCATE 1, 1
        PRINT "iterates= "; iterates
        PRINT "Lambda= "; lambda
        PRINT "Alpha = "; alpha
        PRINT "Beta  = "; beta
        PRINT "Gamma = "; gamma
        PRINT "Omega = "; omega
        PRINT "M ="; ma
        PRINT "sHift by "; shift
        LINE (nstartx, 0)-(nstartx, npixely)
        RETURN

initialize:
        toggle = 0: ncolor = 15
        nperiod = 3
        nscreen = 12
        npixelx = 640: npixely = 480: nstartx = 160
        CLS
        SCREEN nscreen
        pi = 355 / 113: p2 = 2 * pi
        x = .1: y = .334: xnew = x: ynew = y
        lambda = -.59: alpha = .2: beta = .1: gamma = -.09: ma = 0
        shift = 0
        RETURN

errortrap:
        x = .0234: y = .12345: xnew = x: ynew = y
        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 = .3: y = .5345
        IF C$ = "x" THEN INPUT "(x,y) coordinates =", x, y
        xnew = x: ynew = y
        RETURN

setscreen:
        CLS
        GOSUB parameters
        IF toggle = 0 THEN RETURN
        FOR j = 0 TO (npixelx - nstartx) / nperiod
                FOR i = 0 TO npixely / nperiod
                        mcount(j, i) = 0
                NEXT i
        NEXT j
        FOR i = 1 TO 15
                LINE (0, npixely - 20 * i)-(15, npixely - 20 * (i + 1)), colord(i), BF
        NEXT i
        RETURN

setcolors:
        colord(1) = 8: colord(2) = 6: colord(3) = 1: colord(4) = 9
        colord(5) = 3: colord(6) = 11: colord(7) = 2: colord(8) = 10
        colord(9) = 5: colord(10) = 13: colord(11) = 4: colord(12) = 12
        colord(13) = 14: colord(14) = 7: colord(15) = 15
        FOR j = 1 TO 15
                mcolor(j) = colord(j)
        NEXT j
        RETURN

plotpoints:
        FOR i = 0 TO nperiod - 1
                FOR j = 0 TO nperiod - 1
                        IF toggle = 0 THEN PSET (fnxpix(x + i), fnypix(y + j)): GOTO 160
                        mc = mcount(mxnew, mynew)
                        IF mc < 15 THEN mm = mcolor(mc) ELSE mm = 15
                        PSET (fnxpix(x + i), fnypix(y + j)), mm
'rem If coloring is not being used delete , mm  from previous line
160     NEXT j
        NEXT i
        RETURN