261 lines
7.4 KiB
QBasic
261 lines
7.4 KiB
QBasic
DECLARE SUB playerspawn (x%, y%)
|
|
DECLARE SUB savelevel ()
|
|
DECLARE FUNCTION iswall% (x%, y%)
|
|
DECLARE SUB loadlevel ()
|
|
DECLARE SUB box (x%, y%)
|
|
DECLARE SUB hazard (x%, y%)
|
|
DECLARE SUB goal (x%, y%)
|
|
DECLARE SUB cursor (x%, y%)
|
|
DECLARE SUB drawtile (i%, j%)
|
|
DECLARE SUB fulldraw ()
|
|
DECLARE SUB place (x%, y%, tile$)
|
|
|
|
SCREEN 13
|
|
|
|
CONST W% = 20, H% = 12
|
|
|
|
DIM SHARED level(W% - 1, H% - 1) AS STRING * 1
|
|
DIM SHARED playerx AS INTEGER
|
|
DIM SHARED playery AS INTEGER
|
|
|
|
fulldraw
|
|
cursor 0, 0
|
|
|
|
playerx = 152
|
|
playery = 90
|
|
|
|
x% = 0
|
|
y% = 0
|
|
done% = 0
|
|
WHILE done% = 0
|
|
playerspawn playerx, playery
|
|
|
|
k$ = INKEY$
|
|
|
|
IF k$ = "q" THEN done% = 1
|
|
|
|
oldx% = x%
|
|
oldy% = y%
|
|
|
|
IF k$ = CHR$(0) + "K" THEN x% = x% - 1
|
|
IF k$ = CHR$(0) + "M" THEN x% = x% + 1
|
|
IF k$ = CHR$(0) + "H" THEN y% = y% - 1
|
|
IF k$ = CHR$(0) + "P" THEN y% = y% + 1
|
|
|
|
IF x% < 0 THEN x% = 0
|
|
IF W% <= x% THEN x% = W% - 1
|
|
IF y% < 0 THEN y% = 0
|
|
IF H% <= y% THEN y% = H% - 1
|
|
|
|
IF k$ = " " THEN
|
|
SELECT CASE level(x%, y%)
|
|
CASE CHR$(0), " ": place x%, y%, "x"
|
|
CASE ELSE: place x%, y%, " "
|
|
END SELECT
|
|
END IF
|
|
|
|
IF k$ = "w" THEN place x%, y%, "W"
|
|
IF k$ = "e" THEN place x%, y%, "@"
|
|
|
|
IF k$ = "p" THEN
|
|
playerx = x% * 16 + 8
|
|
playery = y% * 16 + 10
|
|
fulldraw
|
|
cursor x% * 16, y% * 16
|
|
END IF
|
|
|
|
IF k$ = CHR$(13) THEN
|
|
SCREEN 0
|
|
WIDTH 80, 25
|
|
savelevel
|
|
INPUT dummy
|
|
SCREEN 13
|
|
fulldraw
|
|
cursor x% * 16, y% * 16
|
|
ELSEIF k$ = "l" THEN
|
|
SCREEN 0
|
|
WIDTH 80, 25
|
|
loadlevel
|
|
SCREEN 13
|
|
fulldraw
|
|
cursor x% * 16, y% * 16
|
|
END IF
|
|
|
|
IF oldx% <> x% OR oldy% <> y% THEN
|
|
drawtile oldx%, oldy%
|
|
cursor x% * 16, y% * 16
|
|
END IF
|
|
WEND
|
|
|
|
SUB box (x%, y%)
|
|
LINE (x%, y%)-(x% + 15, y%), 15
|
|
LINE (x%, y%)-(x% + 15, y% + 15), 15
|
|
LINE (x%, y%)-(x%, y% + 15), 15
|
|
LINE (x%, y% + 15)-(x% + 15, y% + 15), 15
|
|
LINE (x% + 15, y%)-(x% + 15, y% + 15), 15
|
|
LINE (x% + 15, y%)-(x%, y% + 15), 15
|
|
END SUB
|
|
|
|
SUB cursor (x%, y%)
|
|
LINE (x%, y%)-(x% + 4, y%), 9
|
|
LINE (x%, y%)-(x%, y% + 4), 9
|
|
LINE (x% + 15 - 4, y%)-(x% + 15, y%), 9
|
|
LINE (x% + 15, y%)-(x% + 15, y% + 4), 9
|
|
LINE (x%, y% + 15 - 4)-(x%, y% + 15), 9
|
|
LINE (x%, y% + 15)-(x% + 4, y% + 15), 9
|
|
LINE (x% + 15, y% + 15 - 4)-(x% + 15, y% + 15), 9
|
|
LINE (x% + 15 - 4, y% + 15)-(x% + 15, y% + 15), 9
|
|
END SUB
|
|
|
|
SUB drawtile (i%, j%)
|
|
tile$ = level(i%, j%)
|
|
x% = i% * 16
|
|
y% = j% * 16
|
|
LINE (x%, y%)-(x% + 15, y% + 15), 0, BF
|
|
SELECT CASE tile$
|
|
CASE "x":
|
|
box x%, y%
|
|
CASE "@":
|
|
hazard x%, y%
|
|
CASE "W":
|
|
goal x%, y%
|
|
END SELECT
|
|
END SUB
|
|
|
|
SUB fulldraw
|
|
FOR i% = 0 TO W% - 1
|
|
FOR j% = 0 TO H% - 1
|
|
drawtile i%, j%
|
|
NEXT
|
|
NEXT
|
|
END SUB
|
|
|
|
SUB goal (x%, y%)
|
|
LINE (x% + 1, y% + 1)-(x% + 1, y% + 14), 3
|
|
LINE (x% + 1, y% + 14)-(x% + 14, y% + 14), 3
|
|
LINE (x% + 14, y% + 14)-(x% + 14, y% + 1), 3
|
|
LINE (x% + 14, y% + 1)-(x% + 11, y% + 10), 3
|
|
LINE (x% + 11, y% + 10)-(x% + 8, y% + 1), 3
|
|
LINE (x% + 7, y% + 1)-(x% + 4, y% + 10), 3
|
|
LINE (x% + 4, y% + 10)-(x% + 1, y% + 1), 3
|
|
END SUB
|
|
|
|
SUB hazard (x%, y%)
|
|
LINE (x%, y% + 15)-(x% + 3, y%), 5
|
|
LINE (x% + 8, y% + 15)-(x% + 11, y%), 5
|
|
LINE (x% + 12, y%)-(x% + 15, y% + 15), 5
|
|
LINE (x% + 4, y%)-(x% + 7, y% + 15), 5
|
|
END SUB
|
|
|
|
FUNCTION iswall% (x%, y%)
|
|
iswall% = 0
|
|
IF level(x%, y%) = "x" THEN iswall% = 1
|
|
END FUNCTION
|
|
|
|
SUB loadlevel
|
|
FOR i% = 0 TO W% - 1
|
|
FOR j% = 0 TO H% - 1
|
|
level(i%, j%) = " "
|
|
NEXT
|
|
NEXT
|
|
|
|
FOR row% = 0 TO H% - 1
|
|
PRINT "walls"; row%;
|
|
INPUT a%, b%, c%
|
|
FOR i% = 0 TO 4
|
|
IF (a% AND 8) <> 0 THEN level(i%, row%) = "x"
|
|
a% = (2 * a%) AND 15
|
|
NEXT
|
|
FOR i% = 4 TO 11
|
|
IF (b% AND 128) <> 0 THEN level(i%, row%) = "x"
|
|
b% = (2 * b%) AND 255
|
|
NEXT
|
|
FOR i% = 12 TO 19
|
|
IF (c% AND 128) <> 0 THEN level(i%, row%) = "x"
|
|
c% = (2 * c%) AND 255
|
|
NEXT
|
|
NEXT
|
|
|
|
INPUT "objects"; goalobj%
|
|
level(goalobj% MOD W%, goalobj% \ W%) = "W"
|
|
|
|
DO
|
|
INPUT obj%
|
|
IF obj% <> 255 THEN level(obj% MOD W%, obj% \ W%) = "@"
|
|
LOOP UNTIL obj% = 255
|
|
|
|
INPUT "spawn"; playerx, playery
|
|
END SUB
|
|
|
|
SUB place (x%, y%, tile$)
|
|
level(x%, y%) = tile$
|
|
drawtile x%, y%
|
|
cursor x% * 16, y% * 16
|
|
END SUB
|
|
|
|
SUB playerspawn (x%, y%)
|
|
LINE (x%, y% - 10)-(x%, y%), 3
|
|
LINE (x%, y%)-(x% - 5, y% + 8), 3
|
|
LINE (x%, y%)-(x% + 5, y% + 8), 3
|
|
END SUB
|
|
|
|
SUB savelevel
|
|
DIM walls(H% - 1, 2) AS INTEGER
|
|
FOR row% = 0 TO H% - 1
|
|
FOR i% = 0 TO 3
|
|
walls(row%, 0) = walls(row%, 0) * 2 + iswall(i%, row%)
|
|
NEXT
|
|
FOR i% = 4 TO 11
|
|
walls(row%, 1) = walls(row%, 1) * 2 + iswall(i%, row%)
|
|
NEXT
|
|
FOR i% = 12 TO 19
|
|
walls(row%, 2) = walls(row%, 2) * 2 + iswall(i%, row%)
|
|
NEXT
|
|
NEXT
|
|
|
|
DIM objects(H% * W% - 1) AS INTEGER
|
|
obj% = 0
|
|
goalx% = -1
|
|
goaly% = -1
|
|
FOR i% = 0 TO W% - 1
|
|
FOR j% = 0 TO H% - 1
|
|
IF level(i%, j%) = "W" THEN
|
|
IF goalx% = -1 AND goaly% = -1 THEN
|
|
goalx% = i%
|
|
goaly% = j%
|
|
ELSE
|
|
' Sentinel for "more than one goal".
|
|
' Yeah it's ugly. Sue me.
|
|
goalx% = -2
|
|
goaly% = -2
|
|
END IF
|
|
ELSEIF level(i%, j%) = "@" THEN
|
|
objects(obj%) = j% * W% + i%
|
|
obj% = obj% + 1
|
|
END IF
|
|
NEXT
|
|
NEXT
|
|
|
|
IF goalx% < 0 OR goaly% < 0 THEN
|
|
PRINT "Error: There must be exactly one goal per level"
|
|
ELSE
|
|
PRINT "Walls:";
|
|
FOR row% = 0 TO H% - 1
|
|
PRINT walls(row%, 0); walls(row%, 1); walls(row%, 2);
|
|
IF row% MOD 4 = 3 THEN
|
|
PRINT
|
|
END IF
|
|
PRINT " ";
|
|
NEXT
|
|
PRINT
|
|
|
|
PRINT "Objects:"; goaly% * W% + goalx%;
|
|
FOR i% = 0 TO obj% - 1
|
|
PRINT objects(i%);
|
|
NEXT
|
|
PRINT 255 'marker for end of objects
|
|
|
|
PRINT "Spawn:"; playerx; playery
|
|
END IF
|
|
END SUB
|
|
|