Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Pixelrennen die 2.
| Uploader: |  OneCypher |
| Datum/Zeit: | 05.09.2008 13:21:31 |
'Copyright by Christian H. alias OneCypher
'Diesen Quelltext stelle ich ausschließlich für nichtkommerzielle Zwecke zur Verfügung!
const pxcolor = RGB(0,255,0)
function getlength(x1 as double,y1 as double,x2 as double,y2 as double) as double
dim dx as double = x2 - x1
dim dy as double = y2 - y1
dim l as double = SQR(dx * dx + dy *dy)
return l
end function
function red(col AS UINTEGER) as ubyte
red = col SHR 16
END function
function green(col AS UINTEGER) as ubyte
green = col SHR 8
END function
function blue(col AS UINTEGER) as ubyte
blue = col
end function
type st 'Wegpunkt definition
x as integer
y as integer
nx_st as st ptr
end type
type px 'Pixel definition
x as double 'Position X
y as double 'Position Y
dest as st ptr 'Zielwegpunkt
dist as integer 'Distanzerweiterung zum Zielwegpunkt (für Stau minimierung)
nx_px as px ptr 'Nächster Pixel
bg as uinteger 'Pixelhintergrund
slp as integer 'Pixel schläft im Stau
declare sub work() 'LAUFZEIT :-D
end type
sub px.work()
dim dx as double 'Ziel X
dim dy as double 'Ziel Y
dim tx as double 'Temp X
dim ty as double 'Temp Y
dx = dest->x 'Ziel einlesen
dy = dest->y
if getlength(x,y,dx,dy) > 10 + dist then 'Solange Ziel(+Tolleranz) nicht erreicht dann...
tx = (rnd *2) -1 '... Schauen wir mal wo man so hintreten kann
ty = (rnd *2) -1 'Einfach mal auf gut Glück
if getlength(x,y,dx,dy) > getlength(x+tx,y+ty,dx,dy) then 'Wenn wir näher treten und...
if green(point(x+tx,y+ty)) = 0 then 'der nächste Schritt nicht ins Grüne führt..
if blue(bg) < 255 then bg = rgb(0,0,blue(bg) +1) 'dann Hintergrund um 1 hervorheben...
pset(x,y),bg 'Hintergrund zeichnen
x +=tx 'Neue Koordinaten übernehmen
y +=ty
bg = point(x,y) 'Neuen Hintergrund übernehmen
pset(x,y),pxcolor 'Grünen Pixel setzen
slp = 0 'Aufwachen! (falls es im Stau war)
dist = 0 'Da man wieder frei laufen kann, Distanzerweiterung auf 0 setzen
else
if dist > 50 then
dest = dest->nx_st 'WegPunkt erreicht, nächster ist an der Reihe!
dist = 0
else
if dist > 10 then 'Wenn die Distanz zum Wegpunkt zu groß wird
if slp < 255 then
slp = slp +1 'Dann fang an einzuschlafen!
pset(x,y), RGB(0,255-slp,0)
end if
else
dist = dist +1 'Da blockiert was den Weg, also Distanzerweiterung erhöhen!
end if
end if
end if
end if
else
dest = dest->nx_st 'WegPunkt erreicht, nächster ist an der Reihe!
end if
end sub
dim sx as integer 'Bildschirmgrößen
dim sy as integer
dim mx as integer 'Mausinfos
dim my as integer
dim bt as integer
screen 18, 32
screeninfo sx, sy
cls
dim i as integer 'Zum iterieren von irgendwas....
dim in as string 'Für Tastratur-eingaben...
dim paused as ubyte
dim spx as px ptr 'Erster Pixel
dim apx as px ptr 'Aktueller Pixel
dim tpx as px ptr 'Temporärer Zeiger
dim fstat as st ptr 'Erster Wegpunkt
dim lstat as st ptr 'Letzter Wegpunkt
fstat = new st
fstat->x = int(sx /8)
fstat->y = int(sy /8)
pset(fstat->x,fstat->y),RGB(255,0,0)
fstat->nx_st = fstat
lstat = fstat
apx = new px
spx = apx
for i = 1 to 10
'Neue Pixel generieren
apx->x = int(rnd*sx-1) +1
apx->y = int(rnd*sy-1) +1
apx->bg = point(apx->x,apx->y)
apx->dest = fstat
apx->nx_px = new px
if i < 10 then apx = apx->nx_px else apx->nx_px = spx
next
apx = spx
paused = 1
do
in = inkey
getmouse mx,my,,bt
if paused = 0 then apx->work
apx=apx->nx_px
if bt <> 0 and mx > 0 and my > 0 then
'Ein neuer Wegpunkt
lstat->nx_st = new st
lstat = lstat->nx_st
lstat->x = mx
lstat->y = my
lstat->nx_st = fstat
pset(mx,my),RGB(255,0,0)
while bt > 0
'Überlauf verhindern
getmouse mx,my,,bt
wend
end if
if in = "c" then
'Löscht und baut den Bildschirm wieder auf.
cls
sleep 1000
apx = spx->nx_px
while apx <> spx
apx->bg = RGB(0,0,0)
pset(apx->x,apx->y),pxcolor
apx = apx->nx_px
wend
end if
if in = "+" then
'Pixel hinzufügen
for i = 1 to 10
tpx = apx->nx_px
apx->nx_px = new px
apx->nx_px->x = int(rnd*sx-1) +1
apx->nx_px->y = int(rnd*sy-1) +1
apx->nx_px->bg = point(apx->nx_px->x,apx->nx_px->y)
apx->nx_px->dest = fstat
apx->nx_px->nx_px = tpx
next
end if
if in = "-" then
'Pixel wegnehmen
if apx <> apx->nx_px then
pset(apx->nx_px->x,apx->nx_px->y),apx->bg
tpx = apx->nx_px->nx_px
delete apx->nx_px
apx->nx_px = tpx
end if
end if
if in = "p" then
'Pause
if paused = 0 then
sleep 500
paused = 1
else
sleep 500
paused = 0
end if
end if
if in = "l" then
'Löscht den ersten Wegpunkt
sleep 500
pset(fstat->x,fstat->y),rgb(0,0,0)
fstat->x = fstat->nx_st->x
fstat->y = fstat->nx_st->y
lstat->nx_st = fstat->nx_st
delete fstat
fstat = lstat->nx_st
end if
'sleep 10
loop until in = "q" or in = chr(27) or in = chr(255,107)