'DraaiKrimp
'**********
SCREEN 12
pi = ATN(1) * 4
LOCATE 6, 1: COLOR 11      'INTRO
PRINT "                              Rotating Shrink"
PRINT : COLOR 3
PRINT "   Initial ring of N points, each point chasing its next neighbour."
PRINT "   Successive ring shapes through constant and rotating shrink."
PRINT "   Each point follows a spiral path. It's rather like N dogs"
PRINT "   hunting each other along proportionally shrinking trajectories."
PRINT
COLOR 7
PRINT "     -> ESCAPE = END"
PRINT "     -> ENTER  = Choose new parms"
PRINT "     -> SPACE  = Wait On/Off (when On: push key after each image)"
PRINT "     -> F1     = Flag for showing initial ring or not"
PRINT "     -> F2     = Flag for showing rings or chase paths"
PRINT "     -> F3     = Flag for showing final ring or not"
PRINT "     -> F4     = Flag for retracing chase ring or not"
PRINT
PRINT "     -> Default = 10 ring points, 1000 trace points, shrink 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 "-> Push a key..."
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
'Flags initial ring, rings/paths, final ring, paths/rings ,trace rings
'**********************************************************************
vlgbgn = 1: vlgbtw = 1: vlgend = 1: vlgchs = 1 - vlgbtw: vlgclr = 0
'Current picture ring
'********************
REDIM x(k), y(k), xx(k), yy(k), xo(k), yo(k)

'RotShrink
'*********

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

'Initial ring
'***********
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

'Current ring:
'***********
i = 1                                      'counter trace points...
DO WHILE i + k < n
i = i + k                                  '...next ring
                               
FOR m = 1 TO k - 1                          'chase shrink
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                      'current color

IF vlgbtw = 1 THEN                        'draw next ring
GOSUB Tekenkring
END IF

IF vlgcol = 1 THEN                        'trace current ring
GOSUB Tekenjaagkring
END IF

IF vlgchs = 1 THEN                        'draw chase paths
GOSUB Tekenjaagbaan
END IF
                                          
FOR m = 1 TO k                             '...update previous
xx(m) = x(m): yy(m) = y(m)
NEXT m

LOOP

IF vlgend = 1 THEN                         'draw final ring
col = 12
GOSUB Tekenkring
END IF

IF wacht = 1 THEN                          'wait
PLAY "o4l32d": SLEEP: a$ = INKEY$:
GOSUB scankey                              'check keys
ELSE
SLEEP 1
END IF

a$ = INKEY$                                'read key
GOSUB scankey                              'check keys
GOTO begin

END

'New parms
'************

parms:
CLS
PLAY "o4l32d"
INPUT "Number of chasing points (3 thru 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 "Number of trace points (100 thru 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 "RotShrink factor alpha (between 0 and 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 keys
'*************

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 wait...
END SELECT
RETURN

Tekenkring:                                       'add next ring
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:                                   'trace current ring
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:                                    'add chase paths
FOR m = 1 TO k
LINE (xx(m), yy(m))-(x(m), y(m)), col
NEXT m
RETURN