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.
 

(* Place this procedure at begin of "main" module of your project: *)
PROCEDURE ^Main; PROCEDURE EntryPoint; BEGIN Main END EntryPoint;
(* It defines procedure Main. Procedure EntryPoint is started first *)
(* (for example, at 26000) and run procedure "Main". *)
 
...
 
PROCEDURE Main;
BEGIN
  (* Place your startup code here, *)
  (* and not in the initialization section of the module "BEGIN ... END Module. *)
END Main;

 
all: $(target).tap
 
$(target).tap: $(target).bin
	Bin/bin2tap -b -a 26000 -c 25999 -r 26000 -o $(target).tap $(target).bin
	fuse-gtk $(target).tap
$(target).bin: $(target).ihx
	Bin/hex2bin $(target).ihx
 
$(target).ihx: Obj/$(target).c path.lib
	Bin/sdcc/bin/sdcc -mz80 --code-loc 26000 --opt-code-size --no-std-crt0 Obj/$(target).c -I Lib -I Obj Lib/z80/Basic.lib path.lib
 
path.lib: path.rel
	/root/Downloads/sdcc/bin/sdcclib path.lib path.rel
 
path.rel:Obj/path.c
	/root/Downloads/sdcc/bin/sdcc -mz80 -c Obj/path.c -I Obj -I Lib
 
Obj/$(target).c:Mod/$(target).mod Mod/path.mod
	"/root/ofront/linux2/bin/ofront" Mod/path.mod Mod/$(target).mod -m -l
	mv $(target).c Obj/$(target).c
	mv path.c Obj/path.c
 
Obj/path.c:Mod/path.mod
	"/root/ofront/linux2/bin/ofront" Mod/path.mod -l
 
 

	.module crt0
	.globl	_main
	jp	_main

VAR i: INTEGER; (* {-32678..32767} *)
BEGIN i := SHORT(ENTIER(real));
...