[Prev][Next][Index][Thread]
RE: Maz files
Title: Message
I have
MAZ files lurking on my machine, dating back to 1991. I have pasted the
text below of the code that drives them - you can see that they are just 'wall
present or absent' 1's and 0's.
This
bit of code includes a solver of sorts - it was useful for designing mazes that
did not favour left or tight-handed mice.
Save
this message as a text file, delete off this guff at the start and rename it
as mazel2.bas
It
will run in Qbasic or QB4.5 - and would not take much effort to port into
VB6. I admit that it looks a bit rough hewn in the light of
hindsight! But it was just knocked up for maze design, not public
admiration.
Cheers
John
-------------------
DECLARE SUB printmaze ()
DECLARE FUNCTION wall! (x!, y!)
DECLARE
SUB loadmaze ()
DECLARE SUB savemaze ()
DECLARE FUNCTION filename$
()
DECLARE FUNCTION getkey$ ()
DECLARE SUB keytext ()
DECLARE SUB
dispmaze ()
DECLARE SUB setupmaze ()
DECLARE SUB editmaze ()
DECLARE
SUB fillsquare (x!, y!)
DECLARE SUB move (a$)
DECLARE SUB drawyou
(c!)
DECLARE SUB drawsquare ()
DECLARE FUNCTION wallcol! (n!)
DECLARE
SUB playmaze ()
DECLARE SUB solvemaze (sx, sy)
DECLARE SUB mark (x!,
y!)
DIM SHARED m(32, 32)
DIM SHARED x, ox, y, oy, ds
CONST csl = 75,
csr = 77, csu = 72, csd = 80
'CONST gc1$ = " ³ÄÀ³³ÚÃÄÙÄÁ¿´ÂÅ ³Ä"
CONST
gc1$ = "oooooooooooooooo ³Ä"
'CONST gc2$ = " !- !! +- -+ +++ !-"' for non ibm
printers
CONST gc2$ = "oooooooooooooooo !-"' for non ibm printers
x = 15:
y = 15
setupmaze
SCREEN 12
ON
ERROR GOTO erh
DO
LOCATE 26, 1
PRINT "Load, Save, Edit, Print,
Quit
"
PRINT
"
"
a$ = getkey$
SELECT CASE a$
CASE
"e": dispmaze: editmaze
CASE "p":
printmaze
CASE "l": loadmaze
CASE
"s": savemaze
CASE "q": END
END
SELECT
LOOP
erh:
IF ERR = 53 OR ERR = 52 THEN ds = 1: RESUME NEXT
ON ERROR GOTO
0
SUB
dispmaze
SCREEN 12
CLS
FOR i = 0 TO 32 STEP 2
FOR j = 1 TO 31
STEP 2
IF m(i, j) THEN LINE (i * 12, j * 12 - 10)-(i * 12,
j * 12 + 10)
NEXT
NEXT
FOR i = 0 TO 32 STEP 2
FOR j =
1 TO 31 STEP 2
IF m(j, i) THEN LINE (j * 12 - 10, i *
12)-(j * 12 + 10, i * 12)
NEXT
NEXT
keytext
END
SUB
SUB
drawsquare
LINE (x * 12 - 12, y * 12 - 10)-STEP(0, 20), wallcol(m(x - 1,
y))
LINE (x * 12 + 12, y * 12 - 10)-STEP(0, 20), wallcol(m(x + 1, y))
LINE
(x * 12 - 10, y * 12 - 12)-STEP(20, 0), wallcol(m(x, y - 1))
LINE (x * 12 -
10, y * 12 + 12)-STEP(20, 0), wallcol(m(x, y + 1))
END
SUB
SUB
drawyou (c)
CIRCLE (12 * x, 12 * y), 8, c
END SUB
SUB
editmaze
DO
drawyou 10 + m
DO
a$ =
INKEY$
LOOP UNTIL a$ <> ""
drawyou 0
move
a$
IF a$ = "c" THEN m = -1
IF a$ = "f" THEN fillsquare x,
y
IF a$ = "m" OR a$ = "v" THEN m = 0
IF a$ = "p" THEN m =
1
IF a$ = "b" THEN playmaze
IF a$ = "s" THEN solvemaze x \
2, y \ 2
IF a$ = "d" THEN dispmaze
IF m = -1 THEN m((x + ox)
/ 2, (y + oy) / 2) = 0
IF m = 1 AND m((x + ox) / 2, (y + oy) / 2) THEN
x = ox: y = oy
drawsquare
LOOP UNTIL a$ = " "
END
SUB
FUNCTION filename$
CLS
FILES "*.maz"
PRINT
INPUT "file name
(no extension): "; f$
filename$ = f$
END
FUNCTION
SUB
fillsquare (x, y)
m(x - 1, y) = 1
m(x + 1, y) = 1
m(x, y + 1) =
1
m(x, y - 1) = 1
END SUB
FUNCTION getkey$
DO
a$ = INKEY$
LOOP UNTIL a$ <>
""
getkey$ = LCASE$(a$)
END FUNCTION
SUB
keytext
LOCATE 26, 1
PRINT "Cut new path, Move, Play"
PRINT "Blind,
Solve, Display, <space> to end."
END SUB
SUB
loadmaze
a$ = filename$
IF a$ = "" THEN EXIT SUB
ds = 0
OPEN a$ +
".maz" FOR INPUT AS #1
IF ds <> 0 THEN
PRINT "file not
found "
SHELL "cd a$"
EXIT SUB
END IF
FOR
i = 0 TO 31
FOR j = 0 TO 31
IF (i + j AND 1)
<> 0 THEN INPUT #1, m(i, j)
NEXT
NEXT
CLOSE #1
END
SUB
SUB
mark (x, y)
CIRCLE (24 * x + 12, 24 * y + 12), 4, 1
END
SUB
SUB
move (a$)
ox = x
oy = y
IF LEN(a$) < 2 THEN EXIT SUB
a =
ASC(MID$(a$, 2, 1))
SELECT CASE a
CASE csl: x = x + 2 * (x >
1)
CASE csr: x = x - 2 * (x < 31)
CASE csu: y = y + 2 *
(y > 1)
CASE csd: y = y - 2 * (y < 31)
END SELECT
END
SUB
SUB
playmaze
CLS
LOCATE
26, 1
PRINT "Play the maze, press space to return to edit"
x = 1: y =
31
DO
drawyou 2 + m
DO
a$ =
INKEY$
LOOP UNTIL a$ <> ""
drawyou 0
move
a$
IF m((x + ox) / 2, (y + oy) / 2) THEN x = ox: y = oy
drawsquare
LOOP UNTIL a$ = " "
dispmaze
END SUB
SUB
printmaze
LOCATE 27, 1
PRINT "Screen or Ibm or Ascii printer or
File"
a$ = LCASE$(getkey$)
SELECT
CASE a$
CASE "s": OPEN "o", 1, "con": gc$ = gc1$: n$ = ""
CASE "i": OPEN "o", 1, "lpt1": gc$ = gc1$: INPUT "Title : ", n$
CASE
"a": OPEN "o", 1, "lpt1": gc$ = gc2$: INPUT "Title : ", n$
CASE "f":
INPUT "Filename for char. image";
f$
OPEN
"o", 1, f$: gc$ =
gc2$
INPUT
"Title : ", n$
CASE ELSE: EXIT SUB
END SELECT
nc = 1
IF a$ =
"i" OR a$ = "a" THEN INPUT "No of copies"; nc
FOR c = 1 TO
nc
PRINT #1, SPACE$(10); n$: PRINT #1, : PRINT #1,
FOR i = 0 TO 32 STEP 2
PRINT #1,
SPACE$(10);
FOR j = 0 TO 32 STEP
2
PRINT #1, MID$(gc$, 1 + wall(j, i - 1) + 2 *
wall(j + 1, i) + 4 * wall(j, i + 1) + 8 * wall(j - 1, i),
1);
PRINT #1, STRING$(2, MID$(gc$, 17 + 2 *
wall(j + 1, i), 1));
NEXT
PRINT
#1,
PRINT #1, SPACE$(10);
FOR j = 0
TO 32 STEP 2
PRINT #1, MID$(gc$, 17 + 1 *
wall(j, i + 1), 1);
PRINT #1, "
";
NEXT
PRINT #1,
NEXT
IF a$ <> "s" THEN PRINT #1, CHR$(12)
NEXT
CLOSE
#1
CLS
END SUB
SUB
savemaze
a$ = filename$
IF a$ = "" THEN EXIT SUB
OPEN a$ + ".maz" FOR
OUTPUT AS #1
FOR i = 0 TO 31
FOR j = 0 TO 31
IF (i + j AND 1) <> 0 THEN WRITE #1, m(i, j)
NEXT
NEXT
CLOSE #1
END
SUB
SUB
setupmaze
FOR i = 0 TO 32
FOR j = 0 TO 32
m(i, j) = 1
NEXT
NEXT
END
SUB
SUB
solvemaze (sx, sy)
dispmaze
DIM s(15, 15) AS INTEGER, k AS
INTEGER
s(sx, sy) = 2: mark sx, sy
FOR k = 2 TO 255
mm =
0
FOR i = 0 TO 15
FOR j = 0 TO
15
IF s(i, j) = k
THEN
FOR di = -1 TO
1
FOR dj =
-1 TO
1
IF ABS(di) + ABS(dj) = 1
THEN
IF m(2 * i + 1 + di, 2 * j + 1 + dj) = 0
THEN
IF s(i + di, j + dj) = 0
THEN
s(i + di, j + dj) = k +
1
mm =
1
mark i + di, j +
dj
END
IF
END
IF
END IF
NEXT
NEXT
END IF
NEXT
NEXT
' BEEP: LOCATE 22, 1: PRINT k, i, j
IF
s(7, 7) <> 0 OR mm = 0 THEN EXIT FOR
NEXT
IF mm = 0 THEN EXIT
SUB
LOCATE
28, 1
PRINT "Path length = "; k - 1;
tx =
7: ty = 7
nx = 7: ny = 7
PSET (tx * 24 + 12, ty * 24 + 12),
4
FOR k
= k TO 2 STEP -1
IF tx > 0 THEN IF s(tx - 1, ty) = k AND m(2 * tx,
2 * ty + 1) = 0 THEN nx = tx - 1: ny = ty
IF tx < 15 THEN IF s(tx +
1, ty) = k AND m(2 * tx + 2, 2 * ty + 1) = 0 THEN nx = tx + 1: ny = ty
IF ty > 0 THEN IF s(tx, ty - 1) = k AND m(2 * tx + 1, 2 * ty) = 0 THEN ny =
ty - 1: nx = tx
IF ty < 15 THEN IF s(tx, ty + 1) = k AND m(2 * tx +
1, 2 * ty + 2) = 0 THEN ny = ty + 1: nx = tx
tx = nx: ty =
ny
LINE -(tx * 24 + 12, ty * 24 + 12), 4
NEXT
END
SUB
FUNCTION wall (x, y)
IF x < 33 AND y < 33 AND x >= 0 AND y
>= 0 THEN wall = m(x, y)
END FUNCTION
FUNCTION wallcol (n)
IF n <> 0 THEN wallcol = 15
END
FUNCTION
What is the format
for a MAZ file?
Derek