Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
6. Minensuchspiel
| Uploader: |  nemored |
| Datum/Zeit: | 09.10.2011 20:02:25 |
Hinweis: Dieser Quelltext ist Bestandteil des Projekts OpenBook: 2D-Spieleprogrammierung, zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.
' *** CODE 6: Minensuchspiel
' *** Spielelemente ***
#DEFINE Offen 16 ' 5. Bit - die Zahlen 0-8 werden freigehalten
#DEFINE Fahne 32 ' 6. Bit
#DEFINE Bombe 64 ' 7. Bit
DIM SHARED AS INTEGER Feldbreite = 20, Feldhoehe = 20, Feldgroesse = 20
DIM SHARED AS INTEGER Bombenzahl = 50
DIM SHARED AS INTEGER feld(0 TO Feldbreite-1, 0 TO Feldhoehe-1)
DIM SHARED AS ANY PTR BildBombe, BildFahne
SCREENRES Feldbreite*Feldgroesse, Feldhoehe*Feldgroesse, 32
BildBombe = IMAGECREATE(Feldgroesse, Feldgroesse)
BildFahne = IMAGECREATE(Feldgroesse, Feldgroesse)
BLOAD "bombe.bmp", BildBombe
BLOAD "fahne.bmp", BildFahne
' ***Bomben verteilen ***
DIM AS INTEGER verteilt = 0, x, y
RANDOMIZE
DO
x = INT(RND*Feldbreite)
y = INT(RND*Feldhoehe)
IF feld(x, y) = Bombe THEN CONTINUE DO
feld(x, y) = Bombe
verteilt += 1
LOOP UNTIL verteilt = Bombenzahl
' *** Feld aufdecken ***
FUNCTION aufdecken(x AS INTEGER, y AS INTEGER) AS INTEGER
' offene sowie mit Fahne versehene Felder werden nicht aufgedeckt
IF feld(x, y) AND Offen THEN RETURN Offen
IF feld(x, y) AND Fahne THEN RETURN Fahne
' Aufdecken einer Bombe
IF feld(x, y) AND Bombe THEN ' "Bombe"-Flag gesetzt?
PUT (x*FeldGroesse, y*FeldGroesse), BildBombe
feld(x, y) OR= Offen ' das "Offen"-Flag setzen
RETURN Bombe
END IF
' normales Feld: umgebende Bomben zaehlen
DIM AS INTEGER zaehler = 0
FOR i AS INTEGER = x-1 TO x+1
IF i < 0 OR i >= FeldBreite THEN CONTINUE FOR ' ausserhalb des Spielfelds
FOR k AS INTEGER = y-1 TO y+1
IF k < 0 OR k >= FeldHoehe THEN CONTINUE FOR ' ausserhalb des Spielfelds
IF feld(i, k) AND Bombe THEN zaehler += 1
NEXT
NEXT
DRAW STRING ((x+.5)*FeldGroesse-4, (y+.5)*FeldGroesse-4), STR(zaehler)
feld(x, y) OR= Offen ' das "Offen"-Flag setzen
' rekursiver Aufruf, wenn keine Bomben in der Naehe sind
IF zaehler = 0 THEN
FOR i AS INTEGER = x-1 TO x+1
IF i < 0 OR i >= FeldBreite THEN CONTINUE FOR
FOR k AS INTEGER = y-1 TO y+1
IF k < 0 OR k >= FeldHoehe THEN CONTINUE FOR
aufdecken i, k
NEXT
NEXT
END IF
RETURN zaehler
END FUNCTION
SUB feldZeigen
FOR x AS INTEGER = 0 TO FeldBreite-1
FOR y AS INTEGER = 0 TO FeldHoehe-1
aufdecken x, y
NEXT
NEXT
END SUB
' *** Hauptprogramm ***
' Raster zeichnen
FOR i AS INTEGER = 0 TO Feldbreite-1
FOR k AS INTEGER = 0 TO Feldhoehe-1
LINE (i*Feldgroesse, k*Feldgroesse)-step(Feldgroesse-1, Feldgroesse-1),, B
NEXT
NEXT
DIM AS INTEGER mausX, mausY, mausB, mausX2, mausY2, mausB2, fx, fy, wert
DO
' Maus abfragen
GETMOUSE mausX, mausY,, mausB
IF mausB THEN
' Position berechnen
fx = mausX \ Feldgroesse
fy = mausY \ Feldgroesse
' auf das Loslassen der Maus warten
DO
GETMOUSE mausX2, mausY2,, mausB2
SLEEP 1
LOOP UNTIL mausB2 = 0
' ueberpruefen, ob sich die Maus noch im selben Feld befindet
IF mausX2\Feldgroesse <> fx OR mausY2\Feldgroesse <> fy THEN CONTINUE DO
IF mausB = 1 THEN
wert = aufdecken(fx, fy)
IF wert = Bombe THEN feldZeigen : GETKEY : EXIT DO
ELSEIF mausB = 2 AND (feld(fx, fy) AND Offen) = 0 THEN
' Fahnenmarkierung setzen bzw. loeschen
feld(fx, fy) XOR= Fahne
PUT (fx*Feldgroesse, fy*Feldgroesse), BildFahne, XOR
END IF
END IF
SLEEP 1
LOOP UNTIL INKEY = CHR(27)
IMAGEDESTROY bildBombe ' Bildpuffer freigeben
IMAGEDESTROY bildFahne