PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Rushhour-Klon + Source

https://www.purebasic.fr/german/viewtopic.php?t=21592

Seite 1 von 1

Rushhour-Klon + Source

Verfasst: 08.01.2010 12:44
von puredave
Liebe Leute,
habe hier viel gelesen und von manchem Quelltext profitiert,
wollte deshalb mal einen eigenen Beitrag leisten:
Dieses Spiel kenne ich als "Rushhour" bzw. "Rickshawjam",
es geht ursprünglich darum, die Autos auf einem quadratischen Parkplatz
so zu verschieben, dass ein "Zielauto" von links nach rechts kommt.
Hier also dasselbe als Kugelspiel.


Einiges könnte man gewiss schöner machen
und Bugs gibt's bestimmt auch noch :roll: ,
aber ich finde es macht schon mal Spaß zu spielen...

Zunächst mal der Download-Link: http://www.mal-sondock-fanpage.de/blend ... olonne.zip

Hier der Quelltext...
Falls jemand eine Idee hat, wie man
die Array-Grenzen einfacher abfragen (ohne Arrayindex out of bounds...) kann,
würde ich mich über einen Hinweis freuen...

Grüße,
David

Code: Alles auswählen

InitSprite()
InitKeyboard()
InitMouse()

Enumeration
#kugel
#maus
#bb=306
#bh=306
EndEnumeration

OpenWindow(0, 0, 0, #bb,#bh, "Kugelkolonne...  --  Regeln mit [F1]",#PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0), 0, 0, #bb,#bh, 0, 0, 0)

LoadSprite(#maus, "maus.bmp")
LoadSprite(#kugel, "kugeln.bmp")
TransparentSpriteColor(#maus, RGB(0,0,255))

Define dummy.w
Global level.w, klick.w
level = 1
gewonnen = 0
zuege = 0
Global Dim Feld.w(5,5) 

Procedure Info(text.s)
  ReleaseMouse(1)
  MessageRequester("Info",text)
  ReleaseMouse(0) 
EndProcedure  

Procedure Laden()
Select level
Case 1
  Restore L1
Case 2
  Restore L2
Case 3
  Restore L3
Case 4
  Restore L4
Case 5
  Restore L5
EndSelect
For y.w = 0 To 5
  For x.w = 0 To 5
  Read.w dummy
   Feld(x,y) = dummy 
  Next
Next 
EndProcedure

Laden()

Procedure Ym1(x,y) ; testet, ob das obenliegende Feld (Ym2 => y-2) noch innerhalb des Feldes liegt
  If y < 1         ; und gibt bei Erfolg den Wert des Feldes zurück
  ProcedureReturn -1 ;verboten
  Else
  ProcedureReturn Feld(x,y-1)
  EndIf 
EndProcedure

Procedure Yp1(x,y) ; s.o. 
  If y > 4 
  ProcedureReturn -1
  Else
  ProcedureReturn Feld(x,y+1)
  EndIf 
EndProcedure

Procedure Xm1(x,y)
  If x < 1
  ProcedureReturn -1
  Else
  ProcedureReturn Feld(x-1,y)
  EndIf 
EndProcedure

Procedure Xp1(x,y) ; s.o. Xp1 => x+1 => das Feld rechts neben dem angeklickten Feld
  If x > 4
  ProcedureReturn -1
  Else
  ProcedureReturn Feld(x+1,y)
  EndIf 
EndProcedure

Procedure Ym2(x,y)
  If y < 2
  ProcedureReturn -1 ;verboten
  Else
  ProcedureReturn Feld(x,y-2)
  EndIf 
EndProcedure

Procedure Yp2(x,y)
  If y > 3 
  ProcedureReturn -1
  Else
  ProcedureReturn Feld(x,y+2)
  EndIf 
EndProcedure

Procedure Xm2(x,y)
  If x < 2
  ProcedureReturn -1
  Else
  ProcedureReturn Feld(x-2,y)
  EndIf 
EndProcedure

Procedure Xp2(x,y)
  If x > 3
  ProcedureReturn -1
  Else
  ProcedureReturn Feld(x+2,y)
  EndIf 
EndProcedure

Procedure Bewegen(x,y) ; testet in alle 4 Richtungen (oben, unten, links, rechts) Möglichkeiten, die Kugel zu verschieben
If Ym2(x,y) = Feld(x,y) And Yp1(x,y) = 0 ;Dreier 
  Swap Feld(x,y-2),Feld(x,y+1) 
  ProcedureReturn 1
ElseIf Ym1(x,y) = Feld(x,y) And Yp1(x,y) = 0 ; Zweier 
  Swap Feld(x,y-1),Feld(x,y+1)
  ProcedureReturn 1
EndIf
If Yp2(x,y) = Feld(x,y) And Ym1(x,y) = 0 ; Dreier
  Swap Feld(x,y+2),Feld(x,y-1) 
  ProcedureReturn
ElseIf Yp1(x,y) = Feld(x,y) And Ym1(x,y) = 0 ;Zweier 
  Swap Feld(x,y+1),Feld(x,y-1)
  ProcedureReturn 1
EndIf

If Xm2(x,y) = Feld(x,y) And Xp1(x,y) = 0 ;Dreier 
  Swap Feld(x-2,y),Feld(x+1,y) 
  ProcedureReturn 1
ElseIf Xm1(x,y) = Feld(x,y) And Xp1(x,y) = 0 ; zweier 
  Swap Feld(x-1,y),Feld(x+1,y)
  ProcedureReturn 1
EndIf
If Xp2(x,y) = Feld(x,y) And Xm1(x,y) = 0 ; dreier 
  Swap Feld(x+2,y),Feld(x-1,y) 
  ProcedureReturn 1
ElseIf Xp1(x,y) = Feld(x,y) And Xm1(x,y) = 0 ;zweier 
  Swap Feld(x+1,y),Feld(x-1,y)
  ProcedureReturn 1
EndIf
ProcedureReturn 0 ;nicht erfolgreich=> kein Zug gemacht
EndProcedure

Repeat
  Event.l = WindowEvent() 
  ExamineKeyboard()
  ExamineMouse()
  ClearScreen(RGB(70,70,255))
  
  StartDrawing(ScreenOutput())
  Box(4*51-1,2*51-1,103,52,RGB(195,195,0))
  StopDrawing()
  
For y.w = 0 To 5
  For x.w = 0 To 5
  ClipSprite(#kugel,0,50*Feld(x,y),50,50)
  DisplaySprite(#kugel, 51*x, 51*y)
  If Feld(5,2) = 1 ; Test, gewonnen
    gewonnen = 1 
  EndIf 
  If MouseButton(1)=1 And SpriteCollision(#kugel, 51*x, 51*y,#maus, MouseX(), MouseY()) And klick = 1
    klick = 0 ; verhindert mehrfaches verschieben mit einem Klick 
    If Bewegen(x,y) = 1 ; bei erfolgreicher Bewegung...
      zuege + 1 ;...hat man einen Zug gemacht
    EndIf 
  EndIf   
  Next
Next

 If MouseButton(1) = 0 ; falls der Mausbutton nicht mehr angeklickt ist...
   klick = 1 ; darf man erneut klicken
 EndIf  
 
 If KeyboardReleased(57) ; aktuelles Level neu laden
  Laden()
 EndIf 
 
 If KeyboardPushed(#PB_Key_F1)
    infotext$ = "Ziel des Spieles:" + Chr(13)
    infotext$ + "Die beiden Lachgesichter mit der Maus ganz nach rechts durchklicken." + Chr(13)
    infotext$ + "" + Chr(13)
    infotext$ + "Wie geht das?" + Chr(13)
    infotext$ + "Jeweils 2 oder 3 gleichfarbige Kugeln gehören zusammen." + Chr(13)
    infotext$ + "Sie können entweder horizontal oder vertikal bewegt werden," + Chr(13)
    infotext$ + "indem du auf die aussenliegende Kugel (links, rechts, oben oder unten) " + Chr(13)
    infotext$ + "klickst. Falls in dieser Richtung ein freies Feld (schwarzer Ring) " + Chr(13)
    infotext$ + "liegt, werden die zusammengehörigen Kugeln entsprechend verschoben. " + Chr(13)
    infotext$ + "" + Chr(13)
    infotext$ + "Ansonsten:" + Chr(13)
    infotext$ + "Falls gar nichts mehr hilft, kannst du das aktuelle Level mit" + Chr(13)
    infotext$ + "der Leertaste neu einlesen. Nach 5 Leveln ist Schluß..." + Chr(13)
    infotext$ + "Dieses Spiel kenne ich auch als 'Rushhour' und 'rickshawjam'." + Chr(13)
    infotext$ + "" + Chr(13)
    infotext$ + "" + Chr(13)
    infotext$ + "VIEL SPASS!!" + Chr(13)
    infotext$ + "David" + Chr(13)        
    Info(infotext$)
 EndIf 
 
 If gewonnen = 1
   gewonnen = 0 
   infotext$ = "Glückwunsch! " + Chr(13) 
   infotext$ + "Du hast das Level " + Str(level) + " nach " + Chr(13)
   infotext$ + Str(zuege) + " Zuegen geschafft!" 
   Info(infotext$)   
   level + 1
   zuege = 0
   Laden()   
 EndIf    
  
DisplayTransparentSprite(#maus, MouseX(), MouseY())

  FlipBuffers() 
  Delay(5) 
Until KeyboardPushed(1)
CloseScreen()
End

DataSection
L1:
Data.w 02,03,00,04,05,06
Data.w 02,03,00,04,05,06
Data.w 02,01,01,04,00,00
Data.w 00,00,10,07,07,07
Data.w 00,00,10,00,00,08
Data.w 00,00,09,09,09,08

L2:
Data.w 02,03,03,00,05,00
Data.w 02,04,04,04,05,06
Data.w 01,01,08,07,00,06
Data.w 09,10,08,07,00,00
Data.w 09,10,12,00,00,00
Data.w 11,11,12,00,00,00

L3:
Data.w 02,02,00,04,05,00
Data.w 03,03,03,04,05,00
Data.w 13,01,01,00,05,06
Data.w 13,12,12,00,00,06
Data.w 00,00,10,11,07,07
Data.w 08,08,10,11,00,00

L4:
Data.w 07,02,03,04,05,05
Data.w 07,02,03,04,08,06
Data.w 00,01,01,00,08,06
Data.w 00,09,11,11,08,00
Data.w 10,09,00,00,00,13
Data.w 10,09,12,12,00,13

L5:
Data.w 00,11,10,08,08,08
Data.w 00,11,10,09,07,07
Data.w 01,01,10,09,06,05
Data.w 12,00,00,00,06,05
Data.w 12,13,13,00,00,04
Data.w 02,02,03,03,03,04

EndDataSection

; Leeres Level:
; Data.w 00,00,00,00,00,00
; Data.w 00,00,00,00,00,00
; Data.w 01,01,00,00,00,00
; Data.w 00,00,00,00,00,00
; Data.w 00,00,00,00,00,00
; Data.w 00,00,00,00,00,00

Re: Rushhour-Klon + Source

Verfasst: 08.01.2010 13:04
von X360 Andy
Schönes Spiel

Aber wie zum Teufel kommt man in Leven 3 weiter ?
Ich hab es 10 minuten jetzt versucht ... :mrgreen:

Re: Rushhour-Klon + Source

Verfasst: 08.01.2010 13:08
von Kiffi
puredave hat geschrieben:Liebe Leute,
habe hier viel gelesen und von manchem Quelltext profitiert,
wollte deshalb mal einen eigenen Beitrag leisten:
Löblich! Danke! :allright:

Grüße ... Kiffi

Re: Rushhour-Klon + Source

Verfasst: 08.01.2010 14:06
von STARGÅTE
zu der Frage:
Falls jemand eine Idee hat, wie man
die Array-Grenzen einfacher abfragen (ohne Arrayindex out of bounds...) kann,
würde ich mich über einen Hinweis freuen...
Mache dein Spielfeld einfach im einen Rand größer und legel außen eine Art "Wand".
Global Dim Feld.w(5,5) --->> Global Dim Feld.w(7,7)
Dein echtes Feld liegt dann nicht mehr in [0,5]x[0,5] sondern [1,6]x[1,6]
Diese Wand sieht man im Spiel selber nicht, für die Array-Abfrage sparst du dir dann aber die Abfrage ob du außerhalb des Arrays bist. denn wenn du dann "scheinbar" am rand in deinem Spiel bist, und ein Feld weiter außen abfragst wird doch "WAND" zurückgegeben also wie als wenn dort kugel wären. die Wand selber kann man nicht verschieben dort tritt eine Abfrage nie auf, somit sollte es kein Arrayindex out of bounds geben...

Re: Rushhour-Klon + Source

Verfasst: 08.01.2010 21:10
von puredave
Schönen Dank für die schnellen Antworten!

@Andy:
Bin beim dritten Level selbst noch am Knobeln,
habe es aber korrekt rauskopiert.
Wenn ich 'ne Lösung finde, melde ich mich noch mal.

@Stargate:
Danke für die Anregung,
werde es mal so probieren.

Grüße,
David :)
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de