'''Subroutines'''
'''***********'''
DECLARE SUB melo ()
DECLARE SUB funcupara ()
DECLARE SUB coorcupara ()
DECLARE SUB figuurtit ()
DECLARE SUB prefsmore ()
DECLARE SUB prefscol ()
DECLARE SUB funcirkel ()
DECLARE SUB funcosin ()
DECLARE SUB fundubhyp ()
DECLARE SUB funcosec ()
DECLARE SUB funexpon ()
DECLARE SUB funparab ()
DECLARE SUB funsino ()
DECLARE SUB funsinq ()
DECLARE SUB funtangens ()
DECLARE SUB afbmod3 ()
DECLARE SUB rotstap ()
DECLARE SUB schermkleur ()
DECLARE SUB scanmax ()
DECLARE SUB scanmod ()
DECLARE SUB tekenen ()
DECLARE SUB figpref ()
DECLARE SUB prefs ()
DECLARE SUB tekenxyas ()
DECLARE SUB tekenparm ()
DECLARE SUB tekencurv ()
DECLARE SUB tekenxyvlak ()
DECLARE SUB intro ()
DECLARE SUB tekenxy ()
DECLARE SUB figcurv ()
DECLARE SUB menu ()
DECLARE SUB rotkeus2 ()
DECLARE SUB projas2 ()
DECLARE SUB afbmod2 ()
DECLARE SUB figuur2 ()
DECLARE SUB scherm ()
DECLARE SUB figuur ()
DECLARE SUB tekencoord ()
DECLARE SUB tekenfig ()
DECLARE SUB rotkeus ()
DECLARE SUB coorcirkel ()
DECLARE SUB coordubhyp ()
DECLARE SUB coorcosec ()
DECLARE SUB coorexpon ()
DECLARE SUB coorparab ()
DECLARE SUB coorcosin ()
DECLARE SUB coorsino ()
DECLARE SUB coorsinq ()
DECLARE SUB coortan ()
DECLARE SUB afbmod ()
DECLARE SUB projas ()
DECLARE SUB cirkel ()
DECLARE SUB dubhyp ()
DECLARE SUB cosec ()
DECLARE SUB expon ()
DECLARE SUB parab ()
DECLARE SUB cosin ()
DECLARE SUB tangens ()
DECLARE SUB sino ()
DECLARE SUB sinq ()
DECLARE SUB rot1 ()
DECLARE SUB rot2 ()
DECLARE SUB rot3 ()
DECLARE SUB rot4 ()
DECLARE SUB rot5 ()
DECLARE SUB rot6 ()
DECLARE SUB rot7 ()
DECLARE SUB rot8 ()
DECLARE SUB rot9 ()
DECLARE SUB rot10 ()
DECLARE SUB rot11 ()
DECLARE SUB rot12 ()
DECLARE SUB rot13 ()
DECLARE SUB teken ()
DECLARE SUB teken2 ()

'''Variables '''
'''**********'''
COMMON SHARED a, b, alf, bet, cca, ccb, ssa, ssb, tta, ttb, alfr, betr
COMMON SHARED pi, nrot, drot, tel, xi, nr%, scan, scr
COMMON SHARED u1, u2, u3, u4, v1, v2, v3, v4
COMMON SHARED u11, u22, u33, u44, v11, v22, v33, v44
COMMON SHARED men, fig, max, xy, fac, yx, nmax, mmax, delthoek, deltx2
COMMON SHARED tit$, c$, rot$, xy$, parm$, ja$, curv$
COMMON SHARED f$(), fmen$(), ffig$(), frot$(), scr$(), mel$()
COMMON SHARED afb$(), afb1$(), afb2$(), afb3$(), col(), scol(), scrcol()'''col1(), col2()
COMMON SHARED x1(), x2(), y1(), y2(), u(), v()
COMMON SHARED r(), rdub(), xx1sec(), xx2sec(), xx1exp()
COMMON SHARED rpar(), rcupar(), xxsin1(), xxsin2(), xxtan1(), xxtan2()
COMMON SHARED colm, coln, colmm, colnn, colx, coly, colxx, colyy, mel
COMMON SHARED colcrv1, colcrv2, colcrv3
COMMON SHARED rij, kol, vlag, vlagxy

'''Titles'''
'''******'''
DIM fmen$(6)
fmen$(0) = " -> DISPLAY"
fmen$(1) = " -> figure"
fmen$(2) = " -> rotation"
fmen$(3) = " -> projective axes"
fmen$(4) = " -> preferences"
fmen$(5) = " -> About COMPLEXITY..."
fmen$(6) = " -> END"
DIM ffig$(10)
ffig$(0) = "-> X and Y unit axes"
ffig$(1) = "-> Circle/Hyperbola : Y=1/X"
ffig$(2) = "-> Double hyperbola : Y=1/X^2"
ffig$(3) = "-> Cosecant........ : Y=1/Sin(X)"
ffig$(4) = "-> Exponential..... : Y=e^X"
ffig$(5) = "-> Parabola........ : Y=X^2"
ffig$(6) = "-> Cosine.......... : Y=Cos(X)"
ffig$(7) = "-> Tangent......... : Y=Sin(X)/Cos(X)"
ffig$(8) = "-> Sinuoid......... : Y=Sin(2pi X)"
ffig$(9) = "-> QuadSin......... : Y=Sin^2 (X)"
ffig$(10) = "-> Cubic parabola.. : Y=X^3"
DIM frot$(13)
frot$(1) = " 1 = x1-as only"
frot$(2) = " 2 = y1-as only"
frot$(3) = " 3 = x2-as only"
frot$(4) = " 4 = y2-as only"
frot$(5) = " 5 = x1-x2 plane (X-plane)"
frot$(6) = " 6 = y1-y2 plane (Y-plane)"
frot$(7) = " 7 = x1-y1 plane (real plane)"
frot$(8) = " 8 = x2-y2 plane (imag. plane)"
frot$(9) = " 9 = x1-y2 plane"
frot$(10) = "10 = x2-y1 plane"
frot$(11) = "11 = X-plane + Y-plane"
frot$(12) = "12 = x1-y1 + x2-y2 planes"
frot$(13) = "13 = x1-y2 + x2-y1 planes"
DIM afb$(7), afb1$(7), afb2$(7)
afb$(1) = "-> Imaging"
afb$(2) = "-> Parameter curves"
afb$(3) = "-> Characteristic curves"
afb$(4) = "-> X Y unit planes"
afb$(5) = "-> x y axes"
afb$(6) = "-> After each image"
afb$(7) = "-> More..."
afb1$(1) = "no"
afb1$(2) = "scan"
afb1$(3) = "show"
afb1$(4) = "show"
afb1$(5) = "show"
afb1$(6) = "wait"
afb1$(7) = ""
afb2$(1) = "yes"
afb2$(2) = "don't scan"
afb2$(3) = "don't show"
afb2$(4) = "don't show"
afb2$(5) = "don't show"
afb2$(6) = "proceed"
afb2$(7) = ""
DIM col(8), scol(9)
DIM afb3$(5)
afb3$(1) = "-> Tune"
afb3$(2) = "-> Back color"
afb3$(3) = "-> Number of images within 360ø"
afb3$(4) = "-> Max number of scans"
afb3$(5) = "-> Scan modes..."
DIM mel$(2), scr$(4), scrcol(4)
mel$(1) = "PLAY": mel$(2) = "MUTE"
scr$(1) = "black ": scrcol(1) = 0
scr$(2) = "grey  ": scrcol(2) = 8
scr$(3) = "white ": scrcol(3) = 7
scr$(4) = "bright": scrcol(4) = 15
DIM f$(2)

''' DEFAULTs           '''
'''********************'''
FOR i = 1 TO 8: col(i) = 7: NEXT i
FOR i = 1 TO 9: scol(i) = 7: NEXT i
pi = ATN(1) * 4
tit$ = "X and Y- unit axes   ": c$ = ""
nrot = 9: drot = 360 / nrot: ja$ = "": xy$ = "": curv$ = ""
a = .8
alf = 55: alfr = alf * pi / 180
tta = TAN(alfr): cca = COS(alfr): ssa = SIN(alfr)
b = .7
bet = -40: betr = bet * pi / 180
ttb = TAN(betr): ccb = COS(betr): ssb = SIN(betr)
nr% = 4: scan = 3: scr = 1: mel = 1

'''Intro'''
'''*****'''
intro:
CALL intro

'''Main menu'''
'''*********'''
menu:
CALL menu
IF men <> 0 GOTO menu

'''Dimensioning'''
'''**************'''
IF fig <> 0 THEN
REDIM x1(mmax, nmax), x2(mmax, nmax), y1(mmax, nmax), y2(mmax, nmax)
REDIM u(mmax, nmax), v(mmax, nmax)
END IF

'''Space coordinates figure'''
'''***********************'''
SELECT CASE fig
CASE 0: max = 2: fac = 1
CASE 1: CALL coorcirkel
CASE 2: CALL coordubhyp
CASE 3: GOSUB datacosec: CALL coorcosec
CASE 4: CALL coorexpon
CASE 5: CALL coorparab
CASE 6: CALL coorcosin
CASE 7: GOSUB datatan: CALL coortan
CASE 8: CALL coorsino
CASE 9: CALL coorsinq
CASE 10: CALL coorcupara
END SELECT

'''Projective coordinates, and draw image'''
'''**************************************'''
tel = 0                          '''first screen'''
SELECT CASE nr%
CASE 1: CALL rot1
CASE 2: CALL rot2
CASE 3: CALL rot3
CASE 4: CALL rot4
CASE 5: CALL rot5
CASE 6: CALL rot6
CASE 7: CALL rot7
CASE 8: CALL rot8
CASE 9: CALL rot9
CASE 10: CALL rot10
CASE 11: CALL rot11
CASE 12: CALL rot12
CASE 13: CALL rot13
END SELECT
PLAY "o4l12d"
LOCATE 1, 60: COLOR 3: PRINT "-> Press a key...   "
a$ = INPUT$(1)
GOTO menu

'''Data COSECANT'''
'''*************'''
datacosec:

 RESTORE leescosec
 FOR n = 0 TO nmax: READ xx1sec(n): NEXT n
 FOR m = 0 TO mmax: READ xx2sec(m): NEXT m
 
leescosec:
 DATA .003,.02,.04,.05,.06,.07,.08,.1,.12,.14,.16
 DATA .2,.25,.3,.4,.5,.75,1,1.25,1.5

 DATA -5,-4,-3,-2,-1,-.5,-.3,-.2,-.15,-.1,-.08,-.06,-.04,-.02
 DATA .0
 DATA .02,.04,.06,.08,.1,.15,.2,.3,.5,1,2,3,4,5
RETURN

'''Data TANGENT'''
'''************'''
datatan:

 RESTORE leestan
 FOR n = 0 TO nmax: READ xxtan1(n): NEXT n
 FOR m = 0 TO mmax: READ xxtan2(m): NEXT m

leestan:
 DATA .1,.25,.5,.75,1,1.2,1.3,1.4,1.42,1.44,1.46,1.48
 DATA 1.5,1.51,1.52,1.53,1.54,1.55,1.57

 DATA -5,-4,-3,-2,-1,-.5,-.25,-.2,-.15,-.1,-.08,-.06,-.04,-.02
 DATA .0
 DATA .02,.04,.06,.08,.1,.15,.2,.25,.5,1,2,3,4,5

RETURN

END

SUB coorcirkel
	FOR m = 0 TO mmax
	FOR n = 0 TO nmax
	str = r(n): hoek = m * delthoek
	x1(m, n) = str * COS(hoek)
	x2(m, n) = str * SIN(hoek)
	y1(m, n) = (1 / str) * COS(-hoek)
	y2(m, n) = (1 / str) * SIN(-hoek)
	NEXT n
	NEXT m
END SUB

SUB coorcosec
coorcosec:
	FOR n = 0 TO nmax
	FOR m = 0 TO mmax
	x1 = xx1sec(n)
	x2 = xx2sec(m)
	x1(m, n) = x1
	x2(m, n) = x2
	y2 = EXP(-x2) * COS(x1) - EXP(x2) * COS(-x1)
	y1 = EXP(-x2) * SIN(x1) - EXP(x2) * SIN(-x1)
	noem = y1 ^ 2 + y2 ^ 2
	y1(m, n) = 2 * y1 / noem
	y2(m, n) = 2 * y2 / noem
	NEXT m
	NEXT n
END SUB

SUB coorcosin
	FOR n = 0 TO nmax
	FOR m = 0 TO mmax
	x1 = xxsin1(n): x2 = xxsin2(m)
	x1(m, n) = x1
	x2(m, n) = x2
	y1(m, n) = .5 * COS(x1) * (EXP(x2) + EXP(-x2))
	y2(m, n) = -.5 * SIN(x1) * (EXP(x2) - EXP(-x2))
	NEXT m
	NEXT n
END SUB

SUB coorcupara
	FOR m = 0 TO mmax
	FOR n = 0 TO nmax
	str = rcupar(n): hoek = m * delthoek
	x1(m, n) = str * COS(hoek)
	x2(m, n) = str * SIN(hoek)
	y1(m, n) = (str ^ 3) * COS(3 * hoek)
	y2(m, n) = (str ^ 3) * SIN(3 * hoek)
	NEXT n
	NEXT m
END SUB

SUB coordubhyp
	FOR m = 0 TO mmax
	FOR n = 0 TO nmax
	st = rdub(n): hoek = m * delthoek
	x1(m, n) = st * COS(hoek)
	x2(m, n) = st * SIN(hoek)
	y1(m, n) = (.125 / (st * st)) * COS(-2 * hoek)
	y2(m, n) = (.125 / (st * st)) * SIN(-2 * hoek)
	NEXT n
	NEXT m
END SUB

SUB coorexpon
	FOR n = 0 TO nmax
	FOR m = 0 TO mmax
	x1 = xx1exp(n)
	x1(m, n) = x1
	x2(m, n) = -pi + m * deltx2
	x2 = x2(m, n)
	y1(m, n) = EXP(x1) * COS(x2)
	y2(m, n) = EXP(x1) * SIN(x2)
	NEXT m
	NEXT n
END SUB

SUB coorparab
	FOR m = 0 TO mmax
	FOR n = 0 TO nmax
	str = rpar(n): hoek = m * delthoek
	x1(m, n) = str * COS(hoek)
	x2(m, n) = str * SIN(hoek)
	y1(m, n) = (str ^ 2) * COS(2 * hoek)
	y2(m, n) = (str ^ 2) * SIN(2 * hoek)
	NEXT n
	NEXT m
END SUB

SUB coorsino
	rb = 0: re = 1.3: argb = 0: arge = 2 * pi
	FOR n = 0 TO nmax
	FOR m = 0 TO mmax
	r = rb + n * (re - rb) / nmax          '!!!
	arg = argb + m * (arge - argb) / mmax  '!!!
	x1(m, n) = r * COS(arg): x2(m, n) = r * SIN(arg)
	argy = COS(2 * arg) * r ^ 2
	mody = EXP(-SIN(2 * arg) * r ^ 2)
	y1(m, n) = (mody / 2 + 1 / (2 * mody)) * COS(argy) - 1
	y2(m, n) = (mody / 2 - 1 / (2 * mody)) * SIN(argy)
	NEXT m
	NEXT n
END SUB

SUB coorsinq
	rb = 0: re = .5: argb = 0: arge = 2 * pi
	FOR n = 0 TO nmax
	FOR m = 0 TO mmax
	r = rb + n * (re - rb) / nmax           '!!!
	arg = argb + m * (arge - argb) / mmax   '!!!
	x1(m, n) = r * COS(arg): x2(m, n) = r * SIN(arg)
	y1(m, n) = (SIN(2 * pi * r) ^ 2) * COS(arg)
	y2(m, n) = (SIN(2 * pi * r) ^ 2) * SIN(arg)
	NEXT m
	NEXT n
END SUB

SUB coortan
coortan:
	FOR n = 0 TO nmax
	FOR m = 0 TO mmax
	x1 = xxtan1(n)
	x2 = xxtan2(m)
	x1(m, n) = x1
	x2(m, n) = x2
	xi1 = EXP(-x2) * COS(x1): eta1 = EXP(-x2) * SIN(x1)
	xi2 = EXP(x2) * COS(-x1): eta2 = EXP(x2) * SIN(-x1)
	noem = (xi1 + xi2) ^ 2 + (eta1 + eta2) ^ 2
	y1(m, n) = ((eta1 - eta2) * (xi1 + xi2) + (-xi1 + xi2) * (eta1 + eta2)) / noem
	y2(m, n) = (-xi1 ^ 2 + xi2 ^ 2 - eta1 ^ 2 + eta2 ^ 2) / noem
	NEXT m
	NEXT n
END SUB

SUB figuur
SCREEN 12: CLS : COLOR 15
	PRINT "     Choice of figure Y=F(X) with X=x1+i*x2;Y=y1+i*y2:"
	PRINT "     ************************************************"
	PRINT : COLOR 7
	FOR i = 0 TO 10: LOCATE i + 4, 15: PRINT ffig$(i): NEXT i

LOCATE 28, 1: COLOR 3: PRINT "     >>> Choose and select figure with arrow keys <<<"

i = fig
in = i
IF mel = 1 THEN PLAY "p21l21o3dp21fp21g"

kiesfig:
IF INKEY$ = a$ AND TIMER - tijd < .1 GOTO verderfig
tijd = TIMER
IF in < 0 THEN in = 10
IF in > 10 THEN in = 0
COLOR 7: LOCATE i + 4, 15: PRINT ffig$(i)
i = in
COLOR 11: LOCATE i + 4, 15: PRINT ffig$(i)

verderfig:
SLEEP: a$ = INKEY$
SELECT CASE a$
CASE CHR$(13): GOTO bewerkfig
CASE CHR$(0) + "K": GOTO bewerkfig
CASE CHR$(0) + "M": GOTO bewerkfig
CASE CHR$(0) + "P": in = (i + 1): GOTO kiesfig
CASE CHR$(0) + "H": in = (i - 1): GOTO kiesfig
CASE ELSE: GOTO verderfig
END SELECT

bewerkfig:
fig = i
COLOR 15
CLS : COLOR 15
SELECT CASE fig
CASE 0:
tit$ = "X and Y unit axes    "
c$ = ""
CASE 1:
tit$ = "CIRCLE/HYPERBOLA Y=1/X"
CALL funcirkel
CASE 2
tit$ = "DOUBLE HYPERBOLA Y=1/X^2"
CALL fundubhyp
CASE 3
tit$ = "COSECANT"
CALL funcosec
CASE 4
tit$ = "EXPONENTIAL Y=EXP(X)"
CALL funexpon
CASE 5
tit$ = "PARABOLA Y=X*X"
CALL funparab
CASE 6
tit$ = "COSINE"
CALL funcosin
CASE 7
tit$ = "TANGENT"
CALL funtangens
CASE 8
tit$ = "SINUOID Ry=SIN(2pi Rx)"
CALL funsino
CASE 9
tit$ = "QUADSIN Y=sin^2 (X)"
CALL funsinq
CASE 10
tit$ = "CUBIC PARABOLA Y=X^3"
CALL funcupara
END SELECT

END SUB

SUB figuurtit
LOCATE 28, 1: COLOR 3
PRINT "     >>> Modify = type other value ; confirm with ENTER <<<    "
LOCATE 1, 15: COLOR 15: PRINT tit$
LOCATE 2, 15: FOR i = 1 TO LEN(tit$): PRINT "*"; : NEXT i: PRINT : PRINT
END SUB

SUB funcirkel
	m = 0: n = 0: nmax = 0
	CALL figuurtit
	COLOR 3
	PRINT "x1 = r * COS(angle) ; x2 = r * SIN(angle)"
	PRINT "y1 = (1/r) * COS(-angle) ; y2 = (1/r) * SIN(-angle)"
	PRINT
	COLOR 7: PRINT "mmax = number parameter curves 'angle' (= resolution figure)"
	COLOR 11: INPUT "  -> mmax? (default=18) : ", mmax
	IF mmax = 0 THEN mmax = 18
	COLOR 7: PRINT
	PRINT "deltr0 = step parameter curves 'r' (= resolution figure)"
	COLOR 11: INPUT "  -> deltr0? (default=1) : ", deltr0
	IF deltr0 = 0 THEN deltr0 = 1
	COLOR 7: PRINT
	PRINT "1 = full figure"
	PRINT "2 = half figure"
	PRINT "4 = 1/4  figure"
	COLOR 11: INPUT "  -> Choice ? (default=1) : ", arge
	IF arge = 0 THEN arge = 1
	COLOR 7: PRINT
	PRINT "fac = screen versus image size parm :"
	COLOR 11: INPUT "  -> fac ? (default=1.15) :", fac
	IF fac = 0 THEN fac = 1.15
	COLOR 7
	arge = 2 * pi / arge
	delthoek = arge / mmax
	rstart = .2: rstop = 1 / rstart
	rstop = 4: str = 1
	REDIM r(50)
	r(0) = str: tel = 0
straalcirkel:
	r(n) = str
	deltr = deltr0 * str * str / SQR(1 + str ^ 4)
	str = str + deltr
	IF str > rstop GOTO herschikcirkel
	tel = tel + 1
	n = n + 1
	GOTO straalcirkel

herschikcirkel:
	FOR i = 1 TO n: r(n + i) = r(i): NEXT i: r(n) = r(0)
	FOR i = 1 TO n: r(n - i) = 1 / r(n + i): NEXT i
	nmax = n * 2
END SUB

SUB funcosec
	CALL figuurtit
	COLOR 3
	PRINT "y2 = EXP(-x2) * COS(x1) - EXP(x2) * COS(-x1)"
	PRINT "y1 = EXP(-x2) * SIN(x1) - EXP(x2) * SIN(-x1)"
	PRINT
	COLOR 7: PRINT "fac = screen versus image size parm :"
	COLOR 11: INPUT "  -> fac ? (default=.02) :", fac
	IF fac = 0 THEN fac = .02
	COLOR 7
	k = 0
	m = 0: n = 0: nmax = 20 - 1: mmax = 29 - 1
	x1 = 0: x2 = 0: y1 = 0: y2 = 0
	REDIM xx1sec(nmax), xx2sec(mmax)
END SUB

SUB funcosin
	m = 0: n = 0: nmax = 0: k = 0
	CALL figuurtit
	COLOR 3
	PRINT "= two-bladed EXPONENTIAL:": PRINT
	PRINT "y1 = .5 * COS(x1) * (EXP(x2) + EXP(-x2))"
	PRINT "y2 = -.5 * SIN(x1) * (EXP(x2) - EXP(-x2))"
	PRINT
	COLOR 7: PRINT "ds1 = step parameter curves x1 (= resolution figure)"
	COLOR 11: INPUT "  -> ds1? (default=.3) : ", delts1
	IF delts1 = 0 THEN delts1 = .3
	COLOR 7: PRINT
	PRINT "ds2 = step parameter curves x2 (= resolution figure)"
	COLOR 11: INPUT "  -> ds2? (default=1.5) : ", delts2
	IF delts2 = 0 THEN delts2 = 1.5
	COLOR 7: PRINT
	PRINT "fac = screen versus image size parm :"
	COLOR 11: INPUT "  -> fac ? (default=1.1) :", fac
	IF fac = 0 THEN fac = 1.1
	COLOR 7

'''Initiate Space coordinates'''
'''***************************'''
	x1b = -pi: x1e = pi: x2b = -pi: x2e = pi
	x1 = .01: x2 = .01: deltx1 = 0: deltx2 = 0
	REDIM xxsin1(50), xxsin2(50)

x1cosin:
	xxsin1(n) = x1: deltx1 = delts1 / SQR(1 + SIN(x1) ^ 2)
	x1 = x1 + deltx1
	IF x1 > x1e GOTO redox1cosin
	n = n + 1
	GOTO x1cosin

redox1cosin:
	FOR k = 1 TO n: xxsin1(n + k) = xxsin1(k): NEXT k
	xxsin1(n) = xxsin1(0)
	FOR k = 1 TO n: xxsin1(n - k) = -xxsin1(n + k): NEXT k
	xxsin1(0) = x1b: xxsin1(2 * n) = x1e

x2cosin:
	xxsin2(m) = x2
	deltx2 = 2 * delts2 / SQR(EXP(-2 * x2) + EXP(2 * x2) + 2 * EXP(-x2) * EXP(x2) + 4)
	x2 = x2 + deltx2
	IF x2 > x2e GOTO redox2cosin
	m = m + 1
	GOTO x2cosin

redox2cosin:
	FOR k = 1 TO m: xxsin2(m + k) = xxsin2(k): NEXT k
	xxsin2(m) = xxsin2(0)
	FOR k = 1 TO m: xxsin2(m - k) = -xxsin2(m + k): NEXT k
	xxsin2(0) = x2b: xxsin2(2 * m) = x2e

	nmax = n * 2: mmax = m * 2
END SUB

SUB funcupara
	m = 0: n = 0: nmax = 0
	CALL figuurtit
	COLOR 3
	PRINT "x1 = r * COS(angle) ; x2 = r * SIN(angle)"
	PRINT "y1 = (r ^ 3) * COS(3 * angle)"
	PRINT "y2 = (r ^ 3) * SIN(3 * angle)"
	PRINT
	COLOR 7: PRINT "mmax = number parameter curves 'angle' (= resolution figure)"
	COLOR 11: INPUT "  -> mmax? (default=36) : ", mmax
	IF mmax = 0 THEN mmax = 36
	COLOR 7: PRINT
	PRINT "deltr0 = step parameter curves 'r' (= resolution figure)"
	COLOR 11: INPUT "  -> deltr0? (default=1) : ", deltr0
	IF deltr0 = 0 THEN deltr0 = 1
	COLOR 7: PRINT
	PRINT "3 = full figure"
	PRINT "2 = 2/3 figure"
	PRINT "1 = 1/3 figure"
	COLOR 11: INPUT "  -> Choice ? (default=3) : ", arge
	IF arge = 0 THEN arge = 3
	COLOR 7: PRINT
	PRINT "fac = screen versus image size parm :"
	COLOR 11: INPUT "  -> fac ? (default=1.2) :", fac
	IF fac = 0 THEN fac = 1.2
	COLOR 7

'''Initiate Space coordinates'''
'''***************************'''
	rstart = 0!: rstop = 2!: deltr = 0!: str = rstart
	REDIM rcupar(50)
	arge = 2 * pi * arge / 3
	delthoek = arge / mmax

straalcupara:
	rcupar(n) = str: deltr = deltr0 / SQR(1 + 9 * str ^ 4)
	deltr = deltr * (str + .1)  '''=finer around 0-point
	str = str + deltr
	IF str > rstop THEN nmax = n: EXIT SUB
	n = n + 1
	GOTO straalcupara
END SUB

SUB fundubhyp
	m = 0: n = 0: nmax = 0
	CALL figuurtit
	COLOR 3
	PRINT "Y = .125 / X^2 , or"
	PRINT "x1 = r * COS(angle) ; x2 = r * SIN(angle)"
	PRINT "y1 = (.125 / (r * r)) * COS(-2 * angle)"
	PRINT "y2 = (.125 / (r * r)) * SIN(-2 * angle)"
	PRINT
	COLOR 7: PRINT "mmax = number parameter curves 'angle' (= resolution figure)"
	COLOR 11: INPUT "  -> mmax? (default=36) : ", mmax
	IF mmax = 0 THEN mmax = 36
	COLOR 7: PRINT
	PRINT "deltr0 = step parameter curves 'r' (= resolution figure)"
	COLOR 11: INPUT "  -> deltr0? (default=.5) : ", deltr0
	IF deltr0 = 0 THEN deltr0 = .5
	COLOR 7: PRINT
	PRINT "1 = full figure"
	PRINT "2 = half figure"
	PRINT "4 = 1/4  figure"
	COLOR 11: INPUT "  -> Choice ? (default=1) : ", arge
	IF arge = 0 THEN arge = 1
	COLOR 7: PRINT
	PRINT "fac = screen versus image size parm :"
	COLOR 11: INPUT "  -> fac ? (default=1) :", fac
	IF fac = 0 THEN fac = 1
	COLOR 7
	arge = 2 * pi / arge
	delthoek = arge / mmax
	rstart = .2: rstop = 3.5: str = rstart
	REDIM rdub(50)

straaldubhyp:
	rdub(n) = str: deltr = deltr0 * 4 * str ^ 3 / SQR(16 * str ^ 6 + 1)
	str = str + deltr
	IF str > rstop THEN nmax = n: EXIT SUB
	n = n + 1
	GOTO straaldubhyp
END SUB

SUB funexpon
	m = 0: n = 0: nmax = 0
	CALL figuurtit
	COLOR 3
	PRINT "y1 = EXP(x1) * COS(x2)"
	PRINT "y2 = EXP(x1) * SIN(x2)"
	PRINT
	COLOR 7: PRINT "mmax = number parameter curves x2 (= resolution figure)"
	COLOR 11: INPUT "  -> mmax? (default=8) : ", mmax
	IF mmax = 0 THEN mmax = 8
	deltx2 = 2 * pi / mmax
	COLOR 7: PRINT
	PRINT "deltx1 = step parameter curves x1 (= resolution figure)"
	COLOR 11: INPUT "  -> deltx1? (default=1) : ", deltx1
	IF deltx1 = 0 THEN deltx1 = 1
	COLOR 7: PRINT
	PRINT "fac = screen versus image size parm :"
	COLOR 11: INPUT "  -> fac ? (default=1.2) :", fac
	IF fac = 0 THEN fac = 1.2
	COLOR 7

'''Initiate Space coordinates'''
'''***************************'''
	x1b = -4: x1e = 2: x2b = -pi: x2e = pi
	REDIM xx1exp(50)
	x1 = x1b

x1expon:
	xx1exp(n) = x1: deltx = deltx1 / SQR(1 + EXP(2 * x1))
	x1 = x1 + deltx
	IF x1 > x1e THEN nmax = n: EXIT SUB
	n = n + 1
	GOTO x1expon
END SUB

SUB funparab
	m = 0: n = 0: nmax = 0
	CALL figuurtit
	COLOR 3
	PRINT "x1 = r * COS(angle) ; x2 = r * SIN(angle)"
	PRINT "y1 = (r ^ 2) * COS(2 * angle)"
	PRINT "y2 = (r ^ 2) * SIN(2 * angle)"
	PRINT
	COLOR 7: PRINT "mmax = number parameter curves 'angle' (= resolution figure)"
	COLOR 11: INPUT "  -> mmax? (default=24) : ", mmax
	IF mmax = 0 THEN mmax = 24
	COLOR 7: PRINT
	PRINT "deltr0 = step parameter curves 'r' (= resolution figure)"
	COLOR 11: INPUT "  -> deltr0? (default=.4) : ", deltr0
	IF deltr0 = 0 THEN deltr0 = .4
	COLOR 7: PRINT
	PRINT "1 = full figure"
	PRINT "2 = half figure"
	PRINT "4 = 1/4  figure"
	COLOR 11: INPUT "  -> Choice ? (default=1) : ", arge
	IF arge = 0 THEN arge = 1
	COLOR 7: PRINT
	PRINT "fac = screen versus image size parm :"
	COLOR 11: INPUT "  -> fac ? (default=1.2) :", fac
	IF fac = 0 THEN fac = 1.2
	COLOR 7

'''Initiate Space coordinates'''
'''***************************'''
	rstart = 0!: rstop = 2!: deltr = 0!: str = rstart
	REDIM rpar(50)
	arge = 2 * pi / arge
	delthoek = arge / mmax

straalparab:
'''     rpar(n) = str: deltr = deltr0 * 2 * str ^ 2 / SQR(4 * str ^ 4 + 1)
	rpar(n) = str: deltr = deltr0 / SQR(1 + 4 * str ^ 2)
	str = str + deltr
	IF str > rstop THEN nmax = n: EXIT SUB
	n = n + 1
	GOTO straalparab
END SUB

SUB funsino
	m = 0: n = 0
	CALL figuurtit
	COLOR 3
	PRINT "x1 = r * COS(arg): x2 = r * SIN(arg)"
	PRINT "argy = COS(2 * arg) * r ^ 2"
	PRINT "mody = EXP(-SIN(2 * arg) * r ^ 2)"
	PRINT "y1 = (mody / 2 + 1 / (2 * mody)) * COS(argy) - 1"
	PRINT "y2 = (mody / 2 - 1 / (2 * mody)) * SIN(argy)"
	PRINT
	COLOR 7: PRINT "nmax = number parameter curves x1 (= resolution figure)"
	COLOR 11: INPUT "  -> nmax? (default=12) : ", nmax
	IF nmax = 0 THEN nmax = 12
	COLOR 7: PRINT
	PRINT "mmax = number parameter curves  x2 (= resolution figure)"
	COLOR 11: INPUT "  -> mmax? (default=72) : ", mmax
	IF mmax = 0 THEN mmax = 72
	COLOR 7: PRINT
	PRINT "fac = screen versus image size parm :"
	COLOR 11: INPUT "  -> fac ? (default=1) :", fac
	IF fac = 0 THEN fac = 1
	COLOR 7
END SUB

SUB funsinq
	m = 0: n = 0
	CALL figuurtit
	COLOR 3
	PRINT "x1 = r * COS(arg): x2 = r * SIN(arg)"
	PRINT "y1 = (SIN(2 * pi * r) ^ 2) * COS(arg)"
	PRINT "y2 = (SIN(2 * pi * r) ^ 2) * SIN(arg)"
	PRINT
	COLOR 7: PRINT "nmax = number parameter curves x1 (= resolution figure)"
	COLOR 11: INPUT "  -> nmax? (default=18) : ", nmax
	IF nmax = 0 THEN nmax = 18
	COLOR 7: PRINT
	PRINT "mmax = number parameter curves x2 (= resolution figure)"
	COLOR 11: INPUT "  -> mmax? (default=18) : ", mmax
	IF mmax = 0 THEN mmax = 18
	COLOR 7: PRINT
	PRINT "fac = screen versus image size parm :"
	COLOR 11: INPUT "  -> fac ? (default=1) :", fac
	IF fac = 0 THEN fac = 1
	COLOR 7
END SUB

SUB funtangens
	CALL figuurtit
	COLOR 3
	PRINT "xi1 = EXP(-x2) * COS(x1): eta1 = EXP(-x2) * SIN(x1)"
	PRINT "xi2 = EXP(x2) * COS(-x1): eta2 = EXP(x2) * SIN(-x1)"
	PRINT "noem = (xi1 + xi2) ^ 2 + (eta1 + eta2) ^ 2"
	PRINT "y1 = ((eta1 - eta2) * (xi1 + xi2) + (-xi1 + xi2) * (eta1 + eta2)) / noem"
	PRINT "y2 = (-xi1 ^ 2 + xi2 ^ 2 - eta1 ^ 2 + eta2 ^ 2) / noem"
	PRINT : COLOR 7: PRINT
	PRINT "fac = screen versus image size parm :"
	COLOR 11: INPUT "  -> fac ? (default=.0075) :", fac
	IF fac = 0 THEN fac = .0075
	COLOR 7
	m = 0: n = 0: k = 0
	nmax = 19 - 1: mmax = 29 - 1
	x1 = 0: x2 = 0: y1 = 0: y2 = 0
	xi1 = 0: xi2 = 0: eta1 = 0: eta2 = 0: noem = 0
	REDIM xxtan1(nmax), xxtan2(mmax)
END SUB

SUB intro
SCREEN 12: CLS : COLOR 11
IF mel = 1 THEN PLAY "p18l18o3cdfa>c"
PRINT "Welcome in 2D COMPLEXITY land !                              >1/4"
COLOR 7: PRINT : PRINT
PRINT "A variety of "; : COLOR 11: PRINT "4D REALITY land"
PRINT : COLOR 7
PRINT "It harbours complex functions of the kind Y=F(X)"
PRINT "In reality land their counterparts would be written"
PRINT "y1=f1(x1,x2); y2=f2(x1,x2), where X=x1+i*x2, Y=y1+i*y2"
PRINT
PRINT "Complexity land (X,Y) is thus a peculiar appearance of"
PRINT "reality land (x1,x2,y1,y2)"
PRINT
PRINT "The function F determines a 1D part (a 'curve') of 2D complexity land,"
PRINT "so its counterpart (f1,f2) will cover a 2D part (a surface) in 4D reality land"
PRINT
PRINT "Hence one thinks, no way of beholding it, because of 4D..."
PRINT "Whereas it should suffice to remember the technique of showing"
PRINT "3D surfaces on paper: by tracing two families of curves;"
PRINT "and apply this same technique for 4D surfaces."
PRINT
PRINT "Previously we have to determine the projections of all axes"
PRINT "x1,x2,y1,y2 upon the paper plane (u,v) (whose axes we  "
PRINT "first of all identify with the ones of the real plane: (x1,y1)"
PRINT
LOCATE 28, 15: COLOR 3: PRINT ">>> press a key <<<   "
SLEEP: a$ = INKEY$

CLS : COLOR 11
IF mel = 1 THEN PLAY "l18o3g"
PRINT "Welcome in 2D COMPLEXITY land !                              >2/4"
COLOR 7: PRINT : PRINT
PRINT "In order to assemble the figure we should then specify"
PRINT "the FUNCTION F, that is, the real functions f1 and f2."
PRINT
PRINT "Next, we must find suitable parameter curves"
PRINT "This is a matter of trying, for each FUNCTION"
PRINT "The result is the calculation of two parameter families,"
PRINT "m and n, so that x1=x1(m,n), x2=x2(m,n),"
PRINT "and corresponding y1(m,n) and y2(m,n) values will build up"
PRINT "a suitable network of coordinates"
PRINT
PRINT "Now we proceed to showing the figure, and rotating it"
PRINT "The rotation is applied to one or two"
PRINT "out of the four axes x1,x2,y1,y2"
PRINT "We may even rotate two planes at once"
PRINT "This way, thirteen rotations are possible"
PRINT
PRINT "The rotations themselves may be viewed as 'zero figure'"
PRINT "ie with no other figure selected (be sure to take a small enough step)"
PRINT
PRINT "Finally you may also want to modify length and angle of"
PRINT "the projective axes x2 and y2 "
LOCATE 28, 15: COLOR 3: PRINT ">>> press a key <<<   "
SLEEP: a$ = INKEY$

CLS : COLOR 11
IF mel = 1 THEN PLAY "l18o3e"
PRINT "Welcome in 2D COMPLEXITY land !                              >3/4"
COLOR 7: PRINT : PRINT
PRINT "As one ought to expect, displaying a complex FUNCTION"
PRINT "reveals algebraicly related real functions to be"
PRINT "subsets of this figure"
PRINT
PRINT "Thus the 'real' circle and hyperbola ('complexly' identical)"
PRINT "prove to be parameter curves of complex CIRCLE, or HYPERBOLA"
PRINT "Other examples include, for COSINE: cosine, cosh and sinh"
PRINT "(hyperbolic sine and cos);"
PRINT "for TANGENT: tan, tanh and cotanh; etcetera"
PRINT
PRINT "Optionally those specific curves can be asked to be emphasized,"
PRINT "according to the figure displayed"
PRINT
PRINT "Other options, regardless the figure, include"
PRINT "number of rotation steps within 360ø,"
PRINT "wait or not after each display,"
PRINT "show or not unit axes or -planes,"
PRINT "scan or not parameter curves"
LOCATE 28, 15: COLOR 3: PRINT ">>> press a key <<<   "
SLEEP: a$ = INKEY$

CLS : COLOR 11
IF mel = 1 THEN PLAY "l18o3c"
PRINT "Welcome in 2D COMPLEXITY land !                              >4/4"
PRINT : PRINT : COLOR 15
PRINT "Enjoy admiring these 4D objects !!!"
PRINT : PRINT : COLOR 7
PRINT "PS: Whoever has more ideas about the subject or otherwise"
PRINT "indulges in creative maths is warmly invited to exchange"
PRINT "views and findings with the author"
PRINT : COLOR 10
LOCATE 25, 14
PRINT "Credits: guido wuyts 1995"
LOCATE 28, 15: COLOR 3: PRINT ">>> press a key <<<   "
SLEEP: a$ = INKEY$: a$ = ""
END SUB

SUB melo
COLOR 11

kiesmelo:
IF mel < 1 THEN mel = 2
IF mel > 2 THEN mel = 1
LOCATE 4, 48: PRINT mel$(mel)

Verdermelo:
SLEEP: a$ = INKEY$
SELECT CASE a$
CASE CHR$(13): GOTO bewerkmelo
CASE CHR$(0) + "P": mel = mel - 1: GOTO kiesmelo
CASE CHR$(0) + "H": mel = mel + 1: GOTO kiesmelo
CASE CHR$(0) + "K": mel = mel - 1: GOTO kiesmelo
CASE CHR$(0) + "M": mel = mel + 1: GOTO kiesmelo
CASE ELSE: GOTO Verdermelo
END SELECT

bewerkmelo:
COLOR 7
LOCATE 4, 48: PRINT mel$(mel)
END SUB

SUB menu
SCREEN 12
	CLS : COLOR 15
	LOCATE 1, 16: PRINT tit$
	c$ = "": FOR i = 1 TO LEN(tit$): c$ = c$ + "*": NEXT i
	LOCATE 2, 16: PRINT c$
	mentot = 6
	COLOR 7: FOR i = 0 TO mentot: LOCATE i + 4, 14: PRINT fmen$(i): NEXT i
       
LOCATE 28, 1: COLOR 3: PRINT "     >>> Choose ans select option with arrow keys <<<"
jn = 0: j = 0
IF mel = 1 THEN PLAY "l21o3cp21gp21>c"

kiesmenu:
IF INKEY$ = a$ AND TIMER - tijd < .1 GOTO verdermenu
tijd = TIMER
IF jn = -1 THEN jn = mentot
COLOR 7: LOCATE j + 4, 14: PRINT fmen$(j)
j = jn
COLOR 11: LOCATE j + 4, 14: PRINT fmen$(j)

verdermenu:
SLEEP: a$ = INKEY$
SELECT CASE a$
CASE CHR$(13): GOTO bewerkmenu
CASE CHR$(0) + "K": GOTO bewerkmenu
CASE CHR$(0) + "M": GOTO bewerkmenu
CASE CHR$(0) + "P": jn = (j + 1) MOD (mentot + 1): GOTO kiesmenu
CASE CHR$(0) + "H": jn = (j - 1) MOD (mentot + 1): GOTO kiesmenu
CASE ELSE: GOTO verdermenu
END SELECT

bewerkmenu:
men = j
SELECT CASE men
CASE 0
COLOR 3: LOCATE 28, 5: PRINT " >>> One second please...                            "
COLOR 15: LOCATE 25, 5: PRINT " >>> Computing figure <<<                "
CALL prefscol
EXIT SUB
CASE 1: CALL figuur: EXIT SUB
CASE 2: CALL rotkeus: EXIT SUB
CASE 3: CALL projas: EXIT SUB
CASE 4: CALL prefs: EXIT SUB
CASE 5: CALL intro
CASE ELSE  '''(mentot =  -> END) '''
IF mel = 1 THEN PLAY "l21o3c"
LOCATE 28, 1: COLOR 0: PRINT "     >>> Choose option with corsor keys <<<"
LOCATE 28, 1: COLOR 3
COLOR 3: LOCATE 28, 5: PRINT " >>> ENTER = Don't stop <<<                         "
COLOR 15: LOCATE 25, 5: PRINT "        Are you sure ?"
SLEEP: a$ = INKEY$
IF a$ <> CHR$(13) THEN
IF mel = 1 THEN PLAY "p18l18o4c<gfdc"
END
END IF
COLOR 0: LOCATE 25, 5: PRINT "        Are you sure ?"
LOCATE 28, 1: COLOR 3: PRINT "     >>> Choose and select option with arrow keys <<<"
IF mel = 1 THEN PLAY "l21o3cp21gp21>c"
GOTO verdermenu
END SELECT
END SUB

SUB prefs
SCREEN 12: CLS : COLOR 15
PRINT "               Preferences"
PRINT "               ***********"
LOCATE 28, 1: COLOR 3
PRINT "     >>> Choose and toggle option with arrow keys; confirm= ENTER <<<"
COLOR 7
FOR i = 1 TO 7: LOCATE 3 + i, 15: PRINT afb$(i): NEXT i
FOR i = 1 TO 7: LOCATE 3 + i, 45: COLOR col(i): PRINT afb1$(i): NEXT i
FOR i = 1 TO 7: LOCATE 3 + i, 55: COLOR 18 - col(i): PRINT afb2$(i): NEXT i

i = 1
in = i
IF mel = 1 THEN PLAY "p21l21o3fp21gp21c"

kiesafb:
IF INKEY$ = a$ AND TIMER - tijd < .1 GOTO verderafb
tijd = TIMER
IF in < 1 THEN in = 7
IF in > 7 THEN in = 1
COLOR 7: LOCATE i + 3, 15: PRINT afb$(i)
i = in
COLOR 11: LOCATE i + 3, 15: PRINT afb$(i)

verderafb:
SLEEP: a$ = INKEY$
SELECT CASE a$
CASE CHR$(13): EXIT SUB '''GOTO bewerkafb
CASE CHR$(0) + "K": GOTO bewerkafb
CASE CHR$(0) + "M": GOTO bewerkafb
CASE CHR$(0) + "P": in = (i + 1): GOTO kiesafb
CASE CHR$(0) + "H": in = (i - 1): GOTO kiesafb
CASE ELSE: GOTO verderafb
END SELECT

bewerkafb:
col(i) = 18 - col(i)
LOCATE 3 + i, 45: COLOR col(i): PRINT afb1$(i)
LOCATE 3 + i, 55: COLOR 18 - col(i): PRINT afb2$(i)
IF i = 7 THEN CALL prefsmore: EXIT SUB
GOTO verderafb
END SUB

SUB prefscol
IF scr < 3 THEN
colm = 6: coln = 3: colmm = 12: colnn = 11
colx = 11: coly = 13
colcrv1 = 10: colcrv2 = 9: colcrv3 = 14
ELSE
colm = 4: coln = 1: colmm = 14: colnn = 11
colx = 3: coly = 5
colcrv1 = 2: colcrv2 = 13: colcrv3 = 12
END IF
END SUB

SUB prefsmore
SCREEN 12: CLS : COLOR 15
PRINT "               Preferences (more)"
PRINT "               ******************"
LOCATE 28, 1: COLOR 3
PRINT "     >>> Choose and toggle option with arrow keys; confirm= ENTER <<<"
COLOR 7
FOR i = 1 TO 5: LOCATE 3 + i, 15: PRINT afb3$(i): NEXT i
LOCATE 4, 48: PRINT mel$(mel)
LOCATE 5, 48: PRINT scr$(scr)
LOCATE 6, 45: PRINT USING "#### x ####.##ø"; nrot; drot
LOCATE 7, 45: PRINT USING "#### "; scan

i = 1
in = i
IF mel = 1 THEN PLAY "p21l21o3fp21gp21c"

kiesafb3:
IF INKEY$ = a$ AND TIMER - tijd < .1 GOTO verderafb3
tijd = TIMER
IF in < 1 THEN in = 5
IF in > 5 THEN in = 1
COLOR 7: LOCATE i + 3, 15: PRINT afb3$(i)
i = in
COLOR 11: LOCATE i + 3, 15: PRINT afb3$(i)

verderafb3:
SLEEP: a$ = INKEY$
SELECT CASE a$
CASE CHR$(13): EXIT SUB
CASE CHR$(0) + "K": GOTO bewerkafb3
CASE CHR$(0) + "M": GOTO bewerkafb3
CASE CHR$(0) + "P": in = (i + 1): GOTO kiesafb3
CASE CHR$(0) + "H": in = (i - 1): GOTO kiesafb3
CASE ELSE: GOTO verderafb3
END SELECT

bewerkafb3:
SELECT CASE i
CASE 1: CALL melo
CASE 2: CALL schermkleur
CASE 3: CALL rotstap
CASE 4: CALL scanmax
CASE 5: CALL scanmod
END SELECT
GOTO verderafb3
END SUB

SUB projas
CLS :  SCREEN 12
xy = 1.3: WINDOW (-2 * xy, -2)-(2 * xy, 2)
COLOR 15: PRINT "     Projective axes "; :
COLOR 11: PRINT "x2 "; : COLOR 15: PRINT "and "; : COLOR 13: PRINT "y2 "
COLOR 15: PRINT "     *************************"
LOCATE 26, 1: COLOR 3
PRINT "     >>> Modify length by  '+' or '-' <<<"
PRINT "     >>>    angle by cursor keys      <<<"
PRINT "     >>>      confirm by   ENTER      <<<"
LOCATE 7, 1: COLOR 7: PRINT "Len y2 = "; : PRINT USING "#.##"; b
LOCATE 8, 1: PRINT "Arg y2 = "; : PRINT USING "#### ø"; bet
IF mel = 1 THEN PLAY "p21l21o3gp21fp21e"

'x2-axis
'*****
an = a: alfr = alf * pi / 180: alfn = alf

kiesalf:
IF INKEY$ = a$ AND TIMER - tijd < .1 GOTO verderalf
tijd = TIMER
IF an < 0 THEN an = 0
LINE (0, 0)-(a * COS(alfr), a * SIN(alfr)), 0
alf = alfn: a = an: alfr = alf * pi / 180
LOCATE 4, 1: COLOR 7: PRINT "Len x2 = "; : COLOR 11: PRINT USING "#.##"; a
LOCATE 5, 1: COLOR 7: PRINT "Arg x2 = "; : COLOR 11: PRINT USING "#### ø"; alf
LINE (0, 0)-(0, 1), 7: LINE (0, 0)-(1, 0), 3
LINE (0, 0)-(b * ccb, b * ssb), 7
LINE (0, 0)-(a * COS(alfr), a * SIN(alfr)), 11

verderalf:
SLEEP: a$ = INKEY$
SELECT CASE a$
CASE CHR$(13)
GOTO bewerkalf
CASE CHR$(0) + "K": alfn = alf - 1: GOTO kiesalf
CASE CHR$(0) + "M": alfn = alf + 1: GOTO kiesalf
CASE CHR$(0) + "P": alfn = alf - 10: GOTO kiesalf
CASE CHR$(0) + "H": alfn = alf + 10: GOTO kiesalf
CASE "-": an = a - .05: GOTO kiesalf
CASE "+": an = a + .05: GOTO kiesalf
CASE ELSE: GOTO verderalf
END SELECT

bewerkalf:
alfr = alf * pi / 180
tta = TAN(alfr): cca = COS(alfr): ssa = SIN(alfr)

'y2-axis
'*****
bn = b
betr = bet * pi / 180: betn = bet

kiesbet:
IF INKEY$ = a$ AND TIMER - tijd < .1 GOTO verderbet
tijd = TIMER
IF bn < 0 THEN bn = 0
LINE (0, 0)-(b * COS(betr), b * SIN(betr)), 0
bet = betn: b = bn: betr = bet * pi / 180
LOCATE 7, 1: COLOR 7: PRINT "Len y2 = "; : COLOR 13: PRINT USING "#.##"; b
LOCATE 8, 1: COLOR 7: PRINT "Arg y2 = "; : COLOR 13: PRINT USING "#### ø"; bet
LINE (0, 0)-(0, 1), 5: LINE (0, 0)-(1, 0), 7
LINE (0, 0)-(a * cca, a * ssa), 7
LINE (0, 0)-(b * COS(betr), b * SIN(betr)), 13

verderbet:
SLEEP: a$ = INKEY$
SELECT CASE a$
CASE CHR$(13)
GOTO bewerkbet
CASE CHR$(0) + "K": betn = bet - 1: GOTO kiesbet
CASE CHR$(0) + "M": betn = bet + 1: GOTO kiesbet
CASE CHR$(0) + "P": betn = bet - 10: GOTO kiesbet
CASE CHR$(0) + "H": betn = bet + 10: GOTO kiesbet
CASE "-": bn = b - .05: GOTO kiesbet
CASE "+": bn = b + .05: GOTO kiesbet
CASE ELSE: GOTO verderbet
END SELECT

bewerkbet:
betr = bet * pi / 180
ttb = TAN(betr): ccb = COS(betr): ssb = SIN(betr)
END SUB

SUB rot1
rot$ = "rotation 1: x1-axis only"
FOR xi = 0 TO 360 STEP drot
xxi = xi * pi / 180
ssi = SIN(xxi): cci = COS(xxi)
u1 = cci: v1 = ssi
u2 = a * cca: v2 = a * ssa
u3 = 0: v3 = 1
u4 = b * ccb: v4 = b * ssb
SELECT CASE fig
CASE 0:
CALL tekenxy    '''axes X and Y'''
CASE ELSE:
CALL tekencoord  '''(u,v)'''
CALL tekenen     '''figure FOR xi'''
END SELECT
NEXT xi
END SUB

SUB rot10
rot$ = "rotation 10: x2-y1 plane"
FOR xi = 0 TO 360 STEP drot
xxi = xi * pi / 180
ssi = SIN(xxi): cci = COS(xxi)
u1 = 1: v1 = 0
u2 = a * cca * cci: v2 = a * ssa * cci + ssi
u3 = -a * cca * ssi: v3 = -a * ssa * ssi + cci
u4 = b * ccb: v4 = b * ssb
SELECT CASE fig
CASE 0:
CALL tekenxy    '''axes X and Y'''
CASE ELSE:
CALL tekencoord  '''u,v'''
CALL tekenen     '''figure(xi)'''
END SELECT
NEXT xi
END SUB

SUB rot11
rot$ = "rotation 11: X-plane & Y-plane"
FOR xi = 0 TO 360 STEP drot
xxi = xi * pi / 180
ssi = SIN(xxi): cci = COS(xxi)
u1 = cci + a * cca * ssi: v1 = a * ssa * ssi
u2 = -ssi + a * cca * cci: v2 = a * ssa * cci
u3 = b * ccb * ssi: v3 = cci + b * ssb * ssi
u4 = b * ccb * cci: v4 = -ssi + b * ssb * cci
SELECT CASE fig
CASE 0:
CALL tekenxy    '''axes X and Y'''
CASE ELSE:
CALL tekencoord  '''u,v'''
CALL tekenen     '''figure(xi)'''
END SELECT
NEXT xi
END SUB

SUB rot12
rot$ = "rotation 12: x1-y1 & x2-y2 planes"
FOR xi = 0 TO 360 STEP drot
xxi = xi * pi / 180
ssi = SIN(xxi): cci = COS(xxi)
u1 = cci: v1 = ssi
u2 = a * cca * cci + b * ccb * ssi: v2 = a * ssa * cci + b * ssb * ssi
u3 = -ssi: v3 = cci
u4 = -a * cca * ssi + b * ccb * cci: v4 = -a * ssa * ssi + b * ssb * cci
SELECT CASE fig
CASE 0:
CALL tekenxy    '''axes X and Y'''
CASE ELSE:
CALL tekencoord  '''u,v'''
CALL tekenen     '''figure(xi)'''
END SELECT
NEXT xi
END SUB

SUB rot13
rot$ = "rotation 13: x1-y2 & x2-y1 planes"
FOR xi = 0 TO 360 STEP drot
xxi = xi * pi / 180
ssi = SIN(xxi): cci = COS(xxi)
u1 = cci + b * ccb * ssi: v1 = b * ssb * ssi
u2 = a * cca * cci: v2 = a * ssa * cci + ssi
u3 = -a * cca * ssi: v3 = -a * ssa * ssi + cci
u4 = -ssi + b * ccb * cci: v4 = b * ssb * cci
SELECT CASE fig
CASE 0:
CALL tekenxy    '''axes X and Y'''
CASE ELSE:
CALL tekencoord  '''u,v'''
CALL tekenen     '''figure(xi)'''
END SELECT
NEXT xi
END SUB

SUB rot2
rot$ = "rotation 2: y1-axis only"
FOR xi = 0 TO 360 STEP drot
xxi = xi * pi / 180
ssi = SIN(xxi): cci = COS(xxi)
u1 = 1: v1 = 0
u2 = a * cca: v2 = a * ssa
u3 = -ssi: v3 = cci
u4 = b * ccb: v4 = b * ssb
SELECT CASE fig
CASE 0:
CALL tekenxy    '''axes X and Y'''
CASE ELSE:
CALL tekencoord  '''u,v'''
CALL tekenen     '''figure(xi)'''
END SELECT
NEXT xi
END SUB

SUB rot3
rot$ = "rotation 3: x2-axis only"
FOR xi = 0 TO 360 STEP drot
xxi = xi * pi / 180
ssi = SIN(xxi): cci = COS(xxi)
u1 = 1: v1 = 0
u2 = a * COS(alfr + xxi): v2 = a * SIN(alfr + xxi)
u3 = 0: v3 = 1
u4 = b * ccb: v4 = b * ssb
SELECT CASE fig
CASE 0:
CALL tekenxy    '''assen X en Y'''
CASE ELSE:
CALL tekencoord  '''u,v'''
CALL tekenen     '''figuur(xi)'''
END SELECT
NEXT xi
END SUB

SUB rot4
rot$ = "rotation 4: y2-as only"
FOR xi = 0 TO 360 STEP drot
xxi = xi * pi / 180
ssi = SIN(xxi): cci = COS(xxi)
u1 = 1: v1 = 0
u2 = a * cca: v2 = a * ssa
u3 = 0: v3 = 1
u4 = b * COS(betr + xxi): v4 = b * SIN(betr + xxi)
SELECT CASE fig
CASE 0:
CALL tekenxy    '''assen X en Y'''
CASE ELSE:
CALL tekencoord  '''u,v'''
CALL tekenen     '''figuur(xi)'''
END SELECT
NEXT xi
END SUB

SUB rot5
rot$ = "rotation 5: X-plane"
FOR xi = 0 TO 360 STEP drot
xxi = xi * pi / 180
ssi = SIN(xxi): cci = COS(xxi)
u1 = cci + a * cca * ssi: v1 = a * ssa * ssi
u2 = -ssi + a * cca * cci: v2 = a * ssa * cci
u3 = 0: v3 = 1
u4 = b * ccb: v4 = b * ssb
SELECT CASE fig
CASE 0:
CALL tekenxy    '''assen X en Y'''
CASE ELSE:
CALL tekencoord  '''u,v'''
CALL tekenen     '''figuur(xi)'''
END SELECT
NEXT xi
END SUB

SUB rot6
rot$ = "rotation 6: Y-plane"
FOR xi = 0 TO 360 STEP drot
xxi = xi * pi / 180
ssi = SIN(xxi): cci = COS(xxi)
u1 = 1: v1 = 0
u2 = a * cca: v2 = a * ssa
u3 = b * ccb * ssi: v3 = cci + b * ssb * ssi
u4 = b * ccb * cci: v4 = -ssi + b * ssb * cci
SELECT CASE fig
CASE 0:
CALL tekenxy    '''assen X en Y'''
CASE ELSE:
CALL tekencoord  '''u,v'''
CALL tekenen     '''figuur(xi)'''
END SELECT
NEXT xi
END SUB

SUB rot7
rot$ = "rotation 7: x1-y1 plane"
FOR xi = 0 TO 360 STEP drot
xxi = xi * pi / 180
ssi = SIN(xxi): cci = COS(xxi)
u1 = cci: v1 = ssi
u2 = a * cca: v2 = a * ssa
u3 = -ssi: v3 = cci
u4 = b * ccb: v4 = b * ssb
SELECT CASE fig
CASE 0:
CALL tekenxy    '''assen X en Y'''
CASE ELSE:
CALL tekencoord  '''u,v'''
CALL tekenen     '''figuur(xi)'''
END SELECT
NEXT xi
END SUB

SUB rot8
rot$ = "rotation 8: x2-y2 plane"
FOR xi = 0 TO 360 STEP drot
xxi = xi * pi / 180
ssi = SIN(xxi): cci = COS(xxi)
u1 = 1: v1 = 0        ''' vaste as
u2 = a * cca * cci + b * ccb * ssi: v2 = a * ssa * cci + b * ssb * ssi
u3 = 0: v3 = 1        ''' vaste as
u4 = -a * cca * ssi + b * ccb * cci: v4 = -a * ssa * ssi + b * ssb * cci
SELECT CASE fig
CASE 0:
CALL tekenxy    '''assen X en Y'''
CASE ELSE:
CALL tekencoord  '''u,v'''
CALL tekenen     '''figuur(xi)'''
END SELECT
NEXT xi
END SUB

SUB rot9
rot$ = "rotation 9: x1-y2 plane"
FOR xi = 0 TO 360 STEP drot
xxi = xi * pi / 180
ssi = SIN(xxi): cci = COS(xxi)
u1 = cci + b * ccb * ssi: v1 = b * ssb * ssi
u2 = a * cca: v2 = a * ssa
u3 = 0: v3 = 1
u4 = -ssi + b * ccb * cci: v4 = b * ssb * cci
SELECT CASE fig
CASE 0:
CALL tekenxy    '''assen X en Y'''
CASE ELSE:
CALL tekencoord  '''u,v'''
CALL tekenen     '''figuur(xi)'''
END SELECT
NEXT xi
END SUB

SUB rotkeus
SCREEN 12
	CLS : COLOR 15
	PRINT "               Choose type of rotation:"
	PRINT "               ************************"
	PRINT : COLOR 7
	FOR i = 1 TO 13: LOCATE i + 4, 15: PRINT frot$(i): NEXT i
	PRINT


LOCATE 28, 1: COLOR 3: PRINT "     >>> Choose rot.nr. with cursor keys <<<  "
i = nr%: in = i
IF mel = 1 THEN PLAY "l21o3ap21fp21d"

kiesrot:
IF in = 0 THEN in = 13
COLOR 7: LOCATE i + 4, 15: PRINT frot$(i)
i = in
COLOR 11: LOCATE i + 4, 15: PRINT frot$(i)

Verderrot:
SLEEP: a$ = INKEY$
SELECT CASE a$
CASE CHR$(13): GOTO bewerkrot
CASE CHR$(0) + "K": GOTO bewerkrot
CASE CHR$(0) + "M": GOTO bewerkrot
CASE CHR$(0) + "P": in = (i + 1) MOD 13: GOTO kiesrot
CASE CHR$(0) + "H": in = (i - 1) MOD 13: GOTO kiesrot
CASE ELSE: GOTO Verderrot
END SELECT

bewerkrot:
nr% = i
END SUB

SUB rotstap
COLOR 3
LOCATE 20, 1
PRINT "> lower values (less steps) for display figures if rotation secondary"
PRINT "> higher (more steps) for display unit axes or if rotation important"
PRINT "> ESCAPE during display to interrupt series"
COLOR 11

kiesstap:
IF nrot <= 0 THEN nrot = 1
IF nrot > 360 THEN nrot = 360
drot = (360 / nrot)
LOCATE 6, 45: PRINT USING "#### x ####.##ø"; nrot; drot

Verderstap:
SLEEP: a$ = INKEY$
SELECT CASE a$
CASE CHR$(13): GOTO bewerkstap
CASE CHR$(0) + "P": nrot = nrot - 10: GOTO kiesstap
CASE CHR$(0) + "H": nrot = nrot + 10: GOTO kiesstap
CASE CHR$(0) + "K": nrot = nrot - 1: GOTO kiesstap
CASE CHR$(0) + "M": nrot = nrot + 1: GOTO kiesstap
CASE ELSE: GOTO Verderstap
END SELECT

bewerkstap:
COLOR 7
LOCATE 6, 45: PRINT USING "#### x ####.##ø"; nrot; drot
COLOR 0
LOCATE 20, 1
PRINT "> lower values (less steps) for display figures if rotation secondary"
PRINT "> higher (more steps) for display unit axes or if rotation important"
PRINT "> ESCAPE during display to interrupt series"
END SUB

SUB scanmax
COLOR 11

kiesscan:
IF scan <= 0 THEN scan = 1
IF scan > 9 THEN scan = 9
LOCATE 7, 45: PRINT USING "#### "; scan

Verderscan:
SLEEP: a$ = INKEY$
SELECT CASE a$
CASE CHR$(13): GOTO bewerkscan
CASE CHR$(0) + "P": scan = scan - 1: GOTO kiesscan
CASE CHR$(0) + "H": scan = scan + 1: GOTO kiesscan
CASE CHR$(0) + "K": scan = scan - 1: GOTO kiesscan
CASE CHR$(0) + "M": scan = scan + 1: GOTO kiesscan
CASE ELSE: GOTO Verderscan
END SELECT

bewerkscan:
COLOR 7
LOCATE 7, 45: PRINT USING "#### "; scan

END SUB

SUB scanmod
COLOR 15
LOCATE 11, 1: PRINT "              Scan cycle:    Scanned curves: "
COLOR 7
FOR i = 1 TO 9: LOCATE 12 + i, 19: PRINT USING ">##"; i: NEXT i
FOR i = 1 TO 9: LOCATE 12 + i, 29: COLOR scol(i): PRINT "clear ": NEXT i
FOR i = 1 TO 9: LOCATE 12 + i, 39: COLOR 18 - scol(i): PRINT "restore   ": NEXT i

i = 1
in = i

kiesscmod:
IF INKEY$ = a$ AND TIMER - tijd < .1 GOTO verderscmod
tijd = TIMER
IF in < 1 THEN in = 9
IF in > 9 THEN in = 1
COLOR 7: LOCATE 12 + i, 19: PRINT USING ">##"; i
i = in
COLOR 11: LOCATE 12 + i, 19: PRINT USING ">##"; i

verderscmod:
SLEEP: a$ = INKEY$
SELECT CASE a$
CASE CHR$(13)
COLOR 0
LOCATE 11, 1: PRINT "              Scan cycle:    Scanned curves: "
FOR i = 1 TO 9: LOCATE 12 + i, 19: PRINT USING ">##"; i: NEXT i
FOR i = 1 TO 9: LOCATE 12 + i, 29:  PRINT "clear ": NEXT i
FOR i = 1 TO 9: LOCATE 12 + i, 39:  PRINT "restore   ": NEXT i
EXIT SUB '''GOTO bewerkafb
CASE CHR$(0) + "K": GOTO bewerkscmod
CASE CHR$(0) + "M": GOTO bewerkscmod
CASE CHR$(0) + "P": in = (i + 1): GOTO kiesscmod
CASE CHR$(0) + "H": in = (i - 1): GOTO kiesscmod
CASE ELSE: GOTO verderscmod
END SELECT

bewerkscmod:
scol(i) = 18 - scol(i)
LOCATE 12 + i, 29: COLOR scol(i): PRINT "clear "
LOCATE 12 + i, 39: COLOR 18 - scol(i): PRINT "restore   "
GOTO verderscmod
END SUB

SUB scherm
PLAY "o4l12d"      'screen
SCREEN 12
yx = 1.3   '''keep X/Y ratio'''
WINDOW (-max * yx, -max)-(max * yx, max)
END SUB

SUB schermkleur
COLOR 11         'screen color

kiesscrn:
IF scr < 1 THEN scr = 1
IF scr > 4 THEN scr = 4
LOCATE 5, 48: PRINT scr$(scr)

Verderscrn:
SLEEP: a$ = INKEY$
SELECT CASE a$
CASE CHR$(13): GOTO bewerkscrn
CASE CHR$(0) + "P": scr = scr - 1: GOTO kiesscrn
CASE CHR$(0) + "H": scr = scr + 1: GOTO kiesscrn
CASE CHR$(0) + "K": scr = scr - 1: GOTO kiesscrn
CASE CHR$(0) + "M": scr = scr + 1: GOTO kiesscrn
CASE ELSE: GOTO Verderscrn
END SELECT

bewerkscrn:
COLOR 7
LOCATE 5, 48: PRINT scr$(scr)
END SUB

SUB tekencoord
	max = 0             'display coords
	FOR m = 0 TO mmax
	FOR n = 0 TO nmax
	u(m, n) = x1(m, n) * u1 + x2(m, n) * u2 + y1(m, n) * u3 + y2(m, n) * u4
	v(m, n) = x1(m, n) * v1 + x2(m, n) * v2 + y1(m, n) * v3 + y2(m, n) * v4
	IF max < ABS(u(m, n)) THEN max = ABS(u(m, n))
	IF max < ABS(v(m, n)) THEN max = ABS(v(m, n))
	NEXT n
	NEXT m
max = max * fac * 1.02            '''reserve'''
END SUB

SUB tekencurv
SELECT CASE fig          'draw special curves
CASE 1
 LOCATE 2, 27: COLOR colcrv2: PRINT "circle   ";
 COLOR colcrv1: PRINT "hyperbola": COLOR 7
 nn = INT(nmax / 2): mm = INT(mmax / 2)
 FOR m = 0 TO mmax - 1
 LINE (u(m, nn), v(m, nn))-(u(m + 1, nn), v(m + 1, nn)), colcrv2
 NEXT m
 FOR n = 0 TO nmax - 1
 LINE (u(0, n), v(0, n))-(u(0, n + 1), v(0, n + 1)), colcrv1
 LINE (u(mm, n), v(mm, n))-(u(mm, n + 1), v(mm, n + 1)), colcrv1
 NEXT n
CASE 2
 LOCATE 2, 27: COLOR colcrv2: PRINT "core      ";
 COLOR colcrv1: PRINT "'hyperbola'": COLOR 7
 nn = INT(nmax / 2): mm = INT(mmax / 2)
 FOR m = 0 TO mmax - 1
 LINE (u(m, nn), v(m, nn))-(u(m + 1, nn), v(m + 1, nn)), colcrv2
 NEXT m
 FOR n = 0 TO nmax - 1
 LINE (u(0, n), v(0, n))-(u(0, n + 1), v(0, n + 1)), colcrv1
 LINE (u(mm, n), v(mm, n))-(u(mm, n + 1), v(mm, n + 1)), colcrv1
 NEXT n
CASE 3
 LOCATE 2, 27: COLOR colcrv2: PRINT "sech   ";
 COLOR colcrv3: PRINT "cosecant   ";
 COLOR colcrv1: PRINT "ñ cosech": COLOR 7
 mm = INT(mmax / 2)
 FOR m = 0 TO mmax - 1
 LINE (u(m, nmax), v(m, nmax))-(u(m + 1, nmax), v(m + 1, nmax)), colcrv2
 LINE (u(m, 0), v(m, 0))-(u(m + 1, 0), v(m + 1, 0)), colcrv1
 NEXT m
 FOR n = 0 TO nmax - 1
 LINE (u(mm, n), v(mm, n))-(u(mm, n + 1), v(mm, n + 1)), colcrv3
 NEXT n
CASE 4
 LOCATE 2, 27: COLOR colcrv1: PRINT "exponential "
 mm = INT(mmax / 2)
 FOR n = 0 TO nmax - 1
 LINE (u(mm, n), v(mm, n))-(u(mm, n + 1), v(mm, n + 1)), colcrv1
 NEXT n
CASE 5
 LOCATE 2, 27: COLOR colcrv1: PRINT "parabola"
 mm = INT(mmax / 2)
 FOR n = 0 TO nmax - 1
 LINE (u(0, n), v(0, n))-(u(0, n + 1), v(0, n + 1)), colcrv1
 LINE (u(mm, n), v(mm, n))-(u(mm, n + 1), v(mm, n + 1)), colcrv1
 NEXT n
CASE 6
 LOCATE 2, 27: COLOR colcrv3: PRINT "cosine    ";
 COLOR colcrv1: PRINT "cosh   ";
 COLOR colcrv2: PRINT "sinh": COLOR 7
 mm = INT(mmax / 2)
 nn2 = INT(nmax / 2): nn3 = INT(nmax * .75): nn1 = INT(nmax / 4)
 FOR n = 0 TO nmax - 1
 LINE (u(mm, n), v(mm, n))-(u(mm, n + 1), v(mm, n + 1)), colcrv3
 NEXT n
 FOR m = 0 TO mmax - 1
 LINE (u(m, nmax), v(m, nmax))-(u(m + 1, nmax), v(m + 1, nmax)), colcrv1
 LINE (u(m, 0), v(m, 0))-(u(m + 1, 0), v(m + 1, 0)), colcrv1
 LINE (u(m, nn2), v(m, nn2))-(u(m + 1, nn2), v(m + 1, nn2)), colcrv1
 LINE (u(m, nn1), v(m, nn1))-(u(m + 1, nn1), v(m + 1, nn1)), colcrv2
 LINE (u(m, nn3), v(m, nn3))-(u(m + 1, nn3), v(m + 1, nn3)), colcrv2
 NEXT m
CASE 7
 LOCATE 2, 27: COLOR colcrv1: PRINT "tanh   ";
 COLOR colcrv3: PRINT "tangent   ";
 COLOR colcrv2: PRINT "ñ cotanh": COLOR 7
 mm = INT(mmax / 2)
 FOR m = 0 TO mmax - 1
 LINE (u(m, nmax), v(m, nmax))-(u(m + 1, nmax), v(m + 1, nmax)), colcrv2
 LINE (u(m, 0), v(m, 0))-(u(m + 1, 0), v(m + 1, 0)), colcrv1
 NEXT m
 FOR n = 0 TO nmax - 1
 LINE (u(mm, n), v(mm, n))-(u(mm, n + 1), v(mm, n + 1)), colcrv3
 NEXT n
CASE 10
 LOCATE 2, 27: COLOR colcrv1: PRINT "cubic parabola   "
 mm = INT(mmax / 2)
 FOR n = 0 TO nmax - 1
 LINE (u(0, n), v(0, n))-(u(0, n + 1), v(0, n + 1)), colcrv1
 LINE (u(mm, n), v(mm, n))-(u(mm, n + 1), v(mm, n + 1)), colcrv1
 NEXT n
END SELECT
END SUB

SUB tekenen               'draw
	tel = tel + 1: vlag = 0: a$ = ""
	IF tel = 1 THEN CALL scherm
	CLS
	IF scr > 1 THEN PAINT (0, 0), scrcol(scr)
	LOCATE 1, 1
PRINT "                                                                                "
PRINT "                                                                                "
	LOCATE 1, 1: COLOR 7
	PRINT USING "###/### :####ø rot. ##"; tel - 1; nrot; xi; nr%
	LOCATE 1, 27: COLOR 7: PRINT tit$;
	rij = CSRLIN: kol = POS(0)

'''building up figure:
'''***************'''
IF col(1) = 7 THEN CALL tekenfig

''' axis planes '''
'''*************'''
IF col(4) = 11 THEN vlagxy = 1: CALL tekenxyvlak

'''axes '''
'''*****'''
IF col(5) = 11 THEN CALL tekenxyas

'''slow'''
'''********'''
FOR dum = 1 TO 2000: NEXT dum
vlagxy = 0

'''ESCAPE=STOP'''
'''***********'''
IF vlag = 1 THEN vlag = 0:  xi = 360: EXIT SUB

'''show parm families     '''
'''***********************'''
IF col(2) = 11 THEN CALL tekenparm

'''ESCAPE=STOP'''
'''***********'''
IF vlag = 1 THEN vlag = 0:  xi = 360: EXIT SUB

'''Draw curves   '''
'''**************'''
IF col(3) = 11 THEN CALL tekencurv

'''slow    '''
'''********'''
FOR dum = 1 TO 2000: NEXT dum

'''Wait after each display
'''********************'''
IF col(6) = 11 THEN
LOCATE 1, 60: COLOR 3: PRINT "-> Press a key...   "
IF mel = 1 THEN PLAY "l21o3c"
SLEEP: a$ = INKEY$: PLAY "o4l12d"
IF a$ = CHR$(27) THEN col(6) = 7
LOCATE 1, 60: COLOR 3: PRINT ">>> One second...   "
END IF

END SUB

SUB tekenfig
	FOR m = 0 TO mmax - 1
	FOR n = 0 TO nmax - 1
	LINE (u(m, n), v(m, n))-(u(m, n + 1), v(m, n + 1)), colm
	LINE (u(m, n), v(m, n))-(u(m + 1, n), v(m + 1, n)), coln
	NEXT n
	IF vlag = 0 THEN a$ = INKEY$
	IF a$ = CHR$(27) THEN
	a$ = ""
	vlag = 1
	LOCATE 1, 60: COLOR 3: PRINT ">>> One second...   "
	LOCATE rij, kol
	PLAY "o4l12d"
	END IF
	LINE (u(m, nmax), v(m, nmax))-(u(m + 1, nmax), v(m + 1, nmax)), coln
	NEXT m
'''for  goniom. functions''
'''*********************'''
	IF fig > 2 AND fig <> 5 THEN
	FOR n = 0 TO nmax - 1
	LINE (u(mmax, n), v(mmax, n))-(u(mmax, n + 1), v(mmax, n + 1)), colm
	NEXT n
	END IF

END SUB

SUB tekenparm
	LOCATE 2, 27: COLOR colmm: PRINT "Parameter curves M";
	LOCATE 1, 60: COLOR 3: PRINT "-> Press a key...   "
	vlag = 0: a$ = "": telscan = 1
fam1:
	IF scol(telscan) = 7 THEN scolm = colm ELSE scolm = scrcol(scr)
	FOR n = 0 TO nmax - 1
	LINE (u(0, n), v(0, n))-(u(0, n + 1), v(0, n + 1)), colmm
	NEXT n
	FOR dum = 1 TO 200: NEXT dum
      
	FOR m = 0 TO mmax - 1
      
	FOR n = 0 TO nmax - 1
	LINE (u(m, n), v(m, n))-(u(m, n + 1), v(m, n + 1)), scolm '''colm
	LINE (u(m + 1, n), v(m + 1, n))-(u(m + 1, n + 1), v(m + 1, n + 1)), colmm
	NEXT n
	FOR dum = 1 TO 200: NEXT dum
      
	IF vlag = 0 THEN a$ = INKEY$
	IF a$ = CHR$(27) THEN vlag = 1: EXIT SUB
	IF a$ <> "" THEN
	a$ = ""
	vlag = 1
	LOCATE 1, 60: COLOR 3: PRINT ">>> One second...   "
	PLAY "o4l12d"
	END IF
      
	NEXT m
      
	FOR n = 0 TO nmax - 1
	LINE (u(mmax, n), v(mmax, n))-(u(mmax, n + 1), v(mmax, n + 1)), scolm '''colm
	NEXT n
     
	telscan = telscan + 1
	IF vlag = 0 AND telscan <= scan GOTO fam1
      
'        IF a$ = CHR$(27) THEN EXIT SUB
	vlag = 0: telscan = 1
	LOCATE 2, 27: COLOR colnn: PRINT "Parameter curves N";
	LOCATE 1, 60: COLOR 3: PRINT "-> Press a key...   "
fam2:
	IF scol(telscan) = 7 THEN scoln = coln ELSE scoln = scrcol(scr)
	FOR m = 0 TO mmax - 1
	LINE (u(m, 0), v(m, 0))-(u(m + 1, 0), v(m + 1, 0)), colnn
	NEXT m
	FOR dum = 1 TO 200: NEXT dum
     
	FOR n = 0 TO nmax - 1
      
	FOR m = 0 TO mmax - 1
	LINE (u(m, n), v(m, n))-(u(m + 1, n), v(m + 1, n)), scoln '''coln
	LINE (u(m, n + 1), v(m, n + 1))-(u(m + 1, n + 1), v(m + 1, n + 1)), colnn
	NEXT m
	FOR dum = 1 TO 200: NEXT dum
      
	IF vlag = 0 THEN a$ = INKEY$
	IF a$ = CHR$(27) THEN vlag = 1: EXIT SUB
	IF a$ <> "" THEN
	a$ = ""
	vlag = 1
	LOCATE 1, 60: COLOR 3: PRINT ">>> One second...   "
	PLAY "o4l12d"
	END IF
       
	NEXT n
      
	FOR m = 0 TO mmax - 1
	LINE (u(m, nmax), v(m, nmax))-(u(m + 1, nmax), v(m + 1, nmax)), scoln '''coln
	NEXT m
	FOR dum = 1 TO 200: NEXT dum
     
	telscan = telscan + 1
	IF vlag = 0 AND telscan <= scan GOTO fam2
     
'        IF a$ = CHR$(27) THEN EXIT SUB
	vlag = 0: telscan = 0
	COLOR 0
	LOCATE 2, 27:  PRINT "Parameter curves n";
	LOCATE 1, 60:  PRINT "-> Press a key...   "
END SUB

SUB tekenxy
	tel = tel + 1
	IF tel = 1 THEN CALL scherm: CLS
	COLOR 7
	LOCATE 1, 1
	PRINT USING "###/### :####ø rot. ##"; tel - 1; nrot; xi; nr%
	LOCATE 1, 27: COLOR 7: PRINT tit$;
	COLOR 11: PRINT "   X   ";
	COLOR 13: PRINT "Y"

''' Don't show X and Y planes'
'''************************'''
IF col(4) = 7 THEN
LINE (0, 0)-(u11, v11), 0
LINE (0, 0)-(u22, v22), 0
LINE (0, 0)-(u33, v33), 0
LINE (0, 0)-(u44, v44), 0
PSET (u22, v22), 7: PSET (u44, v44), 7  ''' Show rotation path
PSET (u11, v11), 7: PSET (u33, v33), 7
LINE (0, 0)-(u1, v1), 11
LINE (0, 0)-(u2, v2), 11
LINE (0, 0)-(u3, v3), 13
LINE (0, 0)-(u4, v4), 13
u11 = u1: v11 = v1: u22 = u2: v22 = v2
u33 = u3: v33 = v3: u44 = u4: v44 = v4

ELSE
''' Show X and Y planes''
'''*******************''
LINE (0, 0)-(u11, v11), 0: LINE -(u11 + u22, v11 + v22), 0
LINE -(u22, v22), 0: LINE -(0, 0), 0
LINE (0, 0)-(u33, v33), 0: LINE -(u33 + u44, v33 + v44), 0
LINE -(u44, v44), 0: LINE -(0, 0), 0
PSET (u22, v22), 7: PSET (u44, v44), 7  ''' Toon rotatiebaan
LINE (0, 0)-(u1, v1), 11: LINE -(u1 + u2, v1 + v2), 11
LINE -(u2, v2), 11: LINE -(0, 0), 11
LINE (0, 0)-(u3, v3), 13: LINE -(u3 + u4, v3 + v4), 13
LINE -(u4, v4), 13: LINE -(0, 0), 13
u11 = u1: v11 = v1: u22 = u2: v22 = v2
u33 = u3: v33 = v3: u44 = u4: v44 = v4
END IF

'''ESCAPE=STOP'''
'''***********'''
IF INKEY$ = CHR$(27) THEN xi = 360

'''Wait after each display
'''********************'''
	IF ja$ = "y" THEN
	LOCATE 1, 60: COLOR 3: PRINT "-> Press a key...   "
	IF mel = 1 THEN PLAY "l21o3c"
	SLEEP: a$ = INKEY$: IF a$ = " " THEN ja$ = ""
	END IF

END SUB

SUB tekenxyas
	IF vlagxy = 0 THEN
	COLOR 11: PRINT "   X   ";
	COLOR 13: PRINT "Y"
	END IF
	mm = max / (1.1 * fac)
	LINE (0, 0)-(u1 * mm, v1 * mm), 11
	LINE (0, 0)-(u2 * mm, v2 * mm), 3
	LINE (0, 0)-(u3 * mm, v3 * mm), 13
	LINE (0, 0)-(u4 * mm, v4 * mm), 5
END SUB

SUB tekenxyvlak
	COLOR 11: PRINT "   X   ";
	COLOR 13: PRINT "Y"
	LINE (0, 0)-(u1, v1), 11
	LINE -(u1 + u2, v1 + v2), 11
	LINE -(u2, v2), 11
	LINE -(0, 0), 11
	LINE (0, 0)-(u3, v3), 13
	LINE -(u3 + u4, v3 + v4), 13
	LINE -(u4, v4), 13
	LINE -(0, 0), 13
END SUB