DUNE 2077

[Macros]

mach es so, wie ich dir geschrieben habe:

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

übrigens: interessante Signatur

[STARGÅTE]

mach es so, wie ich dir geschrieben habe:

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

übrigens: interessante Signatur

ok ich teste es mal

Signatur ... JUP

SCHLECHTE NACHRICHT : GEHT NICHT wieder Chaos

[STARGÅTE]

mmmm da ich fast alles probiert habe und immerwieder nur schrott nach ALT-TAB war habe ich es jetzt so umgeschrieben das ich einfach die EXE noch mal laden lasse und diese dann wieder zu letzten Bild geht. Das ist zwar etwas umständlich aber mir ist nichts anderes eingefallen.

Nehme aber gerne noch vorschläge an (THEMA war das bei ALT-TAB alle Sprites vermischt waren, also zerstört)

[Macros]

Hab (nach langer Suche) die perfekte Pfadfinderroutine für dich gefunden.
Aus irgendeinem Französischen Forum(Kommentare).
Linksklick ist Objekt plazieren.
Rechtsklick ist entfernen.
F2 schaltet das dauernde neuzeichnen des Pfades aus,
nützlich zum Blöckezeichnen.

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

[glubschi90]

Also bei PB ist es momentan so, dass die eingeladenen Sprites beim Minimieren und wieder Wiederherstellen des Screens verloren gehen. Man muss sie also neu einladen.

Jo, das ist wegen der 3.30er Version, die Stargate hat. Seit PB Version 3.93 gibts das Problem nichtmehr.

Zum Pathfinding: Ich habs mal mit dem A* algo versucht, das ganze ist auch schön unf funktioniert super, aber sobald die Map etwas größer ist und einige Hindernisse im Weg sind, dauert das eeeewig bis er einen Weg gefunden hat... und weil das ganze mit LLs funktioniert, wird der RAM auch ziemlich vollgestopft, während er berechnet.

Viele Grüße - Christian

[STARGÅTE]

@Macros

Danke aber ich werde es leider nich SO verwenden können weil ich nur 3.3 habe wie glubschi90 schon sagt und dass mit dem löschen der Sprite ... tja ist wohl dumm gelaufen aber wer geht schon mit ALT-TAB raus und wieder rein. Mein Spiel ist so schnell geladen da kann man auch Beenden und wieder Starten

Und mit der Wegsuche : .... O O dass wird noch eine lange Geschichte glaube ich. Wahrscheinlich werde ich dann erstmal kleinere Wegsucher einbauen wenn z.B nur ein großes Gebäude im weg steht.
Später kann ich das ja noch verfeinern

PS: Zur Zeit mache ich die Soundeffekte, Technologieforschung und Netzwerk, mal gucken wann das nächste Update reinkommt.

[Macros]

Ich hatte auch sehr lange 3.3 (bis vor 1 monat).
Ich habe mir einiges Wissen im anpassen von Codes angeeignet.
Daher sind jetzt ein paar Sachen ausgebessert,
übersetzt (http://germanien.ch/Franzoesisch/ft.htm sei dank )
Probier nochmal, ob er läuft. Wenn nicht schreib mir
welche Fehler der Debugger meldet!
Jetzt kannst du ihn testen.

PS:vieleicht kann in ja auch jemand anderer
mit 3.3 testen und mir Feedback geben, selbst korrigieren.

[glubschi90]

tja ist wohl dumm gelaufen aber wer geht schon mit ALT-TAB raus und wieder rein.

Ich

Mein Spiel ist so schnell geladen da kann man auch Beenden und wieder Starten

Naja, aber andauernd Lust auf Speichern hat wohl keiner, nur weil er z.B. angechattet wird.

[STARGÅTE]

tja ist wohl dumm gelaufen aber wer geht schon mit ALT-TAB raus und wieder rein.

Ich

Mein Spiel ist so schnell geladen da kann man auch Beenden und wieder Starten

Naja, aber andauernd Lust auf Speichern hat wohl keiner, nur weil er z.B. angechattet wird.

ich habe ja autosave beim Beenden JETZT drin

[Macros]

Hallo Stargate,
hast du mein letztes Post gelesen?