Buchempfehlung
MySQL kurz & gut
MySQL kurz & gut
Das preiswerte Taschen- buch stellt MySQL-rele- vante Inhalte systematisch und knapp dar, sodass es sich optimal zum Nach- schlagen beim Pro- grammieren eignet. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

6. Minensuchspiel

Uploader:Redakteurnemored
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