SCREEN 12

PRINT "massagroeifractal door migratie-absorptie, afgeleid van SloGro"
PRINT "mass growth fractal thru migrative absorption, derived from SloGro"
PRINT "******************************************************************"
PRINT
PRINT "Druk toets om te stoppen/Press a key to stop"
PRINT "********************************************"
PRINT : PRINT : PRINT : COLOR 10
PRINT "     Credits: guido wuyts 1997"
PRINT : PRINT : PRINT : COLOR 3
PRINT "     -> Toets/Key...": COLOR 15
PLAY "o4l24d"
SLEEP: a$ = INKEY$: a$ = "": COLOR 12
CLS

Init:
px = 10: py = 5
nx = INT(640 / px): ny = INT(460 / py): n = nx * ny
bx = 20: by = 10                     'bufferlokaties
                                  'locations tampons
M = 60: DIM toest(bx * 2 + nx, by * 2 + ny), mx(M), my(M)'aantal pt;toest;rel. afst. tot kiem
                                                'nbre pts; etat; dist. rel. au germe
RANDOMIZE TIMER

SpreidMassa:
FOR k = 1 TO M
nk = INT(RND * n)
i = nk MOD nx: j = (nk - i) / nx
IF toest(i + bx, j + by) = 1 THEN k = k - 1: GOTO Volgk1'reeds bezet ; deja occupe
toest(i + bx, j + by) = 1                      'bezetten ; occuper
LINE (i * px, j * py)-(i * px + px, j * py + py), , BF'tekenen ; dessiner

Volgk1:
NEXT k

Kiemmassa:
i0 = INT(nx / 2): j0 = INT(ny / 2): ik = i0: jk = j0'kiemlokatie ; location germe
toest(ik + bx, jk + by) = 1: mx(0) = 0: my(0) = 0
Mn = 0                              'tot. nieuwe massa ex kiem
                                    'tot. masse neuve ex germe

TosVerplaats:
IF NOT INKEY$ = "" THEN GOTO Einde
IF RND < .5 THEN a = .5 ELSE a = -.5
IF RND < .5 THEN b = .5 ELSE b = -.5
i = ik: j = jk                      'oude pos. ; anc. pos.
ik = i + a + b: jk = j + a - b      'nieuwe pos. ; nouv. pos.
IF ik = 0 OR ik = nx THEN ik = i0   'beperk zwerf ; limiter migr.
IF jk = 0 OR jk = ny THEN jk = j0

CheckToest:
Mm = Mn                             'huidige massa ; masse actuelle
FOR k = 0 TO Mm
IF toest(ik + mx(k) + bx, jk + my(k) + by) <> 1 GOTO Volgk
Mn = Mn + 1                         'absorb. nw. pt.
                                    'absorb. pt neuf
mx(Mn) = mx(k) + a + b              'en neem het mee
                                    'et emporte-le
my(Mn) = my(k) + a - b
toest(ik + mx(k) + bx, jk + my(k) + by) = 0'punt komt vrij
                                          'point se libere

Volgk:
NEXT k

Teken:
FOR k = 0 TO Mn
x = (i + mx(k)) * px: y = (j + my(k)) * py
LINE (x, y)-(x + px, y + py), 0, BF 'wis oude pos. / rayer anc. pos.
x = (ik + mx(k)) * px: y = (jk + my(k)) * py
LINE (x, y)-(x + px, y + py), 3, BF 'teken nwe pos. / dessiner nouv. pos.
NEXT k

NogPtenVrij:
IF Mn < M GOTO TosVerplaats

Einde:
BEEP
a$ = INPUT$(1)
CLS
END