fb:porticula NoPaste
AminTest
Uploader: | Muttonhead |
Datum/Zeit: | 31.08.2011 18:01:24 |
type obj
posx as integer
posy as integer
MoveIt as integer 'löst Anim/Bewegung in gewünschter Richtung aus
AnimInProgress as integer'ist >0(1,2,3,4) während Anim/Bewegung
animright(3) as integer ptr 'rechts
animrightframe as integer
animleft(3) as integer ptr 'links
animleftframe as integer
animtop(3) as integer ptr 'oben
animtopframe as integer
animbottom(3) as integer ptr 'unten
animbottomframe as integer
actVisible as integer ptr'direkter Link zum zuletzt angezeigten Bild, bei Stillstand benötigt
newpos as integer 'Hilfsvariable Zielpunkt der Bewegung
fract as single 'Hilfsvariable um Anim von Objektbewegung zu trennen
end type
declare sub UeberdenkeObjektPosition (byref o as obj)
declare sub raster
screen 19,32
dim as integer ptr Bildm, Bildo, Bildu, Bildr, Bildl
Bildm= imagecreate(16,16,&H0)
Bildo= imagecreate(16,16,&H0)
Bildu= imagecreate(16,16,&H0)
Bildr= imagecreate(16,16,&H0)
Bildl= imagecreate(16,16,&H0)
circle Bildm,(7,7),3,&HFF6600,,,,f
circle Bildo,(7,3),3,&HFF6600,,,,f
circle Bildu,(7,12),3,&HFF6600,,,,f
circle Bildr,(12,7),3,&HFF6600,,,,f
circle Bildl,(3,7),3,&HFF6600,,,,f
dim as obj Figur
Figur.posx=16*4
Figur.posy=16*3
'Animationsreihenfolge festlegen
Figur.animright(0)=Bildm'Ball mitte
Figur.animright(1)=Bildo'Ball oben
Figur.animright(2)=Bildm'Ball mitte
Figur.animright(3)=Bildu'Ball rechts
Figur.animleft(0)=Bildm'Ball mitte
Figur.animleft(1)=Bildu'Ball unten
Figur.animleft(2)=Bildm'Ball mitte
Figur.animleft(3)=Bildo'Ball oben
Figur.animtop(0)=Bildm'Ball mitte
Figur.animtop(1)=Bildr'Ball rechts
Figur.animtop(2)=Bildm'Ball mitte
Figur.animtop(3)=Bildl'Ball links
Figur.animbottom(0)=Bildm'Ball mitte
Figur.animbottom(1)=Bildl'Ball links
Figur.animbottom(2)=Bildm'Ball mitte
Figur.animbottom(3)=Bildr'Ball rechts
Figur.actVisible=Figur.animright(0)'StartBild festlegen
Figur.animrightframe=0
dim as string key
do
key=inkey
if key="d" then Figur.MoveIt=1'rechts
if key="a" then Figur.MoveIt=2'links
if key="w" then Figur.MoveIt=3'oben
if key="s" then Figur.MoveIt=4'unten
screenlock
cls
raster
UeberdenkeObjektPosition (Figur)'eigentliche Bewegung/Anim erfolgt hier
screenunlock
sleep 1
loop until key=chr(27)
imagedestroy Bildm
imagedestroy Bildo
imagedestroy Bildu
imagedestroy Bildr
imagedestroy Bildl
end
sub UeberdenkeObjektPosition (byref o as obj)
if (o.MoveIt>0) and (o.AnimInProgress=0) then'Wenn Anim gewünscht und keine andere läuft
select case o.MoveIt
case 1
o.newpos = o.posx+16 'neue Zielposition ist 16 Pixel entfernt
case 2
o.newpos = o.posx-16
case 3
o.newpos = o.posy-16
case 4
o.newpos = o.posy+16
end select
o.AnimInProgress=o.MoveIt '"Flag" setzen das ab jetzt etwas im Gange ist
o.MoveIt=0'Richtungswunsch wird nun nicht mehr benötigt
end if
if o.AnimInProgress then 'wenn eine Bewegung/Anim gesetzt ist
select case o.AnimInProgress
case 1 'wenn Richtung rechts
o.posx +=1 'Objekt nach rechts verschieben
o.fract +=.8 'mit fract wird versucht, daß nicht in jedem Durchgang
if o.fract>1 then 'ein neues Bild erscheint, sonst sieht das sehr hyperaktiv aus
o.animrightframe = ((o.animrightframe+1) mod 4)'<-Rotation des Bildindex
o.fract=0
end if
if o.posx = o.newpos then'wenn Objekt seine neue Zielposition erreicht hat
o.AnimInProgress=0 'Freigeben für neue Anim
o.animrightframe=0 'bestimmtes Bild bei Stillstand setzen
end if
o.actVisible=o.animright(o.animrightframe)
case 2
o.posx -=1
o.fract +=.8
if o.fract>1 then
o.animleftframe = ((o.animleftframe+1) mod 4)
o.fract=0
end if
if o.posx = o.newpos then
o.AnimInProgress=0
o.animleftframe=0
end if
o.actVisible=o.animleft(o.animleftframe)
case 3
o.posy -=1
o.fract +=.8
if o.fract>1 then
o.animtopframe = ((o.animtopframe+1) mod 4)
o.fract=0
end if
if o.posy = o.newpos then
o.AnimInProgress=0
o.animtopframe=0
end if
o.actVisible=o.animtop(o.animtopframe)
case 4
o.posy +=1
o.fract +=.8
if o.fract>1 then
o.animbottomframe = ((o.animbottomframe+1) mod 4)
o.fract=0
end if
if o.posy = o.newpos then
o.AnimInProgress=0
o.animbottomframe=0
end if
o.actVisible=o.animbottom(o.animbottomframe)
end select
end if
put (o.posx,o.posy),o.actVisible'Anzeigen
end sub
sub raster
for k as integer=0 to 30
for i as integer=0 to 30
line(i*16,k*16)-(i*16+15,k*16+15),&HFFFFFF,b
next i
next k
end sub