PureBoard

Code: Alles auswählen

if IsScreenActive()

if Os=1
Os=0
LoadSprite(1, "BMP\Karten\Karte_01.bmp", #PB_Sprite_Texture)
 LoadSprite(2, "BMP\Karten\Karte_02.bmp", #PB_Sprite_Texture)
;        ...
endif

;das Hauptprogramm

else
Os=1
delay(20)
endif

Code: Alles auswählen

; --- Initialisation ---
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
MessageRequester("Error", "kein DirectX 7 oder höher", 0)
End
EndIf

#ScreenWidth = 800
#ScreenHeight = 600
#ScreenDepth = 16
If OpenScreen(#ScreenWidth,#ScreenHeight,#ScreenDepth,"Essai Pathfinding") = 0
MessageRequester("Error", "konnte screen nicht öffnen", 0)
End
EndIf
; --- Variablen, global ---
Global ciblex,cibley,departx,departy, AffOpenClosed,affPath
affPath=1

; --- größe des Berechnungsbereichs ---
#max_x=48
#max_y=48
#Schnitt=12 ; Zoom, je größer, dest näher
;wahrscheinlich Ziel
ciblex=1+Random(#max_x-2)
cibley=1+Random(#max_y-2)

;wahrscheinlich Start
departx=1+Random(#max_x-2)
departy=1+Random(#max_y-2)

; --- pour la recherche du chemin ---
Dim map(#max_x,#max_y)
Dim open(#max_x+1,#max_y+1)
Dim parent(#max_x,#max_y,1)
Dim F(#max_x,#max_y)
Dim G(#max_x,#max_y)
Dim H(#max_x,#max_y)
Dim closed(#max_x+1,#max_y+1)
Dim path(#max_x*#max_y,1)

; ************************************************************************************
; *** LES SPRITES ***
; ************************************************************************************

#depart=0
#cible=1
#Souris=2


;/Départ
CreateSprite(#depart, #Schnitt, #Schnitt)
StartDrawing(SpriteOutput(#depart))
Circle(#Schnitt/2,#Schnitt/2,(#Schnitt/2),RGB(255,255,255))
StopDrawing()
;/Cible
CreateSprite(#cible, #Schnitt, #Schnitt)
StartDrawing(SpriteOutput(#cible))
Circle(#Schnitt/2,#Schnitt/2,#Schnitt/2,RGB(255,255,255))
StopDrawing()
;/ Souris
CreateSprite(#Souris, #Schnitt, #Schnitt)
StartDrawing(SpriteOutput(#Souris))
DrawingMode(4)
Box(1,1,#Schnitt-1,#Schnitt-1,RGB(100,200,255))
StopDrawing()

; ************************************************************************************
; *** LES PROCEDURES ***
; ************************************************************************************
Procedure mauer()
Couleur=RGB(100,100,255)
StartDrawing(ScreenOutput())
For y=0 To #max_y
For x=0 To #max_x
If map(x,y)
xa=x*#Schnitt
ya=y*#Schnitt
Box(xa + 1,ya + 1,#Schnitt - 1,#Schnitt - 1,Couleur)
EndIf
Next x
Next y
StopDrawing()
EndProcedure
Procedure init()
path(0,0) = 0
;faire le point sur ce qui est vraiment utile d'initialiser
For a = 0 To #max_x
For b = 0 To #max_y
open(a,b) = 0
parent(a,b,0) = 0
F(a,b) = 0
G(a,b) = 0
H(a,b) = 0
closed(a,b) = 0
Next b
Next a
EndProcedure

Procedure.w ChercheChemin()
; C'est mon interprétation du fameux A*
init()
If departx=ciblex And departy=cibley
fin=2
EndIf
; --- on met le point de départ dans la liste open ---
open(departx,departy)=1
; --- calcul F = G + H pour la Case de départ ---
F(departx,departy)=-1
; --- tant que la liste open n'est pas vide et tant qu'on a pas trouvé la cible
While fin = 0
; --- on cherche la Case la plus avantageuse ( avec F le plus bas) ===
meilleurF = 0
For a = 0 To #max_x
For b = 0 To #max_y
; --- si la Case est open ---
If open(a,b) = 1 And closed(a,b) = 0 And (F(a,b) < meilleurF Or meilleurF = 0)
meilleurF = F(a,b)
x = a
y = b
EndIf
Next b
Next a
; --- il n'y a pas de chemin ---
If meilleurF = 0
fin = 2
EndIf
; --- on met la Case trouvée dans la liste closed
closed(x,y) = 1
; --- on teste les cases autour si fin = 0 ===
; dans cette version le déplacement se fait dans les huits directions
; il est possible d'ajouter un paramètre pour limiter les déplacements à 4 directions
If fin = 0
For a = x - 1 To x + 1
For b = y - 1 To y + 1
; ---- si la Case est libre et n'a pas encore été traitée
If a >= 0 And a <= #max_x And b >= 0 And b <= #max_y
If map(a,b) = 0 And closed(a,b) = 0
interdit = 0
If a=x-1 And b=y-1 And map(x,y-1)=1 And map(x-1,y)=1 : interdit=1 : EndIf
If a=x-1 And b=y+1 And map(x,y+1)=1 And map(x-1,y)=1 : interdit=1 : EndIf
If a=x+1 And b=y-1 And map(x,y-1)=1 And map(x+1,y)=1 : interdit=1 : EndIf
If a=x+1 And b=y+1 And map(x,y+1)=1 And map(x+1,y)=1 : interdit=1 : EndIf
If interdit = 0
; calcule G pour la Case en cours de test ( à adapter selon le jeu)
; si la distance n'a pas d'importance , on peut se contenter de calculer
; le nombre de cases , donc de faire G = G(x,y) + 1
If Abs(a - x) > 0 And Abs(b - y) > 0
G = 14 + G(x,y)
Else
G = 10 + G(x,y)
EndIf
; si la Case n'est pas dans la liste open
If open(a,b) = 0 Or G < G(a,b)
open(a,b) = 1
parent(a,b,0) = x
parent(a,b,1) = y
; --- calcule F = G + H
G(a,b) = G
distance = (Abs(ciblex-a) + Abs(cibley-b))*10
H(a,b) = distance
F(a,b) = G(a,b) + H(a,b)
; --- la cible est trouvée ---
If a = ciblex And b = cibley
fin = 1
Break 2
EndIf
EndIf
EndIf
EndIf
EndIf
Next b
Next a
EndIf
Wend
ProcedureReturn fin
EndProcedure
Procedure Maus(ToucheShift)
If ExamineMouse()
SX = MouseX() / #Schnitt
SY = MouseY() / #Schnitt
If SX >= 0 And SX <= #max_x And SY >= 0 And SY <= #max_y
If ToucheShift = 0
If MouseButton(1)
map(SX,SY)=1 ;place un mur
ElseIf MouseButton(2)
map(SX,SY)=0 ; supprime un Mur
EndIf
Else
If MouseButton(1)
ciblex = SX : cibley = SY ; place la cible
ElseIf MouseButton(2)
departx = SX : departy = SY ; place le départ
EndIf
EndIf
EndIf
EndIf
EndProcedure
Procedure AffOpenClosed()
CoulOpen=RGB(200,255,200)
CoulClosed=RGB(255,200,200)
StartDrawing(ScreenOutput())
For y=0 To #max_y
For x=0 To #max_x
xa=x*#Schnitt
ya=y*#Schnitt
If closed(x,y)
Box(xa + 1,ya + 1,#Schnitt - 1,#Schnitt - 1,CoulClosed)
ElseIf open(x,y)
Box(xa + 1,ya + 1,#Schnitt - 1,#Schnitt - 1,CoulOpen)
EndIf
Next x
Next y
StopDrawing()
EndProcedure
Procedure affPath()
If ChercheChemin()=1
a=-1
b=-1
cx=ciblex
cy=cibley
Couleur=RGB(255,255,100)
StartDrawing(ScreenOutput())
While a <> departx Or b <> departy
a = parent(cx,cy,0)
b = parent(cx,cy,1)
xa=(cx*#Schnitt)+#Schnitt/2
ya=(cy*#Schnitt)+#Schnitt/2
xb=(a*#Schnitt)+#Schnitt/2
yb=(b*#Schnitt)+#Schnitt/2
LineXY(xa,ya,xb,yb,Couleur)
cx = a
cy = b
Wend
StopDrawing()
EndIf
EndProcedure
Procedure AffCadre()
Couleur=RGB(255,255,255)
StartDrawing(ScreenOutput())
DrawingMode(4)
Box(0,0,#Schnitt*(#max_x+1),#Schnitt*(#max_y+1),Couleur)
StopDrawing()
EndProcedure
; ************************************************************************************
; *** BOUCLE PRINCIPALE ***
; ************************************************************************************
Repeat
ClearScreen(0,0,0)
;/ état du clavier
If ExamineKeyboard()
If KeyboardReleased(#PB_Key_F1)
AffOpenClosed=1-AffOpenClosed
EndIf
If KeyboardReleased(#PB_Key_F2)
affPath=1-affPath
EndIf
ToucheShift = KeyboardPushed(#PB_Key_LeftShift) Or KeyboardPushed(#PB_Key_RightShift)
EndIf
;/ Gestion de la souris
Maus(ToucheShift)
;/affiche le fond
mauer()
AffCadre()
If AffOpenClosed
AffOpenClosed()
EndIf
;/Lance la recherche
If affPath
affPath()
EndIf
;/Affiche les sprites
DisplayTransparentSprite(#Souris,MouseX() - #Schnitt / 2,MouseY() - #Schnitt / 2)
DisplayTransparentSprite(#cible,ciblex * #Schnitt,cibley * #Schnitt)
DisplayTransparentSprite(#depart,departx * #Schnitt,departy * #Schnitt)
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
End