[Back to MISC SWAG index] [Back to Main SWAG index] [Original]
(* 30-8-97 : Solve 'Maze' With the Start and the End Position *)
(* By RRC2 (Ramon/Rodrigo Roman Castro) Soft, Malaga, Spain. *)
(* - For: RPG programmers in every languages // Programadores de JDR.
- Used in : BP 7.0.
- Status : FreeWare, Can be Changed if You want.
- Request : If you use it, please put our name in the credits.
- Disclaimer : Code Full Tested. We aren't responsible of the damage
that this code can do in your computer.
- Sorry : We have a very bad English.
- Comments :They're in English and Spanish. I'm Spanish, and Spanish is in
the first five languages talken on the world, Did you know ?. Learn It!.
- ATTENTION: I Don't Know if this Algorithm have been created before our
discovery, but I don't see it on Anywhere. *)
(* Imagine that you are making an RPG Game and you need a way
enemies->objetives ( The Players ) in a maze structure.
We have discovered an algorithm that can give a way to bad guys in
a Rectangular map with or within Obstacles.
This is.....
THE MONIGOTES ALGORITHM
=======================
It's based in BackTracking Algorithm.
Think that in every position of the terrain there's a byte that shows
a direction: 1 North
4 West 2 East
3 South
We start with the idea that my initial position in the terrain is a
monigote (rag figure, I Think), and when it can, it expands himself wri-
ting this directions in the terrain:
3 1
2 M 4 -> We don't write 4 2 (We must find the way Obj->BG, see:
1 3 Now, What we have?)
It Can't expand if there's an wall or another direction written in the
square we wanted to go.
Now we start with a loop:
-------------------------
The directions previously created ( in the previous loop ) transforms
into monigotes, and they expand themselves (see above).
This loop ends when a monigote is beside the objective.
Example:
-------- 3 33 33
3 234 2344 2344 B = Bad Guy
B W 2M4W 2M4W 2M4W 2M4W O = Objective
O -> O 1 -> O 1 -> O 1 -> O 11 M = Monigote
W = Wall
No Loop 1¦ Loop 2¦ L o o p.........
Now, What we have?
------------------
We have in the terrain the way Objective->Badguy written. So, starting
in the position of the monigote that were beside the Obj., we find this
way, put it into a vector, change the directions and put the vector
in a new vector with interchanging beginning and end ( We want BadGuy->
Objetive ! ).
What returns algorithm
----------------------
A vector with the way BadGuy->Objetive. You can't take a Wrong Way.
Tehcnical Details
-----------------
--Who are the directions that I need to transform into monigotes?
They're in a Linked List, PuntActuales, So we transform them into
monigotes and next they're cleared.
--And the directions created?
They're also in another Linked List, SigPunteros. It will transform into
PuntActuales in the start of the a loop.
Praise( Ja,Ja ;) )
------------------
It's a Finstro of algorithm !. (Finstro:Word that means nothing in English,
and nothing in Spanish ! [ Viva Chiquito de la Calz :) ])
Disclaimer
----------
This algorithm was created in 30-8-97, 11:00->4:00(night), so if it
isn't optimal, sorry.
*)
Program AlgoritmoMonigotes;
Uses Crt;
Const MAXMOV = 30; (* The maximum movements I Can do *)
MAXIMO = 20; (* Dimensions of the Terrain *)
INIX = 1; (* X Coordinate of the Bad Guy *)
INIY = 12; (* Y Coordinate of the Bad Guy *)
OBJX = 15; (* X Coordinate of the Objective *)
OBJY = 9; (* Y Coordinate of the Objective *)
DISTANCIAMAXIMA = 1; (* Reserved *)
Type TSolucion = Array[1..MAXMOV] Of Integer; (* Vector with Solution *)
TPantalla = Array[1..MAXIMO,1..MAXIMO] Of Byte; (* Terrain *)
TPosicion = Record (* Position in X and Y *)
X,Y:Integer;
End;
(* Maze-Type Terrain *)
Const Pantalla:TPantalla =
((1,1,1,9,1,1,1,9,1,1,1,1,9,1,9,1,1,1,1,1),
(1,1,1,1,1,9,1,1,1,1,9,9,9,1,9,9,9,9,1,1),
(9,1,1,1,1,1,1,1,1,1,9,9,9,1,9,1,1,9,9,1),
(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,9,1),
(1,1,9,1,1,1,1,9,1,1,9,1,9,9,1,1,1,9,1,1),
(1,1,1,1,1,9,1,9,1,1,1,1,1,1,1,1,1,9,1,1),
(9,1,1,1,9,9,1,9,9,9,9,9,1,9,9,1,1,9,1,9),
(1,1,1,1,1,1,1,1,1,9,1,1,1,1,1,1,1,1,1,9),
(9,1,9,1,1,9,1,9,1,1,1,1,9,1,1,9,9,1,9,9),
(1,1,9,1,1,9,1,1,9,1,1,1,9,1,1,1,9,1,9,1),
(9,1,1,1,1,1,1,1,9,1,1,1,9,1,9,1,1,1,1,1),
(1,1,1,1,9,9,9,1,1,1,9,1,9,1,9,9,9,9,1,1),
(1,1,9,1,1,9,1,1,1,1,9,1,9,1,9,1,1,9,9,1),
(9,1,9,1,1,9,1,9,9,1,1,1,1,1,1,1,1,1,9,9),
(1,1,9,1,9,9,1,9,1,9,9,9,9,9,9,1,1,9,1,1),
(9,1,9,1,1,1,1,9,1,1,1,1,1,1,1,1,1,1,1,1),
(9,1,9,9,9,9,1,1,9,9,9,9,9,9,9,1,1,9,9,9),
(1,1,1,1,9,1,1,1,1,9,1,1,1,1,1,1,1,1,1,9),
(1,1,1,1,1,1,1,1,1,9,1,1,1,1,1,1,1,1,1,9),
(9,9,9,9,9,9,9,1,9,9,9,9,9,9,9,9,9,9,9,9));
(* Terrain Within Obstacles *)
(* Const Pantalla:TPantalla =
((1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1));*)
Var Fondo :TPantalla;
Mov :Integer;
MovTotal :Integer;
Exito :Boolean;
Ini,Obj :TPosicion;
i :Integer;
Solucion :TSolucion;
(* This procedure create the terrain with the Const Pantalla *)
Procedure InicializarPantallas;
Var i,j:Byte;
Pant:TPantalla;
Begin
Fondo:=Pantalla;
End;
(* This procedure Paints the Terrain onto the screen *)
Procedure PintarPantallas;
Var i,j:Byte;
Begin
For i:=1 to MAXIMO Do
For j:=1 to MAXIMO Do
Begin
GotoXy(i,j);
Case Fondo[i,j] Of
1:Write('°');
9:Begin
TextColor(RED);
Write('Û');
TextColor(LIGHTGRAY);
End;
End;
End;
GotoXY(OBJX,OBJY);Write(CHR(1));
GotoXY(INIX,INIY);Write('Y');
End;
(* This procedure paints the solution given in the vector Solucion *)
Procedure PintarMovimientos(Solucion:TSolucion;MovTotal:Integer);
Var Pos:TPosicion;
i:Integer;
Begin
Pos:=INI;
For i:=1 to MovTotal Do
Begin
Case Solucion[i] Of
1:Dec(Pos.Y);
2:Inc(Pos.X);
3:Inc(Pos.Y);
4:Dec(Pos.X);
End;
GotoXy(Pos.X,Pos.Y);
TextColor(DarkGray);
Case Fondo[Pos.X,Pos.Y] Of
1:Write('°');
End;
TextColor(LightGray);
End;
End;
(* This function says if I can Step On a Square *)
Function SiPisar(ActualX,ActualY:ShortInt):Boolean; (* ¨ Puedo Pisar ? *)
Begin
SiPisar:= (ActualX>0) And (ActualX<=MAXIMO) And
(ActualY>0) And (ActualY<=MAXIMO) And
(Fondo[ActualX,ActualY] <> 9); (* 9-> Wall // Muro *)
End;
(*-----------------------------------------------------------------------*)
(*------------------ALGORITHM//ALGORITMO---------------------------------*)
(*-----------------------------------------------------------------------*)
(* BusqMonigote: The Algorithm. Returns TRUE if there's a way
\-----> Devuelve si hay un camino
Inicio: is the position of the Bad Guy, // Pos. Malo
Objetivo: is the objective position, // Posicion objetivo
PMov: is the squares you can move, // Casillas que puedo mover
VAR Solucion: is the vector with the solution, // Array con la solucion
VAR Movtotal: is the movements you have Done, // Movimientos realizados
Fondo: is the Terrain // El terreno donde nos movemos
*)
Function BusqMonigote(Inicio,Objetivo:TPosicion;PMov:Integer;
Var Solucion:TSolucion;Var MovTotal:Integer;
Fondo:TPantalla):Boolean;
Const MAYOR = (MAXIMO*MAXIMO)+1;
Type PRegistro = ^TRegistro;
TLista = PRegistro;
TElemento = TPosicion;
TRegistro = Record
Zona:TElemento;
Sig:TLista;
End;
TAlgMonigote = Array[1..MAXIMO,1..MAXIMO] Of Byte;
TRejSolucion = Array[1..MAYOR] Of Integer; (* Guardo Solucion Total *)
(* Saves the entire Way *)
(* Asi encuentra hasta el camino mas raro *)
(* With this vector it can find even the strangest Way *)
Var PuntActuales:TLista;
SigPunteros:TLista;
Actual:TPosicion;
Indice:TLista;
AlgMonigote:TAlgMonigote;
PosVictoria:TPosicion;
SolucionTmp:TRejSolucion;
Contador:Integer;
CBucle:Integer;
Contador2:Integer;
(* Distancia measure the distance | Mide distancia entre blanco y objetivo *)
Function Distancia(ActualX,ActualY:ShortInt;Objetivo:TPosicion):Byte;
Begin
Distancia:=Abs(ActualX-Objetivo.X)+Abs(ActualY-Objetivo.Y);
End;
(* Initiate vars and pointers *)
Procedure InicializoListasYVariables;
Var x,y:Integer;
Begin
PuntActuales:=NIL;
SigPunteros:=NIL;
Indice:=NIL;
Actual:=Inicio;
PosVictoria.X:=MAXIMO+1;
PosVictoria.Y:=MAXIMO+1;
For x:=1 To MAXIMO Do
Solucion[x]:=0;
For x:=1 To MAYOR Do
SolucionTmp[x]:=0;
For x:=1 To MAXIMO Do
For y:=1 To MAXIMO Do
Begin
AlgMonigote[x,y]:=0;
End;
End;
(* Here stars Procedures of Pointers and Linked Lists *)
(* Insert_Begin // Inserta en el frente de una lista enlazada *)
Procedure MeterFrente(Var Lista:TLista;Ele:TElemento);
Var Tmp:TLista;
Begin
New(Tmp);
Tmp^.Zona:=Ele;
Tmp^.Sig:=Lista;
Lista:=Tmp;
End;
(* Pop_Begin // Saca un elemento del inicio de la lista enlazada *)
Procedure SacarFrente(Var Lista:TLista;Var Ele:TElemento);
Var Tmp:TLista;
Begin
If Lista<>NIL Then
Begin
Tmp:=Lista;
Lista:=Tmp^.Sig;
Ele:=Tmp^.Zona;
Dispose(Tmp);
End;
End;
(* Eliminate List // Elimina la lista enlazada *)
Procedure EliminoLista(Var Lista:TLista);
Var Tmp:TLista;
Begin
While Lista<>NIL Do
Begin
Tmp:=Lista;
Lista:=Tmp^.Sig;
Dispose(Tmp);
End;
End;
(* End of Linked List Procedures and Functions *)
(* Procedure that writes the directions when monigotes are expanding *)
Procedure ComprobarBordes(Pos:TPosicion;Var AlgMonigote:TAlgMonigote;
Var PosVictoria:TPosicion);
Var EleTmp:TPosicion;
Begin
(* Check Distance // Chequea la distancia al objetivo *)
If (Distancia(Pos.X,Pos.Y,Objetivo) <= DISTANCIAMAXIMA) And
(Distancia(Pos.X,Pos.Y,Objetivo) <> 0) Then
PosVictoria:=Pos
Else
Begin
(*1*)If SiPisar(Pos.X,Pos.Y-1) And
(AlgMonigote[Pos.X,Pos.Y-1]=0) Then
Begin
AlgMonigote[Pos.X,Pos.Y-1]:=3;
EleTmp.X:=Pos.X;
EleTmp.Y:=Pos.Y-1;
MeterFrente(SigPunteros,EleTmp);
End;
(*2*)If SiPisar(Pos.X+1,Pos.Y) And
(AlgMonigote[Pos.X+1,Pos.Y]=0) Then
Begin
AlgMonigote[Pos.X+1,Pos.Y]:=4;
EleTmp.X:=Pos.X+1;
EleTmp.Y:=Pos.Y;
MeterFrente(SigPunteros,EleTmp);
End;
(*3*)If SiPisar(Pos.X,Pos.Y+1) And
(AlgMonigote[Pos.X,Pos.Y+1]=0) Then
Begin
AlgMonigote[Pos.X,Pos.Y+1]:=1;
EleTmp.X:=Pos.X;
EleTmp.Y:=Pos.Y+1;
MeterFrente(SigPunteros,EleTmp);
End;
(*4*)If SiPisar(Pos.X-1,Pos.Y) And
(AlgMonigote[Pos.X-1,Pos.Y]=0) Then
Begin
AlgMonigote[Pos.X-1,Pos.Y]:=2;
EleTmp.X:=Pos.X-1;
EleTmp.Y:=Pos.Y;
MeterFrente(SigPunteros,EleTmp);
End;
End;
End;
Begin
InicializoListasYVariables;
(* Pongo las primeras direciones // Puts the First Directions *)
ComprobarBordes(Inicio,AlgMonigote,PosVictoria);
(* INICIO ALGORITMO // ALGORITHM STARTS *)
(* Chequeo PosVictoria o fin del chequeo *)
While ((PosVictoria.X=MAXIMO+1) And (PosVictoria.Y=MAXIMO+1)) And
(SigPunteros<>NIL) Do
Begin
EliminoLista(PuntActuales);
PuntActuales:=SigPunteros;
SigPunteros:=NIL;
(* Salgo al encontrar el 1§ o ninguno *)
While (PuntActuales<>NIL) And
((PosVictoria.X=MAXIMO+1) And (PosVictoria.Y=MAXIMO+1)) Do
Begin
SacarFrente(PuntActuales,Actual);
ComprobarBordes(Actual,AlgMonigote,PosVictoria);
End;
End; (* Fin del Algoritmo en Si *)
EliminoLista(PuntActuales);
EliminoLista(SigPunteros);
(* FIN DEL ALGORITMO // ALGORITHM ENDS *)
(* Ahora paso la solucion al Array Solucion. Escribo el camino completo en
SolucionTmp ( Invirtiendo las direcciones, ya que busco de principio a
fin ) y luego escribo en Solucion "Invirtiendo el vector" *)
(* Now I pass the Solution ( It's in the AlgMonigote Vector ) to Solucion,
using SolucionTmp (-> It Have the entire Way ) like a bridge *)
If (PosVictoria.X=MAXIMO+1) And (PosVictoria.Y=MAXIMO+1) Then
BusqMonigote:=False (* No encontre camino // There's no way *)
Else Begin (* Encontre camino // There's a way *)
Actual:=PosVictoria;
Contador:=1;
While (Actual.X<>Inicio.X) OR (Actual.Y<>Inicio.Y) Do
(* Busco el camino del final al principio, transformando *)
Begin
Case AlgMonigote[Actual.X,Actual.Y] Of (* Cambio direcciones *)
1:SolucionTmp[Contador]:=3;
2:SolucionTmp[Contador]:=4;
3:SolucionTmp[Contador]:=1;
4:SolucionTmp[Contador]:=2;
End;
Inc(Contador);
Case AlgMonigote[Actual.X,Actual.Y] Of
1:Dec(Actual.Y);
2:Inc(Actual.X);
3:Inc(Actual.Y);
4:Dec(Actual.X);
End;
End;(* Del While *)(* Saco Contador con el Num. de Movs Total+1 *)
Contador2:=1;
For CBucle:=Contador-1 DownTo 1 Do
(* Ahora cambio direccion del camino de Fin-inicio a Inicio-Fin *)
(* Meto solo el movimiento que tengo *)
Begin
If (Contador2 <= PMov) And (SolucionTmp[CBucle]<>0) Then
Begin
Solucion[Contador2]:=SolucionTmp[CBucle];
Inc(Contador2);
End;
End; (* Del For *)
MovTotal:=Contador2-1; (* Mov Realizados *)
BusqMonigote:=TRUE;
End;
End;
Begin
TextColor(LightGray);
Ini.X:=INIX;
Ini.Y:=INIY;
Obj.X:=OBJX;
Obj.Y:=OBJY;
ClrScr;
InicializarPantallas;
PintarPantallas;
Exito:=BusqMonigote(INI,OBJ,MAXMOV,Solucion,MovTotal,Fondo);
GotoXy(1,22);
For i:=1 to Movtotal Do
Write(Solucion[i]);
GotoXy(1,23);
Write('Way finded//Hay camino: ',Exito,'. Movements//Movimientos -> ',MovTotal);
ReadKey;
PintarMovimientos(Solucion,MAXMOV);
ReadKey;
End.
(* There's no RPG programmers there?. Contact SWAG, leshe. *)
[Back to MISC SWAG index] [Back to Main SWAG index] [Original]