Maze 2D and 3D

Game development specific discussions.
jepalza
Posts: 70
Joined: Feb 24, 2010 10:08
Location: Spain (Bilbao)

Maze 2D and 3D

Postby jepalza » May 26, 2020 11:46

Maze 2d:

Code: Select all

' laberinto 2D
option explicit

Declare Sub busca_huecos()
Declare Sub dibuja_laberinto_2d()
Declare Sub crea_laberinto()

'RANDOMIZE TIMER
SCREEN 20

Dim Shared alto As Integer
Dim Shared ancho As Integer


Dim Shared c As Integer ' contador de huecos libres
Dim Shared f As Integer ' bucles
Dim Shared g As Integer ' contador
Dim Shared h As Integer ' bucles
Dim Shared i As Integer ' bucles
Dim Shared j As Integer ' bucles
Dim Shared r As Integer ' random
Dim Shared t As Integer ' contador
Dim Shared x As Integer ' posicion en el laberinto
Dim Shared y As Integer ' posicion de casillas en el laberinto

Dim Shared a As String

Dim Shared direccion As Integer

'MEDIDAS LABERINTO, minimo 5x5 maximo no importa, ancho siempre impar, alto no importa
ALTO=45
ANCHO=109

Dim Shared laberinto(alto*ancho) As Integer ' almacen para el laberinto al completo


crea_laberinto
dibuja_laberinto_2d
sleep


Sub crea_laberinto()
'----------------------------------------------------
'---- creamos una plantilla laberinto "hueco" -------
'----------------------------------------------------
G=0
' ------------- crea el borde superior
For F=1 To ANCHO
    LABERINTO(G)=2
    G=G+1
Next

' ------------- crea las celdas intermedias alternadas
For H=1 To (ALTO-2)/2
   
  ' fila impar, con paredes y huecos alternos
  LABERINTO(G)=2:G=G+1
  For F=1 To (ANCHO-3)/2
    LABERINTO(G+0)=0
   LABERINTO(G+1)=1
   G=G+2
  Next
  g=g+1
  LABERINTO(G)=2:g=g+1
 
  ' fila par, pero esta lisa entera (todo pared)
  LABERINTO(G)=2:G=G+1
  For F=1 To ANCHO-2
    LABERINTO(G)=1
    G=G+1
  Next
  LABERINTO(G)=2:g=g+1
Next H
g=g-ancho
  LABERINTO(G-1)=4 ' ponemos la salida, ya que estamos en esta casilla
' ------------ cierra el borde inferior y queda creado

For F=1 To ANCHO
    LABERINTO(G)=2
    G=G+1
Next

FOR f = 1 TO ALTO STEP 2
 For h = 1 TO ANCHO-1 STEP 2
   Y = ANCHO * f + h
   busca_huecos

   IF C > 0 THEN GoTo nohayposibilidad
   If h = 1 And f = 1 THEN GOTO encontrado
   If h = 1 THEN LABERINTO(Y - ANCHO)= 0
   If h > 1 THEN LABERINTO(Y - 1    )= 0

   'DIBUJA EL CAMINO EN TRAMOS DE 20 PASOS
   encontrado:
   For T = 1 TO 200
    r=Rnd(1)*3
     IF r = 1 THEN r = -1
     If r = 2 THEN r = -1*ANCHO
     IF r = 0 THEN r = +1
     IF r = 3 THEN r = ANCHO
     If LABERINTO(Y + r) <> 1 Then GoTo nohaycamino
     Y = Y + 2 * r
    busca_huecos
    IF C > 0 THEN GoTo nohaycamino
    LABERINTO (Y - r)= 0
    GOTO encontrado
    nohaycamino:
   Next T
   nohayposibilidad:
 NEXT h
Next f
laberinto(ancho)=3 ' marcamos la entrada en el laberinto, siempre en la casilla 1
x=1:y=1 ' y asignamos las coordenadas de la misma, como casilla de salida

End Sub

Sub busca_huecos()
' depende del proceso "crea_laberinto()"
' CUENTA ESPACIOS ALREDEDOR DE Y
C = 0

 If LABERINTO(Y - ANCHO) = 0 THEN C = C + 1
 If LABERINTO(Y + ANCHO) = 0 THEN C = C + 1
 If LABERINTO(Y - 1    ) = 0 THEN C = C + 1
 If LABERINTO(Y + 1    ) = 0 THEN C = C + 1

End Sub

Sub dibuja_laberinto_2d()
Cls
i=0
For j=0 To alto*ancho
   If laberinto(j)=0 Then a=" "
   If laberinto(j)=1 Then a=Chr$(219)
   If laberinto(j)=2 then a=Chr$(219) ' para debug, usar este --> a=Chr$(177)
   If laberinto(j)=3 then a="E"
   If laberinto(j)=4 then a="S"
   Print A;
   i=i+1:If i=ancho Then i=0:Print
Next j
End Sub



Maze 3d:

Code: Select all

Declare Sub busca_huecos()
Declare Sub dibuja_laberinto_2d()
Declare Sub dibuja_laberinto_3d(x As Integer, y As Integer, direccion As Integer)
Declare Sub crea_laberinto()
Declare Sub pared_3d(pared As integer)

RANDOMIZE Timer ' para que sea diferente cada vez
SCREEN 20

Dim Shared alto As Integer
Dim Shared ancho As Integer
Dim Shared pared As Integer

Dim Shared b As Integer
Dim Shared c As Integer ' contador de huecos libres
Dim Shared f As Integer ' bucles
Dim Shared g As Integer ' contador
Dim Shared h As Integer ' bucles
Dim Shared i As Integer ' bucles
Dim Shared j As Integer ' bucles
Dim Shared r As Integer ' random
Dim Shared t As Integer ' contador
Dim Shared x As Integer ' posicion en el laberinto
Dim Shared y As Integer ' posicion de casillas en el laberinto
Dim Shared As Integer yori, xori

Dim Shared a As String

Dim Shared direccion As Integer

'MEDIDAS LABERINTO, minimo 5x5 maximo no importa, ancho siempre impar, alto no importa
ALTO=10
ANCHO=15
Dim Shared laberinto(alto*ancho) As Integer ' almacen para el laberinto al completo

'lee coordenadas de los vectores 3d (para 1024x768, modo 20)
Restore coord3d
Dim Shared coord3d(44,2) As Integer
For f=1 To 44
   Read coord3d(f,1),coord3d(f,2)
Next

'lee coordenadas de las lineas de las paredes (10 izq + 6 cen + 10 der, paredes con 4 vertices cada una)
Restore lineas
Dim Shared lineas3d(26,4) As Integer
For f=1 To 26
   Read lineas3d(f,1),lineas3d(f,2),lineas3d(f,3),lineas3d(f,4)
Next

' direccion incial (1=norte, 2=este, 3=sur, 4=oeste)
direccion=3 ' miramos al sur

crea_laberinto()
x=2:y=2 ' asignamos las coordenadas de inicio

inicio:
   Cls
   dibuja_laberinto_2d()
   xori=x:yori=y ' copia de la posicion
   dibuja_laberinto_3d(x-1,y-1,direccion)' las coord. del 3d empiezan en "0,0", quito 1 para compensar
   Locate 2,40:Print "POS:";x;",";y
   b=GetKey

   If b>255 Then b=b Shr 8:a=Chr(b) Else a=Chr(b)
   
   If a="H" Then
      If direccion=1 Then y-=1
      If direccion=2 Then x+=1
      If direccion=3 Then y+=1
      If direccion=4 Then x-=1
   EndIf
   If a="P" Then
      If direccion=1 Then y+=1
      If direccion=2 Then x-=1
      If direccion=3 Then y-=1
      If direccion=4 Then x+=1
   EndIf
   If a="K" Then direccion-=1
   If a="M" Then direccion+=1
   If direccion=0 Then direccion=4
   If direccion=5 Then direccion=1
   
   If a=Chr(27) Then End
GoTo inicio

end

Sub crea_laberinto()
'----------------------------------------------------
'---- creamos una plantilla laberinto "hueco" -------
'----------------------------------------------------
G=0
' ------------- crea el borde superior
For F=1 To ANCHO
    LABERINTO(G)=2
    G=G+1
Next

' ------------- crea las celdas intermedias alternadas
For H=1 To (ALTO-2)/2
   
  ' fila impar, con paredes y huecos alternos
  LABERINTO(G)=2:G=G+1
  For F=1 To (ANCHO-3)/2
    LABERINTO(G+0)=0
   LABERINTO(G+1)=1
   G=G+2
  Next
  g=g+1
  LABERINTO(G)=2:g=g+1
 
  ' fila par, pero esta lisa entera (todo pared)
  LABERINTO(G)=2:G=G+1
  For F=1 To ANCHO-2
    LABERINTO(G)=1
    G=G+1
  Next
  LABERINTO(G)=2:g=g+1
Next H
g=g-ancho
  LABERINTO(G-1)=4 ' ponemos la salida, ya que estamos en esta casilla
' ------------ cierra el borde inferior y queda creado

For F=1 To ANCHO
    LABERINTO(G)=2
    G=G+1
Next

FOR f = 1 TO ALTO STEP 2
 For h = 1 TO ANCHO-1 STEP 2
   Y = ANCHO * f + h
   busca_huecos

   IF C > 0 THEN GoTo nohayposibilidad
   If h = 1 And f = 1 THEN GOTO encontrado
   If h = 1 THEN LABERINTO(Y - ANCHO)= 0
   If h > 1 THEN LABERINTO(Y - 1    )= 0

   'DIBUJA EL CAMINO EN TRAMOS DE 20 PASOS
   encontrado:
   For T = 1 TO 200
    r=Rnd(1)*3
     IF r = 1 THEN r = -1
     If r = 2 THEN r = -1*ANCHO
     IF r = 0 THEN r = +1
     IF r = 3 THEN r = ANCHO
     If LABERINTO(Y + r) <> 1 Then GoTo nohaycamino
     Y = Y + 2 * r
    busca_huecos
    IF C > 0 THEN GoTo nohaycamino
    LABERINTO (Y - r)= 0
    GOTO encontrado
    nohaycamino:
   Next T
   nohayposibilidad:
 NEXT h
Next f
laberinto(ancho)=3 ' marcamos la entrada en el laberinto, siempre en la casilla 1

End Sub

Sub busca_huecos()
' depende del proceso "crea_laberinto()"
' CUENTA ESPACIOS ALREDEDOR DE Y
C = 0

 If LABERINTO(Y - ANCHO) = 0 THEN C = C + 1
 If LABERINTO(Y + ANCHO) = 0 THEN C = C + 1
 If LABERINTO(Y - 1    ) = 0 THEN C = C + 1
 If LABERINTO(Y + 1    ) = 0 THEN C = C + 1

End Sub

Sub dibuja_laberinto_2d()
i=0
For j=0 To alto*ancho
   If laberinto(j)=0 Then a=" "
   If laberinto(j)=1 Then a=Chr(219)
   If laberinto(j)=2 then a=Chr(219) ' para depuracion, usar este --> a=Chr(177)
   'If laberinto(j)=3 then a="E"
   If laberinto(j)=4 then a="X"
   Print A;
   i=i+1:If i=ancho Then i=0:Print
Next j
If Screen(y,x)=65499 Then x=xori:y=yori
If Screen(y,x)<>32 And Screen(y,x)<>65499 Then Print "FIN....":Sleep:end
Locate y,x:Print "*"
End Sub

Sub dibuja_laberinto_3d(x As Integer, y As integer, direccion As Integer)
   Dim posicion As Integer
   
   posicion=y*ancho+x ' posicion absoluta segun x e y, dentro de la matriz
   
   ' dibujamos el laberinto 3d, en forma de 15 paredes (1-izq, 1-cen, 1-der y 5 profundidades 3d)
   ' primero, dibujamos el centro, y obtenemos la profundidad a la que se ha parado (de 5 a 0)
   ' y con esa proundidad (guardada en "B"), dibujamos el resto, parando en el mismo sitio
   ' esto lo hacemos por igual para cada direccion que miramos
   
   ' -------------------------------------------
    If direccion=1 Then ' miramos al norte
      h=0
      For g=11 To 16
         If laberinto(posicion-(ancho*h)) Then pared_3d(g):g=17
         h=h+1
      Next
      b=(6-h)*2
      
      h=0
      For g=1 To 9-b Step 2
         If laberinto(posicion-1-(ancho*h)) Then pared_3d(g) Else pared_3d(g+1)
         h=h+1
      Next
      
      h=0
      For g=17 To 25-b Step 2
         If laberinto(posicion+1-(ancho*h)) Then pared_3d(g) Else pared_3d(g+1)
         h=h+1
      Next
   End If

' -------------------------------------------
   If direccion=2 Then ' miramos al este
      h=0
      For g=11 To 16
         If laberinto(posicion+h) Then pared_3d(g):g=17
         h=h+1
      Next
      b=(6-h)*2
      
      h=0
      For g=1 To 9-b Step 2
         If laberinto(posicion-ancho+h) Then pared_3d(g) Else pared_3d(g+1)
         h=h+1
      Next
      
      h=0
      For g=17 To 25-b Step 2
         If laberinto(posicion+ancho+h) Then pared_3d(g) Else pared_3d(g+1)
         h=h+1
      Next
   End If
   
' ------------------------------------------- 
   If direccion=3 Then ' miramos al sur
      h=0
      For g=11 To 16
         If laberinto(posicion+(ancho*h)) Then pared_3d(g):g=17
         h=h+1
      Next
      b=(6-h)*2
      
      h=0
      For g=1 To 9-b Step 2
         If laberinto(posicion+1+(ancho*h)) Then pared_3d(g) Else pared_3d(g+1)
         h=h+1
      Next
      
      h=0
      For g=17 To 25-b Step 2
         If laberinto(posicion-1+(ancho*h)) Then pared_3d(g) Else pared_3d(g+1)
         h=h+1
      Next
   End If

' -------------------------------------------
   If direccion=4 Then ' miramos al oeste
      h=0
      For g=11 To 16
         If laberinto(posicion-h) Then pared_3d(g):g=17
         h=h+1
      Next
      b=(6-h)*2
      
      h=0
      For g=1 To 9-b Step 2
         If laberinto(posicion+ancho-h) Then pared_3d(g) Else pared_3d(g+1)
         h=h+1
      Next
      
      h=0
      For g=17 To 25-b Step 2
         If laberinto(posicion-ancho-h) Then pared_3d(g) Else pared_3d(g+1)
         h=h+1
      Next
   End If
   
End Sub

Sub pared_3d(pared As integer)
   ' dibujamos las paredes por zonas, de la 1 a la 26, segun donde este
   Dim col As Integer
   Dim p1 As Integer
   Dim p2 As Integer
   Dim p3 As Integer
   Dim p4 As Integer
   
   col=14

   p1=lineas3d(pared,1)
   p2=lineas3d(pared,2)
   p3=lineas3d(pared,3)
   p4=lineas3d(pared,4)
   Line (coord3d( p1,1),coord3d( p1,2))-(coord3d(p2,1),coord3d(p2,2)),c
   Line (coord3d( p2,1),coord3d( p2,2))-(coord3d(p3,1),coord3d(p3,2)),c
   Line (coord3d( p3,1),coord3d( p3,2))-(coord3d(p4,1),coord3d(p4,2)),c
   Line (coord3d( p4,1),coord3d( p4,2))-(coord3d(p1,1),coord3d(p1,2)),c 
   
End Sub


' 44*2 coordenadas 3d para dibujar los vectores de las paredes
coord3d:
DATA 0, 0
DATA 0,64
DATA 96,64
DATA 96,128
DATA 192,128
DATA 192,192
DATA 287,192
DATA 287,255
DATA 383,255
DATA 383,316
DATA 474,316
DATA 0,768
DATA 0,692
DATA 96,692
DATA 96,616
DATA 192,616
DATA 192,541
DATA 287,541
DATA 287,465
DATA 383,465
DATA 383,393
DATA 474,393
DATA 1024, 0
DATA 1024,65
DATA 926,65
DATA 926,129
DATA 831,129
DATA 831,192
DATA 735,192
DATA 735,255
DATA 640,255
DATA 640,316
DATA 548,316
DATA 1024,768
DATA 1024,691
DATA 926,691
DATA 926,616
DATA 831,616
DATA 831,540
DATA 735,540
DATA 735,465
DATA 640,465
DATA 640,393
DATA 548,393

' lineas a dibujar en las coordenadas anteriores
lineas:
' paredes izquierda, alternas inclinada y recta
Data  1, 3,14,12
Data  2, 3,14,13
Data  3, 5,16,14
Data  4, 5,16,15
Data  5, 7,18,16
Data  6, 7,18,17
Data  7, 9,20,18
Data  8, 9,20,19
Data  9,11,22,20
Data 10,11,22,21
' paredes centrales, solo planas
Data  1,23,34,12
Data  3,25,36,14
Data  5,27,38,16
Data  7,29,40,18
Data  9,31,42,20
Data 11,33,44,22
' paredes derecha, alternas inclinada y recta
Data 23,25,36,34
Data 24,25,36,35
Data 25,27,38,36
Data 26,27,38,37
Data 27,29,40,38
Data 28,29,40,39
Data 29,31,42,40
Data 30,31,42,41
Data 31,33,44,42
Data 32,33,44,43
badidea
Posts: 2179
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Maze 2D and 3D

Postby badidea » May 26, 2020 12:34

jepalza wrote:Maze 2d

With -exx compile:
Aborting due to runtime error 6 (out of bounds array access) at line 123 of test.bas::BUSCA_HUECOS()
Press any key to continue . . .


Variables c,f,g,h,i,j,r,t,x,y,a ? It is a good thing that they a commented. Now I only need to learn Spanish.

More 2d mazes: viewtopic.php?f=7&t=24291&p=272181#p272181

jepalza wrote:Maze 3d

This one also accesses memory outside the LABERINTO array. After a quick fix, I was able to complete the maze.
jepalza
Posts: 70
Joined: Feb 24, 2010 10:08
Location: Spain (Bilbao)

Re: Maze 2D and 3D

Postby jepalza » May 26, 2020 13:03

Are very old codes from my library. Several of them are conversions from QB , about 90's. I've converted them just for fun and remembering "old times"
Compiled with "fbc -s gui" (or console)

Sorry for "spanish", but not speak english. Using google for all purpouses.
I wouldn't dare or be able to write in English, for not "screwing up" and making a fool of myself
BasicCoder2
Posts: 3620
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Maze 2D and 3D

Postby BasicCoder2 » May 27, 2020 1:17

jepalza wrote:Sorry for "spanish", but not speak english. Using google for all purpouses.
I wouldn't dare or be able to write in English, for not "screwing up" and making a fool of myself

It would be nice if google could translate source code :)
Sería bueno si Google pudiera traducir el código fuente :)

Code: Select all

Declare Sub look_for_gaps()
Declare Sub draw_maze_2d()
Declare Sub draw_maze_3d(x As Integer, y As Integer, direction As Integer)
Declare Sub create_maze()
Declare Sub wall_3d(wall As integer)

RANDOMIZE Timer ' to make it different every time
SCREEN 20

Dim Shared high As Integer
Dim Shared wide As Integer
Dim Shared wall As Integer

Dim Shared b As Integer
Dim Shared c As Integer ' free gap counter
Dim Shared f As Integer ' loops
Dim Shared g As Integer ' accountant
Dim Shared h As Integer ' loops
Dim Shared i As Integer ' loops
Dim Shared j As Integer ' loops
Dim Shared r As Integer ' random
Dim Shared t As Integer ' accountant
Dim Shared x As Integer ' position in maze
Dim Shared y As Integer ' position of squares in the maze
Dim Shared As Integer yori, xori  'y or i   x or i ?

Dim Shared a As String

Dim Shared direction As Integer

'MEASURES LABYRINTH, minimum 5x5 maximum not important, wide always odd height, height not important
high=10
wide=15
Dim Shared labyrinth(high*wide) As Integer ' store for the entire labyrinth

'read coordinates of vectors 3d (for 1024x768, mode 20)
Restore coord3d
Dim Shared coord3d(44,2) As Integer
For f=1 To 44
   Read coord3d(f,1),coord3d(f,2)
Next

'
'reads coordinates of the lines of the walles (10 left + 6 cen + 10 right, walles with 4 vertices each)
Restore lines
Dim Shared lines3d(26,4) As Integer
For f=1 To 26
   Read lines3d(f,1),lines3d(f,2),lines3d(f,3),lines3d(f,4)
Next

' direction initial (1 = north, 2 = east, 3 = south, 4 = west)
direction=3 ' we look south

create_maze()
x=2:y=2 ' we assign the starting coordinates

start:
   Cls
   draw_maze_2d()
   xori=x:yori=y ' copy positions
   draw_maze_3d(x-1,y-1,direction)' the coord. 3d's start at "0,0", I remove 1 to compensate
   Locate 2,40:Print "POS:";x;",";y
   b=GetKey

   If b>255 Then b=b Shr 8:a=Chr(b) Else a=Chr(b)
   
   If a="H" Then
      If direction=1 Then y-=1
      If direction=2 Then x+=1
      If direction=3 Then y+=1
      If direction=4 Then x-=1
   EndIf
   If a="P" Then
      If direction=1 Then y+=1
      If direction=2 Then x-=1
      If direction=3 Then y-=1
      If direction=4 Then x+=1
   EndIf
   If a="K" Then direction-=1
   If a="M" Then direction+=1
   If direction=0 Then direction=4
   If direction=5 Then direction=1
   
   If a=Chr(27) Then End
GoTo start

end

Sub create_maze()
'----------------------------------------------------
'---- we create a hollow labyrinth template -------
'----------------------------------------------------
G=0
' ------------- create the top border
For F=1 To wide
    labyrinth(G)=2
    G=G+1
Next

' ------------- create alternate intermediate cells
For H=1 To (high-2)/2
   
  ' odd row, with alternate walls and gaps
  labyrinth(G)=2:G=G+1
  For F=1 To (wide-3)/2
    labyrinth(G+0)=0
   labyrinth(G+1)=1
   G=G+2
  Next
  g=g+1
  labyrinth(G)=2:g=g+1
 
  ' even row, but this whole smooth (todo wall)
  labyrinth(G)=2:G=G+1
  For F=1 To wide-2
    labyrinth(G)=1
    G=G+1
  Next
  labyrinth(G)=2:g=g+1
Next H
g=g-wide
  labyrinth(G-1)=4 ' we put the output, since we are in this box
 
' ------------ close the bottom edge and it is created

For F=1 To wide
    labyrinth(G)=2
    G=G+1
Next

FOR f = 1 TO high STEP 2
 For h = 1 TO wide-1 STEP 2
   Y = wide * f + h
   look_for_gaps

   IF C > 0 THEN GoTo there_is_no_possibility
   If h = 1 And f = 1 THEN GOTO found
   If h = 1 THEN labyrinth(Y - wide)= 0
   If h > 1 THEN labyrinth(Y - 1    )= 0

   'DRAW THE WAY IN 20-STEP SECTIONS
   found:
   For T = 1 TO 200
    r=Rnd(1)*3
     IF r = 1 THEN r = -1
     If r = 2 THEN r = -1*wide
     IF r = 0 THEN r = +1
     IF r = 3 THEN r = wide
     If labyrinth(Y + r) <> 1 Then GoTo there_is_no_path
     Y = Y + 2 * r
    look_for_gaps
    IF C > 0 THEN GoTo there_is_no_path
    labyrinth (Y - r)= 0
    GOTO found
    there_is_no_path:
   Next T
   there_is_no_possibility:
 NEXT h
Next f
labyrinth(wide)=3 ' we mark the entrance in the labyrinth, always in box 1

End Sub

Sub look_for_gaps()
' depends on the process "create_maze()"
' ACCOUNT SPACES AROUND Y
C = 0

 If labyrinth(Y - wide) = 0 THEN C = C + 1
 If labyrinth(Y + wide) = 0 THEN C = C + 1
 If labyrinth(Y - 1    ) = 0 THEN C = C + 1
 If labyrinth(Y + 1    ) = 0 THEN C = C + 1

End Sub

Sub draw_maze_2d()
i=0
For j=0 To high*wide
   If labyrinth(j)=0 Then a=" "
   If labyrinth(j)=1 Then a=Chr(219)
   If labyrinth(j)=2 then a=Chr(219) ' for debugging use this --> a=Chr(177)
   'If labyrinth(j)=3 then a="E"
   If labyrinth(j)=4 then a="X"
   Print A;
   i=i+1:If i=wide Then i=0:Print
Next j
If Screen(y,x)=65499 Then x=xori:y=yori
If Screen(y,x)<>32 And Screen(y,x)<>65499 Then Print "FIN....":Sleep:end
Locate y,x:Print "*"
End Sub

Sub draw_maze_3d(x As Integer, y As integer, direction As Integer)
   Dim position As Integer
   
   position=y*wide+x ' absolute position according to x and y, inside the matrix
   

   'we draw the labyrinth 3d, in the form of 15 walls (1-left, 1-cen, 1-der and 5 depths 3d)
   'first, we draw the center, and obtain the depth at which it has stopped (from 5 to 0)
   'and with that depth (stored in "B"), we draw the rest, stopping in the same place
   'we do this equally for each direction we look
   
   ' -------------------------------------------
    If direction=1 Then ' we look north
      h=0
      For g=11 To 16
         If labyrinth(position-(wide*h)) Then wall_3d(g):g=17
         h=h+1
      Next
      b=(6-h)*2
     
      h=0
      For g=1 To 9-b Step 2
         If labyrinth(position-1-(wide*h)) Then wall_3d(g) Else wall_3d(g+1)
         h=h+1
      Next
     
      h=0
      For g=17 To 25-b Step 2
         If labyrinth(position+1-(wide*h)) Then wall_3d(g) Else wall_3d(g+1)
         h=h+1
      Next
   End If

' -------------------------------------------
   If direction=2 Then ' we look east
      h=0
      For g=11 To 16
         If labyrinth(position+h) Then wall_3d(g):g=17
         h=h+1
      Next
      b=(6-h)*2
     
      h=0
      For g=1 To 9-b Step 2
         If labyrinth(position-wide+h) Then wall_3d(g) Else wall_3d(g+1)
         h=h+1
      Next
     
      h=0
      For g=17 To 25-b Step 2
         If labyrinth(position+wide+h) Then wall_3d(g) Else wall_3d(g+1)
         h=h+1
      Next
   End If
   
' -------------------------------------------
   If direction=3 Then ' we look south
      h=0
      For g=11 To 16
         If labyrinth(position+(wide*h)) Then wall_3d(g):g=17
         h=h+1
      Next
      b=(6-h)*2
     
      h=0
      For g=1 To 9-b Step 2
         If labyrinth(position+1+(wide*h)) Then wall_3d(g) Else wall_3d(g+1)
         h=h+1
      Next
     
      h=0
      For g=17 To 25-b Step 2
         If labyrinth(position-1+(wide*h)) Then wall_3d(g) Else wall_3d(g+1)
         h=h+1
      Next
   End If

' -------------------------------------------
   If direction=4 Then ' we look west
      h=0
      For g=11 To 16
         If labyrinth(position-h) Then wall_3d(g):g=17
         h=h+1
      Next
      b=(6-h)*2
     
      h=0
      For g=1 To 9-b Step 2
         If labyrinth(position+wide-h) Then wall_3d(g) Else wall_3d(g+1)
         h=h+1
      Next
     
      h=0
      For g=17 To 25-b Step 2
         If labyrinth(position-wide-h) Then wall_3d(g) Else wall_3d(g+1)
         h=h+1
      Next
   End If
   
End Sub

Sub wall_3d(wall As integer)
   ' we draw the walls by zones, from 1 to 26, according to where it is
   Dim col As Integer
   Dim p1 As Integer
   Dim p2 As Integer
   Dim p3 As Integer
   Dim p4 As Integer
   
   col=14

   p1=lines3d(wall,1)
   p2=lines3d(wall,2)
   p3=lines3d(wall,3)
   p4=lines3d(wall,4)
   Line (coord3d( p1,1),coord3d( p1,2))-(coord3d(p2,1),coord3d(p2,2)),c
   Line (coord3d( p2,1),coord3d( p2,2))-(coord3d(p3,1),coord3d(p3,2)),c
   Line (coord3d( p3,1),coord3d( p3,2))-(coord3d(p4,1),coord3d(p4,2)),c
   Line (coord3d( p4,1),coord3d( p4,2))-(coord3d(p1,1),coord3d(p1,2)),c
   
End Sub


' 44*2 3d coordinates to draw the vectors of the walls
coord3d:
DATA 0, 0
DATA 0,64
DATA 96,64
DATA 96,128
DATA 192,128
DATA 192,192
DATA 287,192
DATA 287,255
DATA 383,255
DATA 383,316
DATA 474,316
DATA 0,768
DATA 0,692
DATA 96,692
DATA 96,616
DATA 192,616
DATA 192,541
DATA 287,541
DATA 287,465
DATA 383,465
DATA 383,393
DATA 474,393
DATA 1024, 0
DATA 1024,65
DATA 926,65
DATA 926,129
DATA 831,129
DATA 831,192
DATA 735,192
DATA 735,255
DATA 640,255
DATA 640,316
DATA 548,316
DATA 1024,768
DATA 1024,691
DATA 926,691
DATA 926,616
DATA 831,616
DATA 831,540
DATA 735,540
DATA 735,465
DATA 640,465
DATA 640,393
DATA 548,393

' lines draw on the above coordinates
lines:
' left walls, alternate leaning and straight
Data  1, 3,14,12
Data  2, 3,14,13
Data  3, 5,16,14
Data  4, 5,16,15
Data  5, 7,18,16
Data  6, 7,18,17
Data  7, 9,20,18
Data  8, 9,20,19
Data  9,11,22,20
Data 10,11,22,21
' central walls, only flat
Data  1,23,34,12
Data  3,25,36,14
Data  5,27,38,16
Data  7,29,40,18
Data  9,31,42,20
Data 11,33,44,22
' right walls, alternate inclined and straight
Data 23,25,36,34
Data 24,25,36,35
Data 25,27,38,36
Data 26,27,38,37
Data 27,29,40,38
Data 28,29,40,39
Data 29,31,42,40
Data 30,31,42,41
Data 31,33,44,42
Data 32,33,44,43
jepalza
Posts: 70
Joined: Feb 24, 2010 10:08
Location: Spain (Bilbao)

Re: Maze 2D and 3D

Postby jepalza » May 27, 2020 6:59

Good! even labels! ;-)

Code: Select all

  IF C > 0 THEN GoTo there_is_no_possibility
  IF C > 0 THEN GoTo nohayposibilidad
UEZ
Posts: 664
Joined: May 05, 2017 19:59
Location: Germany

Re: Maze 2D and 3D

Postby UEZ » May 27, 2020 8:37

@jepalza: thanks for sharing the code.

For the 3D version the textures are missing... ;-)
jepalza
Posts: 70
Joined: Feb 24, 2010 10:08
Location: Spain (Bilbao)

Re: Maze 2D and 3D

Postby jepalza » May 27, 2020 20:03

This code was created with QB45, around 1990. At that time (30 years already!!) QB didn't have enough power to move textures in real time. So, the easiest way was "wire mode".
I has several codes for real 3D with textures, but need to clean code first.

Image

This code isn't mine, I've converted it and improved it for the FB. When I have it ready, I'll upload it.

Return to “Game Dev”

Who is online

Users browsing this forum: No registered users and 2 guests