Leider habe ich mein Progrämmchen von früher nicht mehr, wo ich das Problem schonmal gelöst hatte (glaub ich). Jedenfalls bekomm ich's jetzt nimmer gebacken.
Hat jemand das/die Probleme schonmal gelöst?
Gleichzeitig möchte ich das Progrämmchen vorstellen - der ein oder andere kann es sicher als Ansatz für Spiele gebrauchen (zumindest wenn's dann geht) ...
Code: Alles auswählen
;*******************************
;* MAP - Proof of Concept *
;* 2009 *
;*******************************
Structure BallTyp
x.w
y.w
xs.w
ys.w
color.l
;wink.l
radius.w
;modified.w
;speed.b
EndStructure
Global NewList BallListe.BallTyp()
Structure Mauerpos
x.w
y.w
EndStructure
Global Dim Mauerarray.Mauerpos(19,14)
Procedure init()
InitSprite()
InitKeyboard()
;Array initialisieren mit -1
For k=0 To 19
For l=0 To 14
Mauerarray(k,l)\x=-1
Mauerarray(k,l)\y=-1
Next l
Next k
EndProcedure
Procedure initsprts()
CreateSprite(0,32,32)
StartDrawing(SpriteOutput(0))
Box(0,0,32,32,RGB(255,255,255))
For k=2 To 32 ;ein kasten soll 32 breit sein (max 20 stück) und 32 hoch (15 stück)
Box(Int(k/2),Int(k/2),32-k,32-k,RGB(200-6*k,0,6*k)) ;da mitte bezugspkt ist, etwas schwer
Next
StopDrawing()
EndProcedure
Procedure mauerzeichnen(posx.w,posy.w)
;geändert damit mauerkoordinaten x-max=20 und y-max=15 sein können
DisplaySprite(0,32*posx.w,32*posy.w)
;in Array eintragen für Kollisionserkennung
Mauerarray(posx,posy)\x=32*posx.w
Mauerarray(posx,posy)\y=32*posy.w
EndProcedure
Procedure feldzeichnen()
Restore LevelDaten
For reihe=0 To 14
Read.s TempString.s
For spalte=0 To 19
If Mid(TempString.s,spalte+1,1)="#"
mauerzeichnen(spalte,reihe)
EndIf
Next spalte
Next reihe
EndProcedure
Procedure tastaturauswerten()
If KeyboardPushed(#PB_Key_Space)
;Ball hinzufügen
AddElement(BallListe()) ;0. Element
BallListe()\x=320
BallListe()\y=260
BallListe()\color=RGB(Random(255),Random(255),Random(255))
BallListe()\radius=1+Random(15) ;in Pixel
BallListe()\xs.w=1
BallListe()\ys.w=1
;BallListe()\modified=-1
EndIf
EndProcedure
Procedure ballzeichnen()
ForEach BallListe()
StartDrawing(ScreenOutput())
Circle(BallListe()\x,BallListe()\y,BallListe()\radius,BallListe()\color)
StopDrawing()
Next
EndProcedure
Procedure ballkollision_reaktion()
#Abstand=5
;jedes Mauerelement mit jedem Ball prüfen
For k=0 To 19
For l=0 To 14
If Mauerarray(k,l)<>-1 ;wenn Mauerelement vorhanden...
;prüfe ob Kollision mit einem Ball vorliegt...
ForEach BallListe()
;Idee: jeweils eine der 4 Ecken etwas vorstrecken (Abstand)
;Insgesamt wird jetzt aber Radius+Abstand vorgestreckt
;Problem: Ecken und Überlappung
;neue Idee: Änderungs-Flag: modified
;Kollision oben
If (BallListe()\x+BallListe()\radius >= Mauerarray(k,l)\x) And (BallListe()\x-BallListe()\radius <= (Mauerarray(k,l)\x)+32) And (BallListe()\y+BallListe()\radius >= Mauerarray(k,l)\y - #Abstand) And (BallListe()\y-BallListe()\radius <= Mauerarray(k,l)\y+32)
BallListe()\ys=-BallListe()\ys
EndIf
;Kollision unten
If (BallListe()\x+BallListe()\radius >= Mauerarray(k,l)\x) And (BallListe()\x-BallListe()\radius <= (Mauerarray(k,l)\x)+32) And (BallListe()\y+BallListe()\radius >= Mauerarray(k,l)\y) And (BallListe()\y-BallListe()\radius <= Mauerarray(k,l)\y+32+#Abstand)
BallListe()\ys=-BallListe()\ys
EndIf
;Kollision links
If (BallListe()\x+BallListe()\radius >= Mauerarray(k,l)\x-#Abstand) And (BallListe()\x-BallListe()\radius <= (Mauerarray(k,l)\x)+32) And (BallListe()\y+BallListe()\radius >= Mauerarray(k,l)\y) And (BallListe()\y-BallListe()\radius <= Mauerarray(k,l)\y+32)
BallListe()\xs=-BallListe()\xs
EndIf
;Kollision rechts
If (BallListe()\x+BallListe()\radius >= Mauerarray(k,l)\x) And (BallListe()\x-BallListe()\radius <= (Mauerarray(k,l)\x)+32+#Abstand) And (BallListe()\y+BallListe()\radius >= Mauerarray(k,l)\y) And (BallListe()\y-BallListe()\radius <= Mauerarray(k,l)\y+32)
BallListe()\xs=-BallListe()\xs
EndIf
Next
EndIf
Next l
Next k
EndProcedure
Procedure ballbeweg()
ForEach BallListe()
BallListe()\x+BallListe()\xs
BallListe()\y+BallListe()\ys
;BallListe()\modified=-1
Next
EndProcedure
Procedure rungame()
Repeat
ExamineKeyboard()
Delay(5)
tastaturauswerten()
feldzeichnen()
ballzeichnen()
ballkollision_reaktion()
ballbeweg()
FlipBuffers()
ClearScreen(0)
Until KeyboardPushed(#PB_Key_Escape)
EndProcedure
;--main--------------------------------------------
init()
OpenScreen(640,480,16,"Map: Proof of Concept")
initsprts()
rungame()
;--Leveldaten
DataSection
LevelDaten:
Data.s "####################"
Data.s "# #"
Data.s "# #"
Data.s "# #"
Data.s "# #"
Data.s "# #"
Data.s "###### ####### #####"
Data.s "# #"
Data.s "# #######"
Data.s "## #### #"
Data.s "# #"
Data.s "# # #"
Data.s "# # #"
Data.s "# #"
Data.s "####################"
EndDataSection