'DraaiKrimp
'**********
SCREEN 12
pi = ATN(1) * 4
LOCATE 6, 1: COLOR 11      'INTRO
PRINT "                             RotShrink RotatieKrimp"
PRINT : COLOR 3
PRINT "   Beginkring van N punten. Ieder punt zit zijn opvolger achterna."
PRINT "   Opeenvolgende kringposities door constante draaikrimp."
PRINT "   Elk punt beschrijft zelf een spiraalbaan. Het is alsof"
PRINT "   N honden elkaar achterna zitten in proportioneel krimpende banen."
PRINT
COLOR 7
PRINT "     -> ESCAPE = END"
PRINT "     -> ENTER  = Nieuwe parameters kiezen"
PRINT "     -> SPATIE = Wachten On/Off (On: druk toets na elk beeld)"
PRINT "     -> F1     = Beginkring wel-of-niet tonen vlag"
PRINT "     -> F2     = Krimpkringen-of-Jaagbanen tonen vlag"
PRINT "     -> F3     = Eindkring wel-of-niet tonen vlag"
PRINT "     -> F4     = Jagende kring volgen-of-niet vlag"
PRINT
PRINT "     -> Default = 10 beginpunten, 1000 tekenpunten, krimp 0.95"
PRINT
COLOR 14: LOCATE 24, 27: PRINT "Credits: guido wuyts 1997"
col = 0
x0 = 320: y0 = 240: leng = 200
FOR alf = 0 TO 360 STEP 5
col = (col + 1) MOD 7 + 9
a = alf * pi / 180: c = COS(a): s = SIN(a)
PSET (x0 + leng * c, y0 + leng * s), col
NEXT alf
PLAY "l21o3cc+dd+ee-dd-c"
col = 11: a$ = ""
WHILE a$ = ""
COLOR col: LOCATE 27, 28
PRINT "-> Druk een toets..."
tijd = TIMER: WHILE TIMER - tijd < .5: WEND
IF col = 11 THEN col = 5 ELSE col = 11
a$ = INKEY$
WEND
IF a$ = CHR$(27) THEN END
a$ = ""

'Defaults
'********
k = 10: n = 1000: alf = .95
'Vlaggen begin-, tussen- en eindkring, jaagbaan,jaagkring
'*********************************************************
vlgbgn = 1: vlgbtw = 1: vlgend = 1: vlgchs = 1 - vlgbtw: vlgclr = 0
'Lopende Kring
'**************
REDIM x(k), y(k), xx(k), yy(k), xo(k), yo(k)

'RotKrimp
'*********

begin:

COLOR 15: col = 15
RANDOMIZE TIMER
IF vlgclr = 1 THEN
vlgcol = ABS(1 - vlgcol)
IF vlgcol = 0 THEN CLS
ELSE
vlgcol = 0: CLS
END IF

'Beginkring
'***********
FOR m = 1 TO k
IF vlgcol = 0 THEN
 x(m) = RND * 640: xo(m) = x(m): xx(m) = x(m)
 y(m) = RND * 480: yo(m) = y(m): yy(m) = y(m)
 ELSE
 x(m) = xo(m): y(m) = yo(m): xx(m) = x(m): yy(m) = y(m)
 END IF
NEXT m

col = 8
IF vlgbgn = 1 THEN GOSUB Tekenkring

Tussenkring:
'***********
i = 1
DO WHILE i + k < n
i = i + k
                               
FOR m = 1 TO k - 1                         'volgende kring...
x(m) = xx(m) * alf + xx(m + 1) * (1 - alf)
y(m) = yy(m) * alf + yy(m + 1) * (1 - alf)
NEXT m
x(k) = xx(k) * alf + xx(1) * (1 - alf)
y(k) = yy(k) * alf + yy(1) * (1 - alf)

col = 1 + col MOD 14                      'volgkleur

IF vlgbtw = 1 THEN                        'tussenkring tekenen
GOSUB Tekenkring
END IF

IF vlgcol = 1 THEN                        'jaagbaan tekenen
GOSUB Tekenjaagkring
END IF

IF vlgchs = 1 THEN                        'jaagbaan tekenen
GOSUB Tekenjaagbaan
END IF
                                          
FOR m = 1 TO k                             '...actualiseren
xx(m) = x(m): yy(m) = y(m)
NEXT m

LOOP

IF vlgend = 1 THEN                         'eindkring tekenen
col = 12
GOSUB Tekenkring
END IF


'Wachten?
IF wacht = 1 THEN
PLAY "o4l32d": SLEEP: a$ = INKEY$:
GOSUB scankey      'check toetsen...
ELSE
SLEEP 1
END IF

a$ = INKEY$
GOSUB scankey      'check toetsen...
GOTO begin

END

'Nieuwe parms
'************

parms:
CLS
PLAY "o4l32d"
INPUT "Kies aantal beginpunten (3 tot 100, Default=10): ", k
IF k = 0 THEN k = 10
IF k < 3 OR k > 100 THEN GOTO parms
REDIM x(k), y(k), xx(k), yy(k), xo(k), yo(k)
vlgcol = 1
nkeus:
INPUT "Kies aantal punten (100 tot 10000, Default=1000): ", n
IF n = 0 THEN n = 1000
IF n < 100 OR n > 10000 THEN PLAY "o4l32d": GOTO nkeus
n = INT(n / k) * k
alfkeus:
INPUT "Kies draaikrimpfactor alfa  (tussen 0 en 1, Default=0.95) : ", alf
IF alf = 0 THEN alf = .95
IF alf <= 0 OR alf >= 1 THEN PLAY "o4l32d": GOTO alfkeus
CLS
RETURN

'Check toetsen
'*************

scankey:
SELECT CASE a$
CASE "":
CASE CHR$(27):  END                               'ESCAPE
CASE CHR$(13): a$ = "": GOSUB parms: GOTO begin   'ENTER
CASE " ": wacht = ABS(1 - wacht)                  'SPACE
CASE CHR$(0) + ";": vlgbgn = ABS(1 - vlgbgn)      'F1
CASE CHR$(0) + "<":                               'F2
vlgbtw = ABS(1 - vlgbtw)
vlgchs = ABS(1 - vlgbtw)
CASE CHR$(0) + "=": vlgend = ABS(1 - vlgend)      'F3
CASE CHR$(0) + ">": vlgclr = ABS(1 - vlgclr)      'F4
CASE ELSE: IF wacht = 0 THEN wacht = 1            'else wacht...
END SELECT
RETURN

Tekenkring:
FOR m = 1 TO k - 1
LINE (x(m), y(m))-(x(m + 1), y(m + 1)), col
NEXT m
LINE (x(m), y(m))-(x(1), y(1)), col
RETURN

Tekenjaagkring:
FOR m = 1 TO k - 1
LINE (xx(m), yy(m))-(xx(m + 1), yy(m + 1)), 0
LINE (x(m), y(m))-(x(m + 1), y(m + 1)), col
LINE (xx(m), yy(m))-(x(m), y(m)), col
NEXT m
LINE (xx(m), yy(m))-(xx(1), yy(1)), 0
LINE (x(m), y(m))-(x(1), y(1)), col
LINE (xx(m), yy(m))-(x(m), y(m)), col
RETURN

Tekenjaagbaan:
FOR m = 1 TO k
LINE (xx(m), yy(m))-(x(m), y(m)), col
NEXT m
RETURN