Code: Select all
const as single doublepi =atn (1) * 8
const as single pi =atn (1) * 4
const as single halfpi =atn (1) * 2
const as single quarterpi =atn (1)
const as integer Xo=400
const as integer Yo=300
'xpos,ypos Startkoordinaten, es gilt ein karthesisches System dessen Ursprung auf dem Screen mit Xo,Yo definiert ist
'direction Initialrichtung
'fd Laufweite in Pixel, aus wievielen Pixeln besteht die Linie, keine Entfernungsangabe
'mma maximale zulässige Abweichung von Initialrichtung
declare sub RandomWalk(xpos as single, ypos as single, direction as single, fd as integer=0,mma as single=3.14)
screen 19,32
randomize timer
dim as single d=pi + halfpi'270 grd
do
cls
'Erzeugt ein "Büschel" von 8 Zufallslinien
for i as integer=1 to 8
RandomWalk(0,100,d,400)
next i
sleep 200
loop until inkey=chr(27)
sleep
sub RandomWalk(xpos as single, ypos as single, direction as single, fd as integer=0,mma as single=3.14)
static as integer fulldist,actdist,ix,iy
static as single initdirection,max_misaligned
dim as ubyte component
dim as single nx,ny
if fd>0 then
fulldist=fd
actdist=0
ix=int(xpos)
iy=int(ypos)
pset(Xo+ix,Yo-iy),&HFFFFFF
initdirection=direction
max_misaligned=mma
end if
'Veränderung der Richtung
' Zufallwert Zufallsvorzeichen
direction +=rnd * .25 * sgn(rnd-.5) 'die Ausgangsrichtung(Bogenmaß) um einen zufälligen Wert verändern
'Limiter, die aktuelle Richtung darf nur in einem bestimmten Maß von der Initialrichtung abweichen
'dadurch ergibt sich indirekt eine Art von Streuungskegel
if direction>initdirection+max_misaligned then direction=initdirection+max_misaligned
if direction<initdirection-max_misaligned then direction=initdirection-max_misaligned
nx=xpos + cos(direction)
ny=ypos + sin(direction)
if (int(nx)<>ix) or (int(ny)<>iy) then'nur wenn die neue Position(nx,ny) nach Integerrundung ein Pixel neben der alten liegt
actdist +=1
component=255 * ((fulldist-actdist)/fulldist)
ix=int(xpos)
iy=int(ypos)
line -(Xo+ix,Yo-iy),rgb(component,component,component)
end if
if actdist<fulldist then RandomWalk(nx,ny,direction) 'sollte Gesamtlänge noch nicht erreicht sein, "rekursives Verlängern"
end sub
Mutton