'3D Lab 1.0-Labirinto 3D(versao Beta)
'Copyright 1999(c)WendelSoft
'
'
DECLARE SUB Atualiza ()
DECLARE SUB Mapa ()
DECLARE SUB Retrovisor ()
DECLARE SUB Status ()
DECLARE SUB Translacao ()
DECLARE FUNCTION FimDoJogo! ()
DIM Dst(3) AS INTEGER
DIM SHARED Amb(1 TO 10, 1 TO 10) AS INTEGER
DIM SHARED Aux(1 TO 10, 1 TO 10) AS INTEGER
DIM SHARED Original(1 TO 10, 1 TO 10) AS INTEGER
DIM SHARED xp AS INTEGER, yp AS INTEGER, x AS INTEGER, y AS INTEGER, fct
DIM SHARED xe AS INTEGER, ye AS INTEGER, xx AS INTEGER, yy AS INTEGER
DIM SHARED xr AS INTEGER, yr AS INTEGER, d AS INTEGER
DIM SHARED xer AS INTEGER, yer AS INTEGER, xxr AS INTEGER, yyr AS INTEGER
DIM SHARED pts AS INTEGER, xZ, yZ, de AS INTEGER, Retro AS INTEGER, RetroPos AS INTEGER
RANDOMIZE TIMER
xZ = 64: yZ = 20: cx = 64: cy = 20
DO
CLS
PRINT "3D Lab 1.0 - Copyright 1999 (c) WendelSoft"
PRINT
OPEN "3DLAB.DAT" FOR INPUT AS #1
INPUT #1, Max%
DO
PRINT "Escolha um labirinto ( 1 -"; Max%; ") :";
INPUT "", Lab%
LOOP UNTIL Lab% > 0 AND Lab% <= Max%
INPUT "Ver mapa (1=sim,0=nao) :", domap
DO
INPUT #1, n$
LOOP UNTIL Lab% = VAL(MID$(n$, 2)) AND LEFT$(n$, 1) = ":"
FOR i% = 10 TO 1 STEP -1
LINE INPUT #1, a$
FOR j% = 1 TO 10
z$ = UCASE$(MID$(a$, j%, 1))
IF z$ = "X" THEN xp = j%: yp = i%
Amb(j%, i%) = VAL(z$)
Original(j%, i%) = VAL(z$)
NEXT
NEXT
CLOSE #1
fct = .99 ^ 40
d = 0: xr = xp: yr = yp
DO
xer = INT(RND * 10) + 1
yer = INT(RND * 10) + 1
LOOP UNTIL Original(xer, yer) = 0 AND (xer <> xp OR yer <> yp)
xe = xer: ye = yer
DO
xxr = INT(RND * 10) + 1
yyr = INT(RND * 10) + 1
LOOP UNTIL Original(xxr, yyr) = 0 AND (xxr <> xp OR yyr <> yp) AND (xxr <> xer OR yyr <> yer)
xx = xxr: yy = yyr
de = -1
dly = 1
pts = 0
Mapa
DO
Atualiza
1 k$ = INKEY$
Status
IF TIMER - te! > dly THEN
d2% = de
FOR i% = 0 TO 3
Dst(i%) = 1000
IF i% <> 3 - d2% THEN
SELECT CASE i%
CASE 0: px = xer: py = yer + 1
CASE 1: px = xer + 1: py = yer
CASE 2: px = xer - 1: py = yer
CASE 3: px = xer: py = yer - 1
END SELECT
IF Original(px, py) = 0 AND (px <> xxr OR py <> yyr) THEN Dst(i%) = (px - xr) ^ 2 + (py - yr) ^ 2
END IF
NEXT
Min% = 1000
FOR i% = 0 TO 3
IF Dst(i%) < Min% THEN Min% = Dst(i%)
NEXT
IF Min% < 1000 THEN
n% = 0
FOR i% = 0 TO 3
IF Dst(i%) = Min% THEN n% = n% + 1
NEXT
n% = INT(RND * n% + 1)
FOR de = 0 TO 3
IF Dst(de) = Min% THEN n% = n% - 1
IF n% = 0 THEN EXIT FOR
NEXT
SELECT CASE de
CASE 0: yer = yer + 1
CASE 1: xer = xer + 1
CASE 2: xer = xer - 1
CASE 3: yer = yer - 1
END SELECT
ELSE
de = 3 - d2%
END IF
te! = TIMER
Translacao
IF ABS(xe - xp) < 2 OR at% THEN
at% = 0
IF ye > yp THEN
FOR y = yp + 1 TO ye - 1
IF Amb(xp, y) = 1 THEN EXIT FOR
NEXT
IF y = ye THEN Atualiza: at% = 1
ELSEIF ye < yp AND Retro THEN
FOR y = ye + 1 TO yp - 1
IF Amb(xp, y) = 1 THEN EXIT FOR
NEXT
IF y = yp THEN Retrovisor: at% = 1
END IF
END IF
END IF
Translacao
IF xr = xer AND yr = yer THEN
SCREEN 0
PRINT "Voce perdeu ..."
PRINT
EXIT DO
ELSEIF xr = xxr AND yr = yyr THEN
pts = pts + 1
IF pts MOD 10 = 0 THEN dly = dly * .9
PLAY "MFo4l14cdfa"
DO
xxr = INT(RND * 10) + 1
yyr = INT(RND * 10) + 1
LOOP UNTIL Original(xxr, yyr) = 0 AND (xxr <> xr OR yyr <> yr) AND (xxr <> xer OR yyr <> yer)
SELECT CASE d
CASE 0: xx = xxr: yy = yyr
CASE 1: xx = yyr: yy = 11 - xxr
CASE 2: xx = 11 - xxr: yy = 11 - yyr
CASE 3: xx = 11 - yyr: yy = xxr
END SELECT
Mapa
Atualiza
END IF
SELECT CASE k$
CASE "": GOTO 1
CASE "W", "w", CHR$(0) + "H"
yp = yp + 1
IF Amb(xp, yp) = 1 THEN
yp = yp - 1
GOTO 1
END IF
SELECT CASE d
CASE 0: yr = yr + 1
CASE 1: xr = xr - 1
CASE 2: yr = yr - 1
CASE 3: xr = xr + 1
END SELECT
CASE "S", "s", CHR$(0) + "P"
yp = yp - 1
IF Amb(xp, yp) = 1 THEN
yp = yp + 1
GOTO 1
END IF
SELECT CASE d
CASE 0: yr = yr - 1
CASE 1: xr = xr + 1
CASE 2: yr = yr + 1
CASE 3: xr = xr - 1
END SELECT
CASE "A", "a", CHR$(0) + "K"
FOR x = 1 TO 10
FOR y = 1 TO 10
Aux(x, y) = Amb(x, y)
NEXT
NEXT
FOR x = 1 TO 10
FOR y = 1 TO 10
Amb(y, 11 - x) = Aux(x, y)
NEXT
NEXT
xp2 = yp
yp = 11 - xp
xp = xp2
d = (d + 1) MOD 4
CASE "D", "d", CHR$(0) + "M"
FOR x = 1 TO 10
FOR y = 1 TO 10
Aux(x, y) = Amb(x, y)
NEXT
NEXT
FOR x = 1 TO 10
FOR y = 1 TO 10
Amb(11 - y, x) = Aux(x, y)
NEXT
NEXT
xp2 = 11 - yp
yp = xp
xp = xp2
d = (d + 7) MOD 4
CASE "M", "m"
Mapa
CASE ""
EXIT DO
CASE "R", "r"
Retro = NOT Retro
IF RetroPos = 0 THEN RetroPos = 1
CASE "1", "2", "3", "4"
RetroPos = VAL(k$)
CASE "<", ","
xZ = xZ - 8: yZ = yZ - 2.5
CASE ">", "."
xZ = xZ + 8: yZ = yZ + 2.5
CASE ELSE
BEEP: GOTO 1
END SELECT
LOOP
SCREEN 0
PRINT "Pontos :"; pts
PRINT
LOOP WHILE FimDoJogo
SYSTEM

SUB Atualiza
Translacao
LINE (0, 0)-(639, 199), 0, BF
xt = 320: yt = 100
axt = 320: ayt = 100
FOR y = yp TO 10
IF Amb(xp, y) THEN EXIT FOR
LINE (320 - xt, 100 - yt)-(xt + 319, yt + 99), , B
LINE (320 - xt, 100 - yt)-(320 - axt, 100 - ayt)
LINE (320 - xt, yt + 99)-(320 - axt, ayt + 99)
LINE (xt + 319, yt + 99)-(axt + 319, ayt + 99)
LINE (xt + 319, 100 - yt)-(axt + 319, 100 - ayt)
x3 = (2 * axt + xt) / 3
y3 = (2 * yt + ayt) / 3
IF Amb(xp - 1, y) = 0 THEN
LINE (320 - xt, 100 - yt)-(320 - axt, 100 - yt)
LINE (320 - xt, yt + 99)-(320 - axt, yt + 99)
IF xp - 1 = xe AND y = ye THEN
PAINT (320 - x3, y3 + 99), "Uª"
ELSEIF xp - 1 = xx AND y = yy THEN
PAINT (320 - x3, y3 + 99), 1
END IF
END IF
IF Amb(xp + 1, y) = 0 THEN
LINE (xt + 319, 100 - yt)-(axt + 319, 100 - yt)
LINE (xt + 319, yt + 99)-(axt + 319, yt + 99)
IF xp + 1 = xe AND y = ye THEN
PAINT (x3 + 319, y3 + 99), "Uª"
ELSEIF xp + 1 = xx AND y = yy THEN
PAINT (x3 + 319, y3 + 99), 1
END IF
END IF
ym = (yt + ayt) * .5
IF xp = xe AND y = ye THEN
PAINT (320, ym + 99), "Uª"
LINE (320 - xt, yt + 99)-(320 - xt, ayt + 99)
LINE (xt + 319, yt + 99)-(xt + 319, ayt + 99)
END IF
IF xp = xx AND y = yy THEN
PAINT (320, ym + 99), 1
END IF
axt = xt: ayt = yt
xt = xt * fct: yt = yt * fct
NEXT
IF Retro THEN Retrovisor
Status
END SUB

FUNCTION FimDoJogo
PRINT
PRINT "Deseja continuar [S/N]? ";
DO
a$ = UCASE$(INPUT$(1))
LOOP UNTIL a$ = "S" OR a$ = "N"
PRINT a$
BEEP
FimDoJogo = a$ = "S"
END FUNCTION

SUB Mapa
SHARED domap
IF NOT domap THEN SCREEN 2: EXIT SUB
SCREEN 0: WIDTH 40
FOR y = 10 TO 1 STEP -1
FOR x = 1 TO 10
LOCATE 11 - y, x
IF Original(x, y) THEN
PRINT "Û";
ELSEIF x = xr AND y = yr THEN
SELECT CASE d
CASE 0: PRINT CHR$(24);
CASE 1: PRINT CHR$(27);
CASE 2: PRINT CHR$(25);
CASE 3: PRINT CHR$(26);
END SELECT
ELSEIF x = xer AND y = yer THEN
PRINT "X";
ELSEIF x = xxr AND y = yyr THEN
PRINT "";
END IF
NEXT x, y
a$ = INPUT$(1)
SCREEN 2
END SUB

SUB Retrovisor
SELECT CASE RetroPos
CASE 1: cx = xZ: cy = yZ
CASE 2: cx = 639 - xZ: cy = yZ
CASE 3: cx = 639 - xZ: cy = 199 - yZ
CASE 4: cx = xZ: cy = 199 - yZ
END SELECT
LINE (cx - xZ, cy - yZ)-(cx + xZ - 1, cy + yZ - 1), 0, BF
xt = xZ: yt = yZ
axt = xt: ayt = yt
FOR y = yp TO 1 STEP -1
IF Amb(xp, y) THEN EXIT FOR
LINE (cx - xt, cy - yt)-(xt + cx - 1, yt + cy - 1), , B
LINE (cx - xt, cy - yt)-(cx - axt, cy - ayt)
LINE (cx - xt, yt + cy - 1)-(cx - axt, ayt + cy - 1)
LINE (xt + cx - 1, yt + cy - 1)-(axt + cx - 1, ayt + cy - 1)
LINE (xt + cx - 1, cy - yt)-(axt + cx - 1, cy - ayt)
x3 = (2 * axt + xt) / 3
y3 = (2 * yt + ayt) / 3
IF Amb(xp - 1, y) = 0 THEN
LINE (cx - xt, cy - yt)-(cx - axt, cy - yt)
LINE (cx - xt, yt + cy - 1)-(cx - axt, yt + cy - 1)
IF xp - 1 = xe AND y = ye THEN
PAINT (cx - x3, y3 + cy - 1), "Uª"
ELSEIF xp - 1 = xx AND y = yy THEN
PAINT (cx - x3, y3 + cy - 1), 1
END IF
END IF
IF Amb(xp + 1, y) = 0 THEN
LINE (xt + cx - 1, cy - yt)-(axt + cx - 1, cy - yt)
LINE (xt + cx - 1, yt + cy - 1)-(axt + cx - 1, yt + cy - 1)
IF xp + 1 = xe AND y = ye THEN
PAINT (x3 + cx - 1, y3 + cy - 1), "Uª"
ELSEIF xp + 1 = xx AND y = yy THEN
PAINT (x3 + cx - 1, y3 + cy - 1), 1
END IF
END IF
ym = (yt + ayt) * .5
IF xp = xe AND y = ye THEN
PAINT (cx, ym + cy - 1), "Uª"
LINE (cx - xt, yt + cy - 1)-(cx - xt, ayt + cy - 1)
LINE (xt + cx - 1, yt + cy - 1)-(xt + cx - 1, ayt + cy - 1)
END IF
IF xp = xx AND y = yy THEN
PAINT (cx, ym + cy - 1), 1
END IF
axt = xt: ayt = yt
xt = xt * fct: yt = yt * fct
NEXT
END SUB

SUB Status
LOCATE 1, 1
PRINT USING "PTS:#### X:## Y:## N:"; pts; xr; yr;
SELECT CASE d
CASE 0: PRINT CHR$(24);
CASE 1: PRINT CHR$(26);
CASE 2: PRINT CHR$(25);
CASE 3: PRINT CHR$(27);
END SELECT
END SUB

SUB Translacao
SELECT CASE d
CASE 0: xe = xer: ye = yer: xx = xxr: yy = yyr
CASE 1: xe = yer: ye = 11 - xer: xx = yyr: yy = 11 - xxr
CASE 2: xe = 11 - xer: ye = 11 - yer: xx = 11 - xxr: yy = 11 - yyr
CASE 3: xe = 11 - yer: ye = xer: xx = 11 - yyr: yy = xxr
END SELECT
END SUB