A small Boulderdash design for QBasic / FreeBASIC by Movax

'A small Boulderdash design for QBasic by Movax
'----------------------------------------------

'hey wesker_re! (was bedeutet das eigentlich?)
'hab mich mal eben hingesetzt und dir schnell so 'nen boulder-dash-code
'hingehackt um dir zu zeigen, wie ich das meinte..
'du bewegst die figur mit den pfeil-tasten und mit esc ist schluss.
'man könnte natürlich jetzt noch eine abfrage einbauen, was passieren soll,
'wenn dem spieler ein stein auf den kopf fällt oder eine verzögerung ein-
'bauen, damit die steine nicht so *zack* unten sind..
'aber um nur mal die idee zu verstehen, sollte der code hier eigentlich
'reichen ;)
'ich hab auch schon direkt mit eingebaut, dass steine, welche auf steinen
'landen, NEBEN diesen landen, falls das feld dort frei ist (so ist's beim
'original boulder dash auch) ;) ..
'ich schreib jetzt noch ein paar kommentare dran, damit das alles (hoff ich)
'weitestgehend verständlich ist..
'
'und falls nicht -> movax@gmx.de ;)
'
' greetz,
' -movax-


DECLARE SUB check () '<--------- überprüft, ob ein stein "absinken" kann..
DECLARE SUB feldzeichnen () '<-- oh mein GOTT! was ist DAS?! ;)

SCREEN 13

CONST ESC = 27, UNTEN = 80, OBEN = 72, LINKS = 75, RECHTS = 77
CONST frei = 0, dreck = 1, stein = 2, monsieur = 3

TYPE figur '<- *hach*, ich liebe typen-definitionen :)
x AS INTEGER
y AS INTEGER
oldX AS INTEGER
oldy AS INTEGER
c AS STRING * 1 '<- das ist einfach nur das zeichen das den spieler darstellt
END TYPE

DIM SHARED player AS figur
DIM SHARED feld(16, 10) '<- das spielfeld
DIM SHARED offX
DIM SHARED offY

'Die Variablen oben sind SHARED, weil die zwei anderen SUBs ebenfalls darauf
'zugreifen..

offX = 10: offY = 5 '<- das spielfeld beginnt erst bei 10,5

FOR x = 1 TO 16 '<- wir füllen das feld mit dreck :)
FOR y = 1 TO 10
feld(x, y) = dreck
NEXT y
NEXT x

FOR i = 5 TO 10 '<- das sind die 2 steine-reihen
feld(i, 2) = stein
feld(i, 5) = stein
NEXT i

feldzeichnen '<- ??? *g*

COLOR 6 '<-------- das hier wird der braune spielfeld-rahmen.
FOR i = 10 TO 26 ' braucht man zwar nicht unbedingt aber..
LOCATE 5, i: PRINT CHR$(176)' ach was soll's, sieht schicker aus..
LOCATE 15, i: PRINT CHR$(176)
NEXT i
FOR i = 6 TO 14
LOCATE i, 10: PRINT CHR$(176)
LOCATE i, 26: PRINT CHR$(176)
NEXT i

player.x = 2: player.y = 2 '<- die spieler-variablen setzen..
player.oldX = 2: player.oldy = 2
player.c = CHR$(1) '<- ja, es ist der smiley [:D]

DO '<- mainloop
LOCATE 1, 1: PRINT "X:"; player.x '<- hm.. irgendwie muss ich sowas immer
LOCATE 2, 1: PRINT "Y:"; player.y ' irgendwo stehen haben :)
player.oldX = player.x
player.oldy = player.y

eingabe$ = RIGHT$(INKEY$, 1)

SELECT CASE eingabe$ '<- welche taste wurde gedrückt?
CASE CHR$(OBEN)
IF player.y > 1 AND feld(player.x, player.y - 1) <> stein THEN player.y = player.y - 1
CASE CHR$(UNTEN)
IF player.y < 9 AND feld(player.x, player.y + 1) <> stein THEN player.y = player.y + 1
CASE CHR$(LINKS)
IF player.x > 1 AND feld(player.x - 1, player.y) <> stein THEN player.x = player.x - 1
CASE CHR$(RECHTS)
IF player.x < 15 AND feld(player.x + 1, player.y) <> stein THEN player.x = player.x + 1
CASE CHR$(ESC): END
END SELECT

feld(player.oldX, player.oldy) = frei '<- is ja klar: der spieler geht weg,
' also wird das feld "frei"
feld(player.x, player.y) = monsieur '<- den spieler an die neue Koord.
' auf (oder in?) der karte setzen.
check '<--------------------------------- das ist die routine, die über-
' prüft, ob das feld unter einem
' stein frei ist..
feldzeichnen '<- und das feld zeichnen..

LOCATE player.y + offY, player.x + offX: COLOR 15: PRINT player.c
LOOP '<- hier endet die hauptschleife..

'-------------------------------
'Martijn's Boulder Dash Fan Site
'http://www.bd-fans.com

SUB check
'das hier ist die routine, wie ich sie dir mal in der mail beschrieben hab.
'das gesamte spielfeld wird durchlaufen. trifft die routine auf einen
'stein, dann wird überprüft, ob das feld darunter "frei" ist.
'ist dies der fall, dann wird das feld, auf dem der stein momentan liegt frei
'und der stein sinkt ein feld hinab..
'ist das feld unter einem stein EBENFALLS ein stein und ist rechts oder links
'daneben ein freies feld, dann fällt der stein in dieses leere feld NEBEN dem
'stein.. ist eigentlich gar nicht sooo kompliziert..


FOR x = 1 TO 16
FOR y = 1 TO 10

IF feld(x, y) = stein THEN
IF y + 1 < 11 THEN
SELECT CASE feld(x, y + 1)
CASE frei '<-- ist das feld unter dem stein frei?
feld(x, y) = frei: feld(x, y + 1) = stein
CASE stein '<-- ist der stein auf einen stein gefallen (*aua*) ?
IF feld(x - 1, y + 1) = frei AND feld(x - 1, y) = frei THEN '<- links?
feld(x, y) = frei: feld(x - 1, y + 1) = stein
END IF
IF feld(x + 1, y + 1) = frei AND feld(x + 1, y) = frei THEN '<- rechts?
feld(x, y) = frei: feld(x + 1, y + 1) = stein
END IF
END SELECT
END IF
END IF

NEXT y
NEXT x

END SUB

SUB feldzeichnen
'ich hab keine ahnung, was diese routine macht.. echt nicht! *g*

FOR x = 1 TO 15
FOR y = 1 TO 9
LOCATE y + offY, x + offX '<- ha! OffX und OffY tuen ihren Dienst :)
IF feld(x, y) = frei THEN PRINT " "
IF feld(x, y) = dreck THEN COLOR 7: PRINT CHR$(176)
IF feld(x, y) = stein THEN COLOR 8: PRINT CHR$(254)
IF feld(x, y) = monsieur THEN COLOR 15: PRINT player.c
NEXT y
NEXT x

END SUB