DECLARE SUB randomchange ()
DECLARE FUNCTION irand! (i!)
DECLARE SUB randomparams ()
DECLARE SUB drawgrid ()
DECLARE SUB exitprogram ()
DECLARE FUNCTION linecolor! (f, i, j)
DECLARE SUB mainmenu ()
DECLARE SUB warp (r, theta, dtheta)

SCREEN 12
RANDOMIZE TIMER

DIM SHARED imax, jmax
imax = 40
jmax = 40
DIM SHARED x(imax, jmax) AS SINGLE, y(imax, jmax) AS SINGLE

DIM SHARED ni, nj, dtheta, constcolor, ncolors, sx, sy, Pi, xmid, ymid, zmax, zoom

ni = 20
nj = 20
dtheta = 0
constcolor = 1
ncolors = 15
sx = 600
sy = 400
Pi = ATN(1) * 4
xmid = sx / 2
ymid = sy / 2
zmax = .5
zoom = .5

DIM SHARED colscheme, ncolscheme
colscheme = 1
ncolscheme = 8
DIM SHARED colschemedesc(ncolscheme) AS STRING
colschemedesc(1) = "constant color"
colschemedesc(2) = "square, 2 quadrant"
colschemedesc(3) = "square, 4 quadrant"
colschemedesc(4) = "stripes"
colschemedesc(5) = "target"
colschemedesc(6) = "target"
colschemedesc(7) = "quotient"
colschemedesc(8) = "quotient"

DIM SHARED boxscheme, nboxscheme
nboxscheme = 3
boxscheme = 1

DIM SHARED rfun, nrfun
rfun = 1
nrfun = 11
DIM SHARED rfundesc(nrfun) AS STRING
rfundesc(1) = "none"
rfundesc(2) = "square"
rfundesc(3) = "cube"
rfundesc(4) = "square root"
rfundesc(5) = "fourth root"
rfundesc(6) = "1 - radius"
rfundesc(7) = "radius / relative angle change"
rfundesc(8) = "1 / radius"
rfundesc(9) = "1 + sin(angle x radius)"
rfundesc(10) = "1 + sin(angle x (1-radius))"
rfundesc(11) = "r + sin(angle x radius)"

DIM SHARED tfun, ntfun
tfun = 1
ntfun = 6
DIM SHARED tfundesc(ntfun) AS STRING
tfundesc(1) = "none"
tfundesc(2) = "angle x radius"
tfundesc(3) = "angle x (1-radius)"
tfundesc(4) = "Pi x sin(angle x radius)"
tfundesc(5) = "Pi x sin(angle x (1-radius))"
tfundesc(6) = "angle / radius"

DO
        CALL mainmenu
LOOP

SUB drawgrid

'calculate points on grid
FOR i = 0 TO ni - 1
FOR j = 0 TO nj - 1

'calculate zi,zj in grid coordinates [-zmax,zmax],[-zmax,zmax]
zi = (i / (ni - 1) - .5) * 2 * zmax
zj = (j / (nj - 1) - .5) * 2 * zmax

'calculate r,theta in polar coordinates [0,1],[0,2*Pi)
r = SQR(zi * zi + zj * zj)
IF zi = 0 THEN
        IF zj > 0 THEN theta = Pi / 2 ELSE theta = -Pi / 2
ELSE
        theta = ATN(zj / zi)
END IF
IF zi < 0 THEN theta = theta + Pi

'warp the grid by randomly combining transformation functions of polar coordinates r and theta
CALL warp(r, theta, dtheta)

'map r,theta in [0,1],[0,2*Pi) to x,y in screen coordinates [0,xmax],[0,ymax]
x(i + 1, j + 1) = xmid + sx * (r * COS(theta)) * zoom
y(i + 1, j + 1) = ymid + sy * (r * SIN(theta)) * zoom

NEXT j
NEXT i

CLS

'draw horizontal grid lines
SELECT CASE boxscheme
CASE 1
FOR i = 1 TO ni
FOR j = 1 TO nj - 1
        LINE (x(i, j), y(i, j))-(x(i, j + 1), y(i, j + 1)), linecolor(colscheme, i, j)
NEXT j
NEXT i
CASE 2
FOR i = 1 TO ni
FOR j = 1 TO nj - 1
        LINE (x(i, j), y(i, j))-(x(i, j + 1), y(i, j + 1)), linecolor(colscheme, i, j), B
NEXT j
NEXT i
CASE 3
FOR i = 1 TO ni
FOR j = 1 TO nj - 1
        LINE (x(i, j), y(i, j))-(x(i, j + 1), y(i, j + 1)), linecolor(colscheme, i, j), BF
NEXT j
NEXT i
END SELECT

'draw vertical grid lines
SELECT CASE boxscheme
CASE 1
FOR j = 1 TO nj
FOR i = 1 TO ni - 1
        LINE (x(i, j), y(i, j))-(x(i + 1, j), y(i + 1, j)), linecolor(colscheme, i, j)
NEXT i
NEXT j
CASE 2
FOR j = 1 TO nj
FOR i = 1 TO ni - 1
        LINE (x(i, j), y(i, j))-(x(i + 1, j), y(i + 1, j)), linecolor(colscheme, i, j), B
NEXT i
NEXT j
CASE 3
FOR j = 1 TO nj
FOR i = 1 TO ni - 1
        LINE (x(i, j), y(i, j))-(x(i + 1, j), y(i + 1, j)), linecolor(colscheme, i, j), BF
NEXT i
NEXT j
END SELECT

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

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

FUNCTION linecolor (f, i, j)

x = (i - ni / 2)
y = (j - nj / 2)
SELECT CASE f
CASE 1
linecolor = constcolor
CASE 2
linecolor = (x * y) MOD ncolors + 1
CASE 3
linecolor = (i * j) MOD ncolors + 1
CASE 4
linecolor = (i + j) MOD ncolors + 1
CASE 5
linecolor = (x * x + y * y) / 100 MOD ncolors + 1
CASE 6
linecolor = (x * x + y * y) / ni / nj MOD ncolors + 1
CASE 7
IF y = 0 THEN linecolor = 0 ELSE linecolor = (x / y + 8) MOD ncolors + 1
CASE 8
linecolor = (i / j) MOD ncolors + 1
END SELECT

END FUNCTION

SUB mainmenu

CLS
PRINT , "Grid Warp"
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 "X ="; ni, "Press X to change number of points on X axis."
PRINT "Y ="; nj, "Press Y to change number of points on Y axis."
PRINT
PRINT "Z ="; zoom, "Press Z to change the Zoom factor."
PRINT , "Press I to zoom In."
PRINT , "Press O to zoom Out."
PRINT
PRINT "B ="; boxscheme, "Press B to change Box scheme ("; boxscheme; ")."
PRINT "S ="; colscheme, "Press S to change color Scheme ("; colschemedesc(colscheme); ")."
PRINT "C ="; constcolor, "Press C to change Constant color."
PRINT
PRINT "R ="; rfun, "Press R to change Radius warping function."
PRINT , , , "   ("; rfundesc(rfun); ")"
PRINT "T ="; tfun, "Press T to change angle warping function."
PRINT , , , "   ("; tfundesc(tfun); ")"
PRINT "A ="; dtheta / Pi; "* Pi", "Press A to change Angle of warp."
PRINT
PRINT , "Press Esc to quit."

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

SELECT CASE a$
CASE "x"
        DO
                PRINT "Enter number of points on x axis (ni="; ni; ")."
                INPUT ni
                IF ni < 2 OR ni > 40 OR ni / 2 <> INT(ni / 2) THEN PRINT "Number must be 2 to 40 and even."
        LOOP WHILE ni < 2 OR ni > 40 OR ni / 2 <> INT(ni / 2)
CASE "y"
        DO
                PRINT "Enter number of points on y axis (nj="; nj; ")."
                INPUT nj
                IF nj < 2 OR nj > 40 OR nj / 2 <> INT(nj / 2) THEN PRINT "Number must be 2 to 40 and even."
        LOOP WHILE nj < 2 OR nj > 40 OR nj / 2 <> INT(nj / 2)
CASE "r"
        FOR i = 1 TO nrfun
                PRINT i; rfundesc(i)
        NEXT i
        DO
                PRINT "Enter radius warping function (1 to "; nrfun; ")."
                INPUT rfun
                IF rfun < 1 OR rfun > nrfun THEN PRINT "Number must be 1 to "; nrfun; "."
        LOOP WHILE rfun < 1 OR rfun > nrfun
CASE "t"
        FOR i = 1 TO ntfun
                PRINT i; tfundesc(i)
        NEXT i
        DO
                PRINT "Enter angle warping function (1 to "; ntfun; ")."
                INPUT tfun
                IF tfun < 1 OR tfun > ntfun THEN PRINT "Number must be 1 to "; ntfun; "."
        LOOP WHILE tfun < 1 OR tfun > ntfun
CASE "a"
        PRINT "Enter angle of rotation in multiples of Pi."
        INPUT dtheta
        dtheta = dtheta * Pi
CASE "s"
        DO
                FOR i = 1 TO ncolscheme
                        PRINT i; colschemedesc(i)
                NEXT i
                PRINT "Enter color scheme."
                INPUT colscheme
                IF colscheme < 1 OR colscheme > ncolscheme THEN PRINT "color scheme must be 1 to "; ncolscheme; "."
        LOOP WHILE colscheme < 1 OR colscheme > ncolscheme
CASE "c"
        DO
                PRINT "Enter constant color."
                INPUT constcolor
                IF constcolor < 1 OR constcolor > ncolors THEN PRINT "Constant color must be 1 to "; ncolors; "."
        LOOP WHILE constcolor < 1 OR constcolor > ncolors
CASE "b"
        DO
                PRINT "Enter box scheme 1 to 3."
                INPUT boxscheme
                IF boxscheme < 1 OR boxscheme > 3 THEN PRINT "Box scheme must be 1 to 3."
        LOOP WHILE boxscheme < 1 OR boxscheme > 3
CASE "z"
        PRINT "Enter zoom factor (1 = no zoom)."
        INPUT zoom
CASE "i"
        zoom = zoom * 2
CASE "o"
        zoom = zoom / 2
CASE CHR$(13) 'enter
        PRINT "Drawing; please wait..."
        CALL drawgrid
        PRINT "Press any key to continue."
        a$ = ""
        DO
                a$ = INKEY$
        LOOP WHILE a$ = ""
CASE "p"
        PRINT "Drawing; please wait..."
        a$ = ""
        DO
                CALL randomparams
                CALL drawgrid
                SLEEP 1
                a$ = INKEY$
        LOOP WHILE a$ <> CHR$(27) 'esc
CASE "g"
        PRINT "Drawing; please wait..."
        a$ = ""
        DO
                CALL randomchange
                CALL drawgrid
                SLEEP 1
                a$ = INKEY$
        LOOP WHILE a$ <> CHR$(27) 'esc
CASE CHR$(27) 'esc
        CALL exitprogram
END SELECT

END SUB

SUB randomchange

SELECT CASE irand(9)
CASE 1
        ni = INT(RND * imax / 2) * 2 + 2
CASE 2
        nj = INT(RND * imax / 2) * 2 + 2
CASE 3
        nj = ni
CASE 4
        tfun = irand(ntfun)
CASE 5
        rfun = irand(nrfun)
CASE 6
        inc = 10
        IF RND > .25 THEN dtheta = Pi / inc * INT(RND * 4 * inc - inc) ELSE dtheta = 0
CASE 7
        colscheme = irand(ncolscheme)
CASE 8
        constcolor = irand(ncolors)
CASE 9
        boxscheme = irand(3)
END SELECT

END SUB

SUB randomparams

ni = INT(RND * imax / 2) * 2 + 2
IF RND > .5 THEN nj = ni ELSE nj = INT(RND * imax / 2) * 2 + 2
tfun = irand(ntfun)
rfun = irand(nrfun)
inc = 10
IF RND > .25 THEN dtheta = Pi / inc * INT(RND * 4 * inc - inc) ELSE dtheta = 0
colscheme = irand(ncolscheme)
constcolor = irand(ncolors)
IF RND > .6 THEN boxscheme = irand(2) + 1 ELSE boxscheme = 1

END SUB

SUB warp (r, theta, dtheta)

IF r < 1 THEN
SELECT CASE tfun
CASE 1
'do nothing
CASE 2
theta = theta + dtheta * r
CASE 3
theta = theta + dtheta * (1 - r)
CASE 4
theta = theta + Pi * SIN(dtheta * r)
CASE 5
theta = theta + Pi * SIN(dtheta * (1 - r))
CASE 6
theta = theta + dtheta / r
END SELECT
END IF

SELECT CASE rfun
CASE 1
'do nothing
CASE 2
r = r * r * 2
CASE 3
r = r * r * r * 4
CASE 4
r = SQR(r) / 2
CASE 5
r = SQR(SQR(r)) / 4
CASE 6
r = 1 - r
CASE 7
IF dtheta <> 0 THEN r = r * theta / dtheta
CASE 8
r = .1 / r
CASE 9
r = 1 + SIN(r * dtheta)
CASE 10
r = 1 + SIN((1 - r) * dtheta)
CASE 11
r = r + SIN(10 * r * dtheta) / 10
END SELECT

END SUB