06-29-2003, 10:38 AM
Small Sokobhan clone written in about half an hour (entering the map data and playtesting took the other half hour ;-)). The map is stolen from Gnomekobhan but you can make you own if you want. The object of the game is to push all of the boxes(brown things) onto the holders(green things) in the least number of moves. Use the arrow keys to move around.
Code:
'**** Sokobhan clone ****
'**** LooseCaboose ****
DECLARE SUB updateMoves ()
DECLARE SUB moveBox (x AS INTEGER, Y AS INTEGER)
DECLARE SUB gameLoop ()
DECLARE SUB movePlayer (x AS INTEGER, Y AS INTEGER)
DECLARE SUB initBlockTypes ()
DECLARE SUB loadMap ()
DECLARE SUB drawMap ()
DECLARE SUB playGame ()
DECLARE SUB winGame ()
CONST MAPWIDTH = 20
CONST MAPHEIGHT = 12
CONST BPLAYER = 1
CONST BWALL = 2
CONST BBOX = 3
CONST BBOXHELD = 4
CONST BHOLDER = 5
TYPE blockType
colour AS INTEGER
char AS STRING * 1
END TYPE
TYPE playerType
x AS INTEGER
Y AS INTEGER
moves AS INTEGER
END TYPE
DIM SHARED block(5) AS blockType
DIM SHARED player AS playerType
DIM SHARED map(20, 12)
DIM SHARED numMoves, numHeld, numHolders
playGame
DATA 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2
DATA 2, 1, 0, 0, 0, 0, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2
DATA 2, 2, 2, 2, 2, 2, 0, 2, 2, 2, 2, 0, 0, 0, 0, 2, 2, 2, 2, 2
DATA 2, 2, 2, 2, 2, 2, 0, 2, 2, 2, 2, 0, 2, 2, 0, 2, 2, 2, 2, 2
DATA 2, 2, 2, 2, 2, 2, 0, 2, 2, 2, 2, 0, 2, 2, 0, 2, 2, 2, 2, 2
DATA 2, 2, 2, 2, 2, 2, 3, 0, 0, 0, 0, 0, 2, 2, 0, 2, 2, 2, 2, 2
DATA 2, 2, 0, 0, 0, 0, 0, 2, 2, 2, 2, 2, 2, 2, 0, 2, 2, 2, 2, 2
DATA 2, 2, 0, 2, 2, 2, 0, 0, 0, 0, 0, 3, 0, 0, 0, 2, 2, 2, 2, 2
DATA 2, 2, 0, 2, 2, 2, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 0, 0, 5, 2
DATA 2, 2, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5, 2
DATA 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 0, 0, 5, 2
DATA 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2
SUB drawMap
SCREEN 7: CLS
numHolders = 0
FOR i = 1 TO MAPWIDTH
FOR j = 1 TO MAPHEIGHT
LOCATE j, i
COLOR block(map(i, j)).colour
PRINT block(map(i, j)).char;
IF map(i, j) = BPLAYER THEN
player.x = i
player.Y = j
map(i, j) = 0
END IF
IF map(i, j) = BHOLDER THEN
numHolders = numHolders + 1
END IF
NEXT
NEXT
updateMoves
END SUB
SUB gameLoop
DO
i$ = INKEY$
SELECT CASE i$
CASE CHR$(0) + "H"
IF map(player.x, player.Y - 1) = 0 OR map(player.x, player.Y - 1) = BHOLDER THEN
movePlayer 0, -1
END IF
IF map(player.x, player.Y - 1) = BBOX THEN
IF map(player.x, player.Y - 2) = 0 OR map(player.x, player.Y - 2) = BHOLDER THEN
movePlayer 0, -1
moveBox 0, -1
END IF
END IF
CASE CHR$(0) + "P"
IF map(player.x, player.Y + 1) = 0 OR map(player.x, player.Y + 1) = BHOLDER THEN
movePlayer 0, 1
END IF
IF map(player.x, player.Y + 1) = BBOX THEN
IF map(player.x, player.Y + 2) = 0 OR map(player.x, player.Y + 2) = BHOLDER THEN
movePlayer 0, 1
moveBox 0, 1
END IF
END IF
CASE CHR$(0) + "K"
IF map(player.x - 1, player.Y) = 0 OR map(player.x - 1, player.Y) = BHOLDER THEN
movePlayer -1, 0
END IF
IF map(player.x - 1, player.Y) = BBOX THEN
IF map(player.x - 2, player.Y) = 0 OR map(player.x - 2, player.Y) = BHOLDER THEN
movePlayer -1, 0
moveBox -1, 0
END IF
END IF
CASE CHR$(0) + "M"
IF map(player.x + 1, player.Y) = 0 OR map(player.x + 1, player.Y) = BHOLDER THEN
movePlayer 1, 0
END IF
IF map(player.x + 1, player.Y) = BBOX THEN
IF map(player.x + 2, player.Y) = 0 OR map(player.x + 2, player.Y) = BHOLDER THEN
movePlayer 1, 0
moveBox 1, 0
END IF
END IF
CASE CHR$(27)
END
END SELECT
LOOP
END SUB
SUB initBlockTypes
'**** Player ****
block(BPLAYER).colour = 14
block(BPLAYER).char = CHR$(1)
'**** Wall ****
block(BWALL).colour = 9
block(BWALL).char = CHR$(219)
'**** Box ****
block(BBOX).colour = 6
block(BBOX).char = CHR$(177)
'**** Box in holder ****
block(BBOXHELD).colour = 7
block(BBOXHELD).char = CHR$(178)
'**** Box holder ****
block(BHOLDER).colour = 10
block(BHOLDER).char = CHR$(254)
END SUB
SUB loadMap
FOR i = 1 TO MAPHEIGHT
FOR j = 1 TO MAPWIDTH
READ map(j, i)
NEXT
NEXT
END SUB
SUB moveBox (x AS INTEGER, Y AS INTEGER)
'**** Box is at player position ****
map(player.x, player.Y) = 0
'**** Check if the box is on a holder ****
IF map(player.x + x, player.Y + Y) = BHOLDER THEN
'**** Box turns to concrete ****
SOUND 100, .2
map(player.x + x, player.Y + Y) = BBOXHELD
numHeld = numHeld + 1
ELSE
map(player.x + x, player.Y + Y) = BBOX
END IF
LOCATE player.Y + Y, player.x + x
COLOR block(map(player.x + x, player.Y + Y)).colour
PRINT block(map(player.x + x, player.Y + Y)).char;
'**** Check if all boxes are in their holders ****
IF numHeld = numHolders THEN
winGame
END IF
END SUB
SUB movePlayer (x AS INTEGER, Y AS INTEGER)
numMoves = numMoves + 1
updateMoves
'**** Remove old image ****
LOCATE player.Y, player.x
IF map(player.x, player.Y) = BHOLDER THEN
COLOR block(BHOLDER).colour
PRINT block(BHOLDER).char;
ELSE
PRINT " ";
END IF
'**** Draw new image ****
player.x = player.x + x
player.Y = player.Y + Y
COLOR block(BPLAYER).colour
LOCATE player.Y, player.x
PRINT block(BPLAYER).char;
END SUB
SUB playGame
numMoves = 0
numHeld = 0
'**** Allow data to be read in subsequent games ****
RESTORE
loadMap
initBlockTypes
drawMap
gameLoop
END SUB
SUB updateMoves
LOCATE 14, 1
COLOR 15
PRINT "Moves:"; numMoves
END SUB
SUB winGame
LOCATE 15, 1
COLOR 15
PRINT "Congratulations, you won"
PRINT "Play again? (Y/N)"
DO
i$ = INKEY$
SELECT CASE i$
CASE "Y", "y"
CLS
playGame
CASE "N", "n", CHR$(27)
END
END SELECT
LOOP
END SUB
esus saves.... Passes to Moses, shoots, he scores!
![[Image: sig.php]](http://josh.whtiger.net/images/sig.php)