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