## Maze 2D and 3D

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

### Maze 2D and 3D

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
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
nohaycamino:
Next T
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
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
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
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
nohaycamino:
Next T
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
``````
Posts: 2594
Joined: May 24, 2007 22:10
Location: The Netherlands

### Re: Maze 2D and 3D

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: 149
Joined: Feb 24, 2010 10:08
Location: Spain (Bilbao)

### Re: Maze 2D and 3D

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: 3917
Joined: Jan 01, 2009 7:03
Location: Australia

### Re: Maze 2D and 3D

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 :)

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
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
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: 149
Joined: Feb 24, 2010 10:08
Location: Spain (Bilbao)

### Re: Maze 2D and 3D

Good! even labels! ;-)

Code: Select all

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

### Re: Maze 2D and 3D

@jepalza: thanks for sharing the code.

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

### Re: Maze 2D and 3D

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.

This code isn't mine, I've converted it and improved it for the FB. When I have it ready, I'll upload it.
jepalza
Posts: 149
Joined: Feb 24, 2010 10:08
Location: Spain (Bilbao)

### Re: Maze 2D and 3D

And now, only two years later....

An unfinished, but functional project from 2018. I don't remember well how I started it or why I abandoned it, but it may be useful for someone.
It is a 3D textured maze, very fast.
It has a map editor and texture generator. I do not indicate instructions, because I believe that the only thing that would achieve, would be to confuse even more its simple use.
The texture generator takes a file created independently and converts it to the neutral format needed by the graphic engine.
The map generator is a simple graphic editor in text mode, which allows you to choose a texture and create walls.
It is better to use it to understand its use.
The 3D routines are not mine, I took them from some C example I found on the net, but I can't say where.

Translated with www.DeepL.com/Translator (free version)

Spanish:
Y ahora, solo dos años mas tarde....

Un proyecto de 2018 inacabado, pero funcional. No recuerdo bien cómo lo empecé ni por que lo abandone, pero puede ser util para alguno.
Es un laberinto en 3D texturizado, muy rapido.
Tiene editor de mapas y generador de texturas. No indico instrucciones, por que creo que lo unico que lograria, seria confundiar aun mas su simple uso.
El generador de texturas, coge un fichero creado independiente y lo convierte al formato neutro necesario por el motor grafico.
El generador de mapas, es un simple editor grafico en modo texto, que permite elegir una textura y crear muros.
Es mejor usarlo para entender su uso.
las rutinas 3D no son mias, las cogí de algún ejemplo en C que encontré por la red, pero no podria decir de donde.

D.J.Peters
Posts: 8588
Joined: May 28, 2005 3:28
Contact:

### Re: Maze 2D and 3D

I made some changes for 32/64-bit targets
(type RGBAColor as ulong)

Joshy

Code: Select all

``````' lectura de texturas:
' son cuadros de 64x64 pixel, y cada pixel ocupa 4 bytes (alpha,r,g,b), por lo tanto 64x64x4=16384bytes
' se almacenan seguidas en el binario, de 16k en 16k. en el binario se almacena como UInteger.
' un color se guarda en el binario como "BGRA" (azul, rojo, verde, alfa)
' de ese modo, al leerlo con el "GET" se lee en su orden, o sea, que queda como "ARGB"
' ejemplo, en el binario, un pixel, se ve como "BB GG RR AA", pero al leerlo se ve como "AA RR GG BB"

#Include "crt/math.bi"
#Include "fbgfx.bi"

' para el multikey
Using fb

type RGBAColor as ulong

Dim Shared texturas(200,4096) As RGBAColor ' 200 texturas de 4096bytes por 4 bytes del Uinteger=10*16384
Dim As Integer e,f=1,g

Open "texturas.bin" For binary As 1
While Not Eof(1)
Get #1,f,texturas(e,0),4096 ' leo una textura de golpe (4096*4 bytes de golpe)
f+=4096*4 ' siguiente textura
e+=1
Wend
Close 1

Randomize timer

#Define screenWidth 1024
#Define screenHeight 768
#Define texWidth 64
#Define texHeight 64
#Define mapWidth 50
#Define mapHeight 35

Dim Shared worldmap (mapHeight ,mapWidth) As Integer
Dim Shared buffer (screenWidth, screenHeight) As RGBAColor

Dim As Double posX = 1.5, posY = 1.5  'x and y start position: esquina sup.izq. siempre
Dim As Double dirX = -1.0, dirY = 0.0 'initial direction vector
Dim As Double planeX = 0.0, planeY = 0.66 'the 2d raycaster version of camera plane
Dim As Double ctime = 0 'time of current frame
Dim As Double oldTime = 0 'time of previous frame
Dim As Integer done = 0
Dim As long x, y, scrw
Dim framebuffer As RGBAColor Ptr

Dim As Integer xmouse,ymouse, mboton, xmouseold,ymouseold, ratonmas,ratonmenos

Dim As Integer e,f,g
e=0
f=0
g=1
dim sc As String=" "
Open mapa For binary As 1
While Not Eof(1)
Get #1,g,sc
g+=1
worldmap (f,e)=Asc(sc)
'if f<25 then Locate f+1,e+1:Print Chr(Asc(sc)+48)
e+=1:If e=mapWidth Then f+=1:e=0
Wend
Close 1
End Sub

'Returns texture color for given texture
Function GetTextureColor(texnum As Integer, x As Integer, y As Integer, isfloor As Integer = 0) As RGBAColor
Dim As RGBAColor pixel
Dim As Integer twh

If isfloor = 0 Then
twh = texHeight
Else
twh = texWidth
EndIf
'RDC make sure values are in range here
If x < 0 Then x = 0
If x > 63 Then x = 63
If y < 0 Then y = 0
If y > 63 Then y = 63

' ****************************************************
' Aqui recogemos el color del pixel segun la textura
pixel = texturas(texNum-1,twh * Y + X)
' ****************************************************

Return pixel
End Function

'Draws buffer to screen.
Sub DrawBuffer
Dim As ulong x, y, scrw
Dim framebuffer As RGBAColor Ptr

framebuffer = ScreenPtr
If framebuffer Then
ScreenInfo scrw
ScreenLock
For x = LBound(buffer, 1) To UBound(buffer, 1)
For y = LBound(buffer, 2) To UBound(buffer, 2)
Poke RGBAColor, framebuffer + (y * scrw + x), buffer(x, y)
Next
Next
ScreenUnlock
End If
End Sub

'Set up graphic screen.
ScreenRes screenWidth, screenHeight, 32
framebuffer = ScreenPtr
ScreenInfo scrw

' leo el mapa (de 50 de ancho por 35 de alto)

Dim velgiro As Single=1
Dim velavance As Single=1
SetMouse(screenWidth/2,screenHeight/2,0) ' centro el raton, y lo escondo

Do
ScreenLock
Cls
For x As Integer = 0 To screenWidth - 1

'calculate ray position and direction
Dim As Double cameraX = 2 * x / CDbl(screenWidth) - 1 'x-coordinate in camera space
Dim As Double rayPosX = posX
Dim As Double rayPosY = posY
Dim As Double rayDirX = dirX + planeX * cameraX
Dim As Double rayDirY = dirY + planeY * cameraX

'which box of the map we're in
Dim As Integer mapX = Int(rayPosX)
Dim As Integer mapY = Int(rayPosY)

'//length of ray from current position to next x or y-side
Dim As Double sideDistX
Dim As Double sideDistY

'length of ray from one x or y-side to next x or y-side
Dim As Double deltaDistX = Sqrt(1 + (rayDirY * rayDirY) / (rayDirX * rayDirX))
Dim As Double deltaDistY = Sqrt(1 + (rayDirX * rayDirX) / (rayDirY * rayDirY))
Dim As double perpWallDist

'//what direction to step in x or y-direction (either +1 or -1)
Dim As Integer stepX
Dim As Integer stepY

Dim As Integer hit = 0 '//was there a wall hit?
Dim As Integer side '//was a NS or a EW wall hit?

'calculate step and initial sideDist
If rayDirX < 0 Then
stepX = -1
sideDistX = (rayPosX - mapX) * deltaDistX
Else
stepX = 1
sideDistX = (mapX + 1.0 - rayPosX) * deltaDistX
End If

If rayDirY < 0 Then
stepY = -1
sideDistY = (rayPosY - mapY) * deltaDistY
Else
stepY = 1
sideDistY = (mapY + 1.0 - rayPosY) * deltaDistY
End If
'perform DDA
Do While (hit = 0)
If sideDistX < sideDistY Then
mapX += stepX
side = 0
Else
mapY += stepY
side = 1
End If
'Check if ray has hit a wall
If worldMap(mapX, mapY) > 0 Then hit = 1
Loop

'Calculate distance of perpendicular ray (oblique distance will give fisheye effect!)
If side = 0 Then
perpWallDist = fabs((mapX - rayPosX + (1 - stepX) / 2) / rayDirX)
Else
perpWallDist = fabs((mapY - rayPosY + (1 - stepY) / 2) / rayDirY)
End If

'Calculate height of line to draw on screen
Dim As Integer lineHeight = Abs(Int(screenHeight / perpWallDist))

'calculate lowest and highest pixel to fill in current stripe
Dim As Integer drawStart = -lineHeight / 2 + screenHeight / 2
If drawStart < 0 Then drawStart = 0
Dim As Integer drawEnd = lineHeight / 2 + screenHeight / 2
If drawEnd >= screenHeight Then drawEnd = screenHeight - 1

'coge el numero de grafico a emplear en el texturizado, segun el mapa
Dim As Integer texNum = worldMap(mapX, mapY)+2 ' le sumo dos, para dejar el 0 y el 1 para suelo y techo

'calculate value of wallX
Dim As double wallX
'where exactly the wall was hit
If side = 1 Then
wallX = rayPosX + ((mapY - rayPosY + (1 - stepY) / 2) / rayDirY) * rayDirX
Else
wallX = rayPosY + ((mapX - rayPosX + (1 - stepX) / 2) / rayDirX) * rayDirY
End If
wallX -= Floor((wallX))

'x coordinate on the texture
Dim As Integer texX = Int(wallX * CDbl(texWidth))
If (side = 0) And (rayDirX > 0) Then texX = texWidth - texX - 1
If (side = 1) And (rayDirY < 0) Then texX = texWidth - texX - 1

For y As Integer = drawStart To drawEnd - 1
Dim As Integer d = y * 256 - screenHeight * 128 + lineHeight * 128  '256 and 128 factors to avoid floats
Dim As Integer texY = ((d * texHeight) / lineHeight) / 256
'make color darker for y-sides: R, G and B byte each divided through two with a "shift" and an "and"
If side = 1 Then
Poke RGBAColor, framebuffer + (y * scrw + x), (GetTextureColor(texNum, texX,  texY) Shr 1) And 8355711
Else
Poke RGBAColor, framebuffer + (y * scrw + x),  GetTextureColor(texNum, texX,  texY)
EndIf
Next

'FLOOR CASTING
Dim As double floorXWall, floorYWall '//x, y position of the floor texel at the bottom of the wall

'4 different wall directions possible
If (side = 0) and (rayDirX > 0) Then
floorXWall = mapX
floorYWall = mapY + wallX
ElseIf (side = 0) and (rayDirX < 0) Then
floorXWall = mapX + 1.0
floorYWall = mapY + wallX
ElseIf (side = 1) And (rayDirY > 0) Then
floorXWall = mapX + wallX
floorYWall = mapY
else
floorXWall = mapX + wallX
floorYWall = mapY + 1.0
End If

Dim As double distWall, distPlayer, currentDist

distWall = perpWallDist
distPlayer = 0.0
if (drawEnd < 0) Then drawEnd = screenHeight '//becomes < 0 when the integer overflows
'//draw the floor from drawEnd to the bottom of the screen
For y As Integer = drawEnd + 1 To screenHeight  - 1
currentDist = screenHeight / (2.0 * y - screenHeight) '//you could make a small lookup table for this instead

Dim As double weight = (currentDist - distPlayer) / (distWall - distPlayer)

Dim As double currentFloorX = weight * floorXWall + (1.0 - weight) * posX
Dim As double currentFloorY = weight * floorYWall + (1.0 - weight) * posY

Dim As Integer floorTexX, floorTexY
floorTexX = int(currentFloorX * texWidth) Mod texWidth
floorTexY = int(currentFloorY * texHeight) Mod texHeight

' Suelo, textura 0
Poke RGBAColor, framebuffer + (y * scrw + x), (GetTextureColor(1, floorTexX,  floorTexY, 1)  Shr 1) And 8355711
' techo, textura 1
Poke RGBAColor, framebuffer + ((screenHeight - y) * scrw + x), GetTextureColor(2, floorTexX,  floorTexY, 1)

Next
Next

'DrawBuffer
'//clear the buffer instead of cls()
'Erase buffer
ScreenUnLock

'timing for input and FPS counter
oldTime = ctime
ctime = Timer
Dim As Double frameTime = ctime - oldTime '/ 1000.0 'frametime is the time this frame has taken, in seconds

'speed modifiers
Dim As Double moveSpeed = frameTime * velavance'5.0 'the constant value is in squares/second
Dim As Double rotSpeed = frameTime * velgiro'3.0 'the constant value is in radians/second

'mirar arriba-abajo
if Multikey(SC_Q) Then
If worldMap(int(posX + dirX * moveSpeed), int(posY)) = 0 Then posX += dirX * moveSpeed
If worldMap(int(posX), int(posY + dirY * moveSpeed)) = 0 Then posY += dirY * moveSpeed
End If

if Multikey(SC_A) Then
If worldMap(int(posX - dirX * moveSpeed), int(posY)) = 0 Then posX -= dirX * moveSpeed
If worldMap(int(posX), int(posY - dirY * moveSpeed)) = 0 Then posY -= dirY * moveSpeed
End If

'move forward if no wall in front of you
if MultiKey(SC_LSHIFT) Then velavance=2.5 Else velavance=1.2
If MultiKey(SC_UP) Or Multikey(SC_W)  Then
If worldMap(int(posX + dirX * moveSpeed), int(posY)) = 0 Then posX += dirX * moveSpeed
If worldMap(int(posX), int(posY + dirY * moveSpeed)) = 0 Then posY += dirY * moveSpeed
End If

if Multikey(SC_DOWN) or Multikey(SC_S) Then
If worldMap(int(posX - dirX * moveSpeed), int(posY)) = 0 Then posX -= dirX * moveSpeed
If worldMap(int(posX), int(posY - dirY * moveSpeed)) = 0 Then posY -= dirY * moveSpeed
End If

'rotate to the right
if Multikey(SC_RIGHT) Or ratonmas Then
'both camera direction and camera plane must be rotated
Dim As Double oldDirX = dirX
dirX = dirX * cos(-rotSpeed) - dirY * sin(-rotSpeed)
dirY = oldDirX * sin(-rotSpeed) + dirY * cos(-rotSpeed)
Dim As Double oldPlaneX = planeX
planeX = planeX * cos(-rotSpeed) - planeY * sin(-rotSpeed)
planeY = oldPlaneX * sin(-rotSpeed) + planeY * cos(-rotSpeed)
End If

if Multikey(SC_LEFT) Or ratonmenos Then
'both camera direction and camera plane must be rotated
Dim As Double oldDirX = dirX
dirX = dirX * cos(rotSpeed) - dirY * sin(rotSpeed)
dirY = oldDirX * sin(rotSpeed) + dirY * cos(rotSpeed)
Dim As Double oldPlaneX = planeX
planeX = planeX * cos(rotSpeed) - planeY * sin(rotSpeed)
planeY = oldPlaneX * sin(rotSpeed) + planeY * cos(rotSpeed)
EndIf

If MultiKey(SC_ESCAPE) Then
done = 1
EndIf

If InKey=Chr(255)+"k" Then End ' al pulsar la "X"

Sleep 1

GetMouse(xmouse,ymouse,mboton)

If ratonmas Or ratonmenos Then
ratonmas=0
ratonmenos=0
If xmouse=xmouseold Then
SetMouse(screenWidth/2,screenHeight/2,0) ' centro el raton, y lo escondo
GetMouse(xmouse,ymouse,mboton)
xmouseold=xmouse
velgiro=1
EndIf
EndIf

If xmouse<xmouseold Then
velgiro=(xmouseold-xmouse)/7
xmouseold=xmouse
ratonmenos=1
EndIf

If xmouse>xmouseold Then
velgiro=(xmouse-xmouseold)/7
xmouseold=xmouse
ratonmas=1
EndIf

Loop Until done

``````
jepalza
Posts: 149
Joined: Feb 24, 2010 10:08
Location: Spain (Bilbao)

### Re: Maze 2D and 3D

uppss!!
just this:
viewtopic.php?p=295996#p295996

I abandoned this engine some time ago, because I ran out of ideas of how to continue. maybe someone will be encouraged, and a game can be made with it.
flavio
Posts: 1
Joined: Jan 12, 2010 13:51

### Re: Maze 2D and 3D

Oh, don't be sorry, jepalza!
Why would you have to write in a foreign language?
For those who only know English, it will be a benefit to learn another language.