MODULE hi;
IMPORT B := Basic;
CONST
found=1;
pathsuccess=1;
CantCreatePathError=2;
TYPE
string=ARRAY OF CHAR;
VAR
path:INTEGER;
StepsOnPath:INTEGER;
PathBlockedByPerson:SHORTINT;
PathBlocker:INTEGER;
numberofopenlistitems:INTEGER;
LowestFCostSquareX:SHORTINT;
LowestFCostSquareY:SHORTINT;
gameboard:ARRAY 32,22 OF SHORTINT;
SquareState:ARRAY 32,22 OF SHORTINT;
SquareParentX:ARRAY 32,22 OF SHORTINT;
SquareParentY:ARRAY 32,22 OF SHORTINT;
HCost:ARRAY 32,22 OF SHORTINT;
PathToWalkX:ARRAY 100 OF SHORTINT;
PathToWalkY:ARRAY 100 OF SHORTINT;
(*PROCEDURE pathfindmessage(msg:string);
BEGIN
B.PRSTR(msg);
END pathfindmessage;
*)
(*
PROCEDURE ClearPath();
VAR
x,y:SHORTINT;
BEGIN
FOR x:=0 TO 32 DO
FOR y:=0 TO 24 DO
SquareState[x][y]:=0;
SquareParentX[x][y]:=0;
SquareParentY[x][y]:=0;
HCost[x][y]:=0;
END;
END;
(*
'for x=0 to 768
'PathToWalkX(x)=0
'PathToWalkY(x)=0
'next*)
StepsOnPath:=0;
PathBlockedByPerson:=0;
PathBlocker:=0;
numberofopenlistitems:=0;
END ClearPath;
PROCEDURE GetHCost(squarex:SHORTINT;squarey:SHORTINT;targetx:SHORTINT;targety:SHORTINT):SHORTINT;
BEGIN
RETURN (ABS(squarex-targetx)+ABS(squarey-targety));
END GetHCost;
PROCEDURE OnOpenList(squarex:INTEGER;squarey:INTEGER):INTEGER;
BEGIN
IF SquareState[squarex][squarey]=1 THEN
RETURN 1;
END;
RETURN 0;
END OnOpenList;
PROCEDURE OnClosedList(squarex:INTEGER; squarey:INTEGER):SHORTINT;
BEGIN
IF SquareState[squarex][squarey]=2 THEN
RETURN 1
END;
RETURN 0
END OnClosedList;
PROCEDURE AddToOpenList(squarex:SHORTINT;squarey:SHORTINT;parx:SHORTINT;pary:SHORTINT);
VAR
x:INTEGER;
y:INTEGER;
BEGIN
SquareParentX[squarex][squarey]:=parx;
SquareParentY[squarex][squarey]:=pary;
numberofopenlistitems:=numberofopenlistitems+1;
IF HCost[squarex][squarey]<HCost[LowestFCostSquareX][LowestFCostSquareY] THEN
LowestFCostSquareX:=squarex;
LowestFCostSquareY:=squarey;
END;
SquareState[squarex][squarey]:=1;
B.AT(squarey,squarex);
B.PRSTR( "O");
END AddToOpenList;
PROCEDURE AddToClosedList(squarex:INTEGER;squarey:INTEGER);
VAR
dist:INTEGER;
chosenX:SHORTINT;
chosenY:SHORTINT;
x:SHORTINT;
y:SHORTINT;
BEGIN
IF LowestFCostSquareX=squarex THEN
IF LowestFCostSquareY=squarey THEN
chosenX:=-1;
chosenY:=-1;
dist:=9999;
FOR x:=0 TO 32 DO
FOR y:=0 TO 24 DO
IF OnOpenList(x,y)=1 THEN
IF HCost[x][y]<dist THEN
dist:=HCost[x][y];
chosenX:=x;
chosenY:=y;
END;
END;
END;
END;
IF chosenX>-1 THEN
LowestFCostSquareX:=chosenX;
LowestFCostSquareY:=chosenY;
END;
END;
END;
IF SquareState[squarex][squarey]=1 THEN
numberofopenlistitems:=numberofopenlistitems-1;
END;
SquareState[squarex][squarey]:=2;
B.AT(squarey,squarex);
B.PRSTR( "C");
END AddToClosedList;
PROCEDURE AddToPath(squarex:INTEGER;squarey:INTEGER);
BEGIN
B.AT(squarey,squarex);
B.PRSTR( "P");
END AddToPath;
PROCEDURE CreatePath(StartX:SHORTINT;StartY:SHORTINT;TargetX:SHORTINT;TargetY:SHORTINT) :SHORTINT;
VAR
PathCreated:SHORTINT;
ParX:SHORTINT;
ParY:SHORTINT;
NewParX:SHORTINT;
NewParY:SHORTINT;
BEGIN
PathBlockedByPerson:=0;
PathBlocker:=0;
PathCreated:=0;
StepsOnPath:=StepsOnPath+1;
PathToWalkX[StepsOnPath]:=TargetX;
PathToWalkY[StepsOnPath]:=TargetY;
ParX:=PathToWalkX[StepsOnPath];
ParY:=PathToWalkY[StepsOnPath];
WHILE PathCreated=0 DO
NewParX:=SquareParentX[ParX][ParY];
NewParY:=SquareParentY[ParX][ParY];
ParX:=NewParX;
ParY:=NewParY;
AddToPath(ParX,ParY);
StepsOnPath:=StepsOnPath+1;
IF StepsOnPath>254 THEN
RETURN 2
END;
PathToWalkX[StepsOnPath]:=ParX;
PathToWalkY[StepsOnPath]:=ParY;
IF (PathToWalkX[StepsOnPath]=StartX) & (PathToWalkY[StepsOnPath]=StartY) THEN
PathCreated:=1;
END;
END;
RETURN 1;
END CreatePath;
PROCEDURE CheckSquare(squarex:SHORTINT;squarey:SHORTINT;targetx:SHORTINT;targety:SHORTINT;originalx:SHORTINT;originaly:SHORTINT);
BEGIN
IF squarex>-1 THEN
IF squarex<32 THEN
IF squarey>-1 THEN
IF squarey<24 THEN
B.PRSTR("Check square");
(*CHR(squarex+48)+" "+STR(squarey));*)
IF OnClosedList(squarex,squarey)=0 THEN
B.PRSTR("not on closed list");
IF OnOpenList(squarex,squarey)=0 THEN
(*pathfindmessage("not on open list");*)
IF (squarex=targetx)&(squarey=targety)THEN
path:=found;
END;
HCost[squarex][squarey]:=GetHCost(squarex,squarey,targetx,targety);
AddToOpenList(squarex,squarey,originalx,originaly);
IF path=found THEN
SquareParentX[squarex][squarey]:=originalx;
SquareParentY[squarex][squarey]:=originaly;
(*pathfindmessage("path is found");*)
AddToClosedList(squarex,squarey);
END;
END;
END;
END;
END;
END;
END;
END CheckSquare;
PROCEDURE FindPath(startx:SHORTINT;starty:SHORTINT;targetx:SHORTINT;targety:SHORTINT):SHORTINT;
VAR
DebugIter:INTEGER;
lowx:SHORTINT;
lowy:SHORTINT;
BEGIN
ClearPath();
DebugIter:=0;
(*pathfindmessage("FindPath")*)
IF (startx =targetx) & (starty = targety) THEN
(*pathfindmessage("target square = start square")*)
RETURN 3
END;
HCost[startx][starty]:=GetHCost(startx,starty,targetx,targety);
AddToOpenList(startx,starty,startx,starty);
LowestFCostSquareX:=startx;
LowestFCostSquareY:=starty;
path:=-1;
WHILE (path=-1) DO
DebugIter:=DebugIter+1;
IF DebugIter>200 THEN
(*pathfindmessage("path too long")*)
path:=-2
END;
IF numberofopenlistitems=0 THEN
(*pathfindmessage("no more open list items");*)
path:=-2
END;
(*pathfindmessage("Lowest f cost square "+STR(LowestFCostSquareX)+" "+STR(LowestFCostSquareY))*)
lowx:=LowestFCostSquareX;
lowy:=LowestFCostSquareY;
CheckSquare(lowx+1,lowy,targetx,targety,lowx,lowy);
CheckSquare(lowx-1,lowy,targetx,targety,lowx,lowy);
CheckSquare(lowx,lowy+1,targetx,targety,lowx,lowy);
CheckSquare(lowx,lowy-1,targetx,targety,lowx,lowy);
IF path#found THEN
AddToClosedList(lowx,lowy);
END;
END;
IF path = found THEN
(*Print "path was found"*)
IF CreatePath(startx , starty , targetx ,targety)#1 THEN
RETURN CantCreatePathError;
END;
RETURN 1 ;
END;
RETURN 0;
END FindPath;
*)
PROCEDURE Main* ;
CONST
TYPE
VAR
result:SHORTINT;
BEGIN B.Init;
B.BORDER(B.Green);
B.PAPER(B.Black);
B.CLS;
B.PRSTR("hello");
(*result:=FindPath(0,10,10,0);*)
(*result:=FindPath(0,10,31,23);*)
(*result:=FindPath(31,23,0,0);*)
B.PAUSE(B.WaitAKey);
B.Quit;
END Main;
END hi.