61 lines
1.4 KiB
Plaintext
61 lines
1.4 KiB
Plaintext
' version 16-03-2017
|
|
' compile with: fbc -s gui
|
|
|
|
Const As ULong w = 400
|
|
Const As ULong w1 = w -1
|
|
|
|
Dim As Long x, y, lastx, lasty
|
|
Dim As Long count, max = w * w \ 4
|
|
|
|
ScreenRes w, w, 8 ' windowsize 400 * 400, 8bit
|
|
' hit any key to stop or mouseclick on close window [X]
|
|
WindowTitle "hit any key to stop and close the window"
|
|
|
|
Palette 0, 0 ' black
|
|
Palette 1, RGB( 1, 1, 1) ' almost black
|
|
Palette 2, RGB(255, 255, 255) ' white
|
|
Palette 3, RGB( 0, 255, 0) ' green
|
|
|
|
Line (0, 0) - (w1, w1), 0, BF ' make field black
|
|
Line (0, 0) - (w1, w1), 1, B ' draw border in almost black color
|
|
|
|
Randomize Timer
|
|
x = Int(Rnd * 11) - 5
|
|
y = Int(Rnd * 11) - 5
|
|
|
|
PSet(w \ 2 + x, w \ 2 + y), 3 ' place seed near center
|
|
|
|
Do
|
|
Do ' create new particle
|
|
x = Int(Rnd * w1) + 1
|
|
y = Int(Rnd * w1) + 1
|
|
Loop Until Point(x, y) = 0 ' black
|
|
PSet(x, y), 2
|
|
|
|
Do
|
|
lastx = x
|
|
lasty = y
|
|
Do
|
|
x = lastx + Int(Rnd * 3) -1
|
|
y = lasty + Int(Rnd * 3) -1
|
|
Loop Until Point(x, y) <> 1
|
|
|
|
If Point(x, y) = 3 Then
|
|
PSet(lastx, lasty), 3
|
|
Exit Do ' exit do loop and create new particle
|
|
End If
|
|
|
|
PSet(lastx, lasty), 0
|
|
PSet(x,y), 2
|
|
|
|
If Inkey <> "" Or Inkey = Chr(255) + "k" Then
|
|
End
|
|
End If
|
|
Loop
|
|
|
|
count += 1
|
|
Loop Until count > max
|
|
|
|
Beep : Sleep 5000
|
|
End
|