'===========================================================================
' Subject: 3D MAZE PROGRAM                   Date: 02-28-99 (23:01)       
' Author:  Antoni Gual                       Code: QB, QBasic, PDS        
' Origin:  agual@eic.ictnet.es             Packet: GRAPHICS.ABC
'===========================================================================
'program 3dmaze
'1994 AGV

DECLARE SUB infoscreen ()
DECLARE SUB Display2D (ori%, posx%, posy%)
DECLARE SUB Draw2DWall (ix%, iy%)
DECLARE SUB Crash (posx AS INTEGER, posy AS INTEGER)
DECLARE SUB MakePath (x1%, y1%)
DECLARE SUB RandomPath (x%, y%)
DECLARE SUB PutWall (ix%, iy%, clr%)
DECLARE SUB MazeClean ()
DECLARE SUB Target (posx%, posy%)
DECLARE SUB Display3d (posx%, posy%)
DECLARE SUB Turn (posx%, posy%, giro$, ori%)
DECLARE SUB DoMove (posx%, posy%, vx%, vy%)
DECLARE SUB Question (in%, min%, max%, lloc%, txT$)
DECLARE SUB InitMaze ()







CONST planos = 10        'nr of visible levels

'perspective constants screen width -320 a +320, hi -175 a +175)
CONST kancho = 350        'width pixels  1rst plane wall
CONST horiz = 120         'horizon vertical position
CONST rectang = 2         'wall heigth/width
  


DEFINT A-Z
OPTION BASE 0
DIM SHARED lmax AS INTEGER, dime AS INTEGER, DisplayTime AS SINGLE
DIM SHARED fugalto AS INTEGER, fugabajo AS INTEGER, FillWalls AS INTEGER
DIM SHARED markpath AS INTEGER
SCREEN 9     '640x350,(2 p ginas)
'paleta
DIM SHARED pal(64)
FOR i = 0 TO 3: FOR j = 0 TO 15: pal(16 * i + j) = j + 16 * i: NEXT: NEXT
'PALETTE USING pal(0)
infoscreen
'tama¤o laberinto
lmax = 8                         'tama¤o por defecto
maxsiz = (SQR(((FRE(-1) - 4000) / 2)) - 3) / 2'lab mas grande que cabe en mem
CALL Question(lmax, 3, maxsiz, 0, "Maze size")'dimensiones ,max  admisible Qbasic 101*78
dime = lmax * 2 + 2
DIM SHARED Maze(0 TO dime, 0 TO dime)   'Maze(0,x),Maze(x,0),Maze(dime,x) y Maze(x,dime)
                                        'initialised to -2 (out of maze)
                                        '(odd,even) or(even,odd)=walls
                                        '(even,even)= paths
                                        'path values : explored -1, unexplored 0
                                        '-2 target
                                        'wall values: 1 to 15 wall,0 no wall

                                        '(odd,odd)= not used
 
CLS
'Creates maze, displaying process

RANDOMIZE TIMER
InitMaze
x1 = INT(RND * (lmax - 1)) * 2 + 2
y1 = INT(RND * (lmax - 1)) * 2 + 2
MakePath x1, y1
'PutWall lmax * 2, lmax * 2 + 1, 0
a$ = INPUT$(1)
MazeClean

'Player position
ori = 1
x1 = INT(RND * (lmax - 1)) * 2 + 2
y1 = INT(RND * (lmax - 1)) * 2 + 2
Maze(x1, y1) = -2
posx = 2: posy = 2
fugalto = 120
fugabajo = -340
FillWalls = -1
markpath = 0
'inicializa  juego
DisplayTime = TIMER
ON TIMER(1) GOSUB DisplayTime
TIMER ON
Display3d posx, posy
'bucle juego
DO
        DO
                k1$ = UCASE$(INKEY$)
        LOOP UNTIL LEN(k1$)
        K$ = RIGHT$(k1$, 1)
        SELECT CASE K$
                CASE "H"       'forward
                        DoMove posx, posy, 1, 0
                        
                CASE "G"        'forward left
                        DoMove posx, posy, 1, -1
                        
                CASE "I"        'forward right
                        DoMove posx, posy, 1, 1
                        
                CASE "P"        'backwards
                        DoMove posx, posy, -1, 0
                        
                CASE "O"        'backwards left
                        DoMove posx, posy, -1, -1
                       
                CASE "Q"        'backwards right
                        DoMove posx, posy, -1, 1
                        
                CASE "K"        'right
                        DoMove posx, posy, 0, -1
                       
                CASE "M"        'left
                        DoMove posx, posy, 0, 1
                       
                CASE "R"        'left turn
                        Turn posx, posy, "I", ori
                       
                CASE "S"        'right turn
                        Turn posx, posy, "D", ori
                       
                CASE "Z"        'down
                   IF fugalto < 120 THEN fugalto = fugalto + 30: fugabajo = fugabajo + 15

                CASE "A"        'up
                   IF fugalto > -240 THEN fugalto = fugalto - 30: fugabajo = fugabajo - 15
                CASE "T"
                   FillWalls = NOT FillWalls
                CASE "X"
                    markpath = NOT markpath
                CASE ";"
                    TIMER STOP: infoscreen: TIMER ON
                CASE CHR$(27)
                        Display2D ori, posx, posy
                        Display3d posx, posy
        END SELECT
        Display3d posx, posy
LOOP

END
DisplayTime:
LOCATE 25, 38: COLOR 15: PRINT "Time: "; INT(TIMER - DisplayTime);
RETURN

SUB Crash (posx AS INTEGER, posy AS INTEGER)
   'place here any fancy collision display routine
   a$ = INKEY$
END SUB

SUB Display2D (ori, posx, posy) 'displays 2d maze each time you press ESC
   
   a$ = INKEY$
   TIMER STOP
   SCREEN 12
   
   WINDOW (2 * lmax + 1, .99)-(.99, 2 * lmax + 1)
   CLS
   ori1 = ori
   DO WHILE ori > 1
       Turn posx, posy, "I", ori
   LOOP
   
   FOR i = 1 TO dime - 1 'STEP 2
      FOR j = 1 TO dime - 1 'STEP 2
         Draw2DWall i, j
      NEXT
   NEXT
   
   DO
   LOOP UNTIL INKEY$ <> ""
   DO WHILE ori < ori1
      Turn posx, posy, "D", ori
   LOOP
   TIMER ON
END SUB

SUB Display3d (posx, posy)
   
   STATIC pantvis AS SINGLE
   CONST medio = .5
   IF pantvis = 0 THEN pantvis = medio
   'encontrar Target
   fondo = ABS(planos) * 2 + 1
   IF (2 * lmax + 3) - posx > fondo THEN ultfila = fondo ELSE ultfila = (2 * lmax + 3) - posx
   pantvis = -pantvis
   SCREEN 9, 0, medio + pantvis, medio - pantvis
   WINDOW (-320, -175)-(320, 175)
   COLOR 0
   CLS
   TIMER STOP
  
   'for each row of walls, from farthest to nearest
   FOR fila = ultfila TO 3 STEP -2
      

   ' temporal variables for this row
   
      i1 = kancho / (fila)                   'i1 coord x parte lejana cuadro
      i2 = kancho / (fila - 2)               'i2 coord x patre cercana cuadro
      h1 = horiz + fugalto / fila            'h1 coord y alta  lejana
      h2 = horiz + fugalto / (fila - 2)      'h2 coord y alta lejana
      l1 = horiz + fugabajo / fila           'l1 coord y baja cercana
      l2 = horiz + fugabajo / (fila - 2)     'l2 coord y baja lejana
      fx = fila
      'calcula n§ caras visibles lateralmente, izq y der
     
      IF (posy - fx) < 1 THEN
         izq = 1 - posy
      ELSE
         izq = -fx
      END IF
     
      IF (posy + fx) > (lmax * 2 + 1) THEN
         der = (lmax) * 2 - posy + 1
         der1 = der - 1
      ELSE
         der = fx
         der1 = der
      END IF
     
      'drawing..
      'perpendicular walls
      FOR j = izq TO der1 STEP 2
         clr = Maze(posx + fila - 2, posy + j + 1)
         IF clr <> 0 THEN
            IF FillWalls THEN
               LINE (j * i1, h1)-((j + 2) * i1, l1), clr, BF
            ELSE
               LINE (j * i1, h1)-((j + 2) * i1, l1), clr, B
            END IF
         END IF
         IF Maze(posx + fila - 3, posy + j + 1) = -2 THEN
            COLOR 15
            LINE (j * i1, l1)-(j * i2, l2)
            LINE -((j + 2) * i2, l2)
            LINE -((j + 2) * i1, l1)
            LINE -(j * i1, l1)
            PAINT ((j + 1) * i1, (l1 + l2) / 2), 15
         END IF
         'draw path explored marks
         IF markpath THEN
            pisado = Maze(posx + fila - 3, posy + j + 1)
            IF pisado = -1 THEN
               CIRCLE (i1 * (j + 1), (2 * l1 + l2) / 3), .05 * i1, 7, , , .2
            END IF
         END IF
      NEXT
      'parallel walls left of viewpoint
      FOR j = izq TO -1 STEP 2
         clr = Maze(posx + fila - 3, posy + j)
         IF clr <> 0 THEN
            COLOR clr
            LINE (j * i2, h2)-(j * i2, l2)'vertical lejana ,abajo
            LINE -(j * i1, l1)            'fuga abajo, hacia atr s
            LINE -(j * i1, h1)            'vertical cercana, arriba
            LINE -(j * i2, h2)            'fuga arriba,hacia DoMove
            IF FillWalls THEN PAINT (j * (i1 + 2 * i2) / 3, (2 * l1 + l2) / 3), clr, clr
            
         END IF
      NEXT
      'parallel walls, right of viewpoint
      FOR j = der TO 1 STEP -2
         clr = Maze(posx + fila - 3, posy + j)
         IF clr <> 0 THEN
            COLOR clr
            LINE (j * i2, h2)-(j * i2, l2)'vertical lejana ,abajo
            LINE -(j * i1, l1)            'fuga abajo, hacia atr s
            LINE -(j * i1, h1)            'vertical cercana, arriba
            LINE -(j * i2, h2)            'fuga arriba,hacia DoMove
            IF FillWalls THEN PAINT (j * (i1 + 2 * i2) / 3, (2 * l1 + l2) / 3), clr, clr
           
         END IF
      NEXT

   'a$ = INPUT$(1)
   NEXT
   TIMER ON

SCREEN 9, 0, medio + pantvis, medio + pantvis

END SUB

SUB DoMove (posx, posy, vx, vy)
         
     IF vy = 0 AND Maze(posx + vx, posy) = 0 THEN
         posx = posx + 2 * vx
     ELSEIF vx = 0 AND Maze(posx, posy + vy) = 0 THEN
         posy = posy + 2 * vy
     ELSEIF Maze(posx, posy + vy) = 0 AND Maze(posx + vx, posy + 2 * vy) = 0 THEN
         posx = posx + 2 * vx
         posy = posy + 2 * vy
     ELSEIF Maze(posx + vx, posy) = 0 AND Maze(posx + 2 * vx, posy + vy) = 0 THEN
         posx = posx + 2 * vx
         posy = posy + 2 * vy
     ELSE
         Crash posx, posy
     END IF
     
     IF Maze(posx, posy) = -2 THEN
        CALL Target(posx, posy): END
     END IF
     Maze(posx, posy) = -1
END SUB

SUB Draw2DWall (ix, iy)
   SELECT CASE iy MOD 2
      CASE 0
         IF (ix MOD 2) = 1 THEN
            LINE (ix, (iy - 1))-(ix, (iy + 1)), Maze(iy, ix)
         ELSE

            SELECT CASE Maze(iy, ix)
            CASE -1
               IF markpath THEN CIRCLE (ix, iy), .1
            CASE -2
               LINE (ix - 1, iy - 1)-(ix + 1, iy + 1), 15, BF
            END SELECT
         END IF
      CASE 1
         IF (ix MOD 2) = 0 THEN LINE ((ix - 1), iy)-((ix + 1), iy), Maze(iy, ix)
   END SELECT

END SUB

SUB infoscreen
COLOR 14
PRINT "--------------------------- maze3d.bas--------------------------------"
COLOR 15
PRINT "- It's a 3d maze viewer. I programmed this several years before knowing about"
PRINT "  Raytracers, so it uses the old trick  of drawing all walls in the vision range"
PRINT "  from farthest to nearest, so the nearest walls will overwrite the farthest"
PRINT "  This approach has one advantage, you can look over the top of the walls."
PRINT "  .....It's impossible with a Wolfenstein Ray Tracer type maze"
PRINT "- It has a fast random maze generator and an overwiew feature"
PRINT "- The program will calculate the biggest maze that fits in your memory"
PRINT "- To save routines, pointers,.. i had the big idea of turning the whole"
PRINT "maze array each time there is a direction change. A bit slow for big mazes.."
COLOR 12
PRINT
PRINT "Move with the number pad.Change direction with the 0 and  the. of the pad"
PRINT "A Z rises/lowers  point of view "
PRINT "T   toggles transparent / filled walls"
PRINT "X   toggles display/not display explored path"
PRINT "ESC displays the maze overview"
PRINT "F1  displays this screen"
PRINT
COLOR 13
PRINT "agual@eic.ictnet.es"
COLOR 15
PRINT "Press any key to continue.."
a$ = INPUT$(1)
END SUB

SUB InitMaze             'Fills maze array with walls before calling make path
   'WINDOW (.99, .99)-(2 * lmax + 1, 2 * lmax + 1)
   FOR i = 0 TO dime
     Maze(i, 0) = -2: Maze(i, dime) = -2
   NEXT
   FOR j = 0 TO dime
      Maze(0, j) = -2: Maze(dime, j) = -2
   NEXT
   SCREEN 12
   WINDOW (2 * lmax + 1, .99)-(.99, 2 * lmax + 1)
   CLS
  
   FOR i = 1 TO dime - 1 STEP 2
            FOR j = 1 TO dime - 1 STEP 2
               CALL PutWall(i, j + 1, RND * 6 + 1)
               CALL PutWall(i + 1, j, RND * 6 + 9)
            NEXT
      
   NEXT
END SUB

SUB MakePath (x1, y1) ' makes a random and connected path thru' maze
                        ' Calls Putwall with color 0 to delete walls and
                        ' display processs
                        
   Maze(x1, y1) = 1
   CALL RandomPath(x1, y1)
   DO
   a = 0
   FOR i = 2 TO lmax * 2 STEP 2
      FOR j = 2 TO lmax * 2 STEP 2
         IF Maze(i, j) = 0 THEN
            a = 1
            IF Maze(i - 2, j) = 1 THEN
                Maze(i, j) = 1: CALL PutWall(i - 1, j, 0)
                CALL RandomPath(i, j)
            ELSEIF Maze(i + 2, j) = 1 THEN
                Maze(i, j) = 1: CALL PutWall(i + 1, j, 0):
                CALL RandomPath(i, j)
            ELSEIF Maze(i, j - 2) = 1 THEN
                Maze(i, j) = 1: CALL PutWall(i, j - 1, 0):
                CALL RandomPath(i, j)
            ELSEIF Maze(i, j + 2) = 1 THEN
                Maze(i, j) = 1: CALL PutWall(i, j + 1, 0)
                CALL RandomPath(i, j)
            END IF
         END IF
       NEXT
   NEXT
   LOOP UNTIL a = 0

END SUB

SUB MazeClean  'Clean marks used by MakePath before going into 3d part
   FOR i = 2 TO 2 * lmax STEP 2
      FOR j = 2 TO 2 * lmax STEP 2
         Maze(i, j) = 0
      NEXT
   NEXT

END SUB

SUB PutWall (ix, iy, clr) 'put a wall in the maze array and draws it to screen
   Maze(iy, ix) = clr
   Draw2DWall ix, iy
END SUB

SUB Question (in, min, max, lloc, txT$)
   IF lloc < 0 THEN CLS
   lloc = ABS(lloc)
   DO
      IF lloc > 0 THEN LOCATE lloc, 1
      txt1$ = txT$ + ":" + STR$(min) + "<" + STR$(max) + " (" + STR$(in) + ") "
      PRINT txt1$; SPACE$(60 - LEN(txt1$)); ":"; : INPUT UsrInput$
      IF UsrInput$ = "" THEN EXIT DO
      IF VAL(UsrInput$) <> 0 OR UsrInput$ = "0" THEN
         in = VAL(UsrInput$)
      END IF
   LOOP UNTIL in >= min AND in <= max

END SUB

SUB RandomPath (x, y)     'generates random turns in the path being opened
   x1 = x: y1 = y
   largo = INT(RND * lmax)
   i = 1
   D0 = 0: D2 = 0: D3 = 0: D1 = 0
   DO WHILE D1 + D2 + D3 + D0 < 4 AND i < largo
      Recta = INT(RND * lmax)
      j = 0
      DO
        dir = INT(RND * 4)
        OK = 0
        SELECT CASE dir
         CASE 0
            IF Maze(x1 - 2, y1) = 0 THEN
               Maze(x1 - 2, y1) = 1
               CALL PutWall(x1 - 1, y1, 0)
               x1 = x1 - 2: j = j + 1: OK = 1
            ELSE
               D0 = 1
            END IF
         CASE 1
            IF Maze(x1, y1 - 2) = 0 THEN
               Maze(x1, y1 - 2) = 1
               CALL PutWall(x1, y1 - 1, 0)
               y1 = y1 - 2: j = j + 1:  OK = 1
            ELSE
               D1 = 1
            END IF
         CASE 2
            IF Maze(x1 + 2, y1) = 0 THEN
               Maze(x1 + 2, y1) = 1
               CALL PutWall(x1 + 1, y1, 0)
               x1 = x1 + 2: j = j + 1:  OK = 1
            ELSE
               D2 = 1
            END IF
         CASE 3
            IF Maze(x1, y1 + 2) = 0 THEN
               Maze(x1, y1 + 2) = 1
               CALL PutWall(x1, y1 + 1, 0)
               y1 = y1 + 2: j = j + 1:  OK = 1
            ELSE
               D3 = 1
            END IF
         END SELECT
         'FOR K = 1 TO 10: LOCATE 1, 1: COLOR 7: PRINT x; y, x1; y1, dir; : NEXT
      'a$ = INPUT$(1)
      LOOP UNTIL j = Recta OR OK = 0
      i = i + j
   LOOP
END SUB

SUB swapscreen
   STATIC pag
   IF pag = 0 THEN pag = 1
   a = 7 * INT(RND * 8)
   SELECT CASE pag
      CASE -1
         SCREEN 9, 0, 0, 1
      CASE 1
         SCREEN 9, 0, 1, 0
   END SELECT
   pag = -pag

END SUB

SUB Target (posx, posy)
'palette USING pal(0)

SCREEN 9, 0, 0
CLS
 
LOCATE 12, 30:  PRINT "You did it!"
LOCATE 13, 30: PRINT "In "; TIMER - DisplayTime; " Seconds"
SLEEP
END SUB

SUB Turn (posx, posy, giro$, ori) ' use aux array to turn all maze 90
                                  ' it allows to use always the same drawing
                                  ' and collision detection routine..
                                  ' it changes posx, posy and orientation
   
   a = dime
   a1 = dime
   B = lmax + 1
   'monitor
   SELECT CASE giro$
      CASE "I"
         FOR i = 1 TO B - 1
            FOR j = 1 TO B
               t = Maze(i, j)
               Maze(i, j) = Maze(j, a1 - i)
               Maze(j, a1 - i) = Maze(a1 - i, a1 - j)
               Maze(a1 - i, a1 - j) = Maze(a1 - j, i)
               Maze(a1 - j, i) = t
            NEXT
         NEXT
         ori = ori - 1
         nposx = a - posy: nposy = posx
      CASE "D"
         FOR i = 1 TO B - 1
            FOR j = 1 TO B
               t = Maze(i, j)
               Maze(i, j) = Maze(a1 - j, i)
               Maze(a1 - j, i) = Maze(a1 - i, a1 - j)
               Maze(a1 - i, a1 - j) = Maze(j, a1 - i)
               Maze(j, a1 - i) = t
               
            NEXT
         NEXT
         'monitor
         nposx = posy: nposy = a - posx
         ori = ori + 1
   END SELECT
   
posx = nposx: posy = nposy
IF ori > 4 THEN ori = 1
IF ori < 1 THEN ori = 4
END SUB