(* 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. *)