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