Make your own free website on Tripod.com

This PASCAL/Delphi code is converted into HTML using PAS_Colorizator v1.0 (c) 2001 by Alexander Yanuar Koentjara (lexzeus@hotmail.com)
{ Path Finding Algorithm : 8 Filling Square By : Alexander Yanuar Koentjara (lexzeus@hotmail.com) SYSTEM DEVELOPER of www.globalsources.com Logarithm for searching path, "A" must find "X" surrounding by walls. If the path is exist, the algorithm will surely find it. But if the path doesn't exist, it will try to search the nearset spot as possible from the target. } uses crt; Const MaxX = 80; MinX = 1; MaxY = 20; MinY = 1; MaxSquare = 1000; XXX = 9999; MaxTask = 30; Cup=0; Crup=1; Cright=2; crdown=3; cdown=4; cldown=5; cleft=6; clup=7; type recs = record x,y:byte; end; type target = record ptr : pointer; x,y : integer End; var x,y,i,j : integer; Mul,Ak : Target; { Mul = Start/From, Ak = End/Target } Tiles,Til2 : Array[MinX..MaxX,MinY..MaxY] of integer; procedure ShowAll; Var i,j:integer; Begin For j:=MinY to MaxY do For i:=MinX to MaxX do Begin Gotoxy(i,j); textcolor(7); If Til2[i,j]=0 then Write('') else if Til2[i,j]=2 then write('') else Begin textcolor(15);Write('');end; end; TextColor(14); Gotoxy(Mul.X,Mul.Y); Write('A'); TextColor(14); Gotoxy(Ak.X,Ak.Y); Write('X'); End; Procedure CariPath(Rang:Integer); Var x,y,i,j : integer; Til31 : Array[0..MaxSquare] of recs; Til32 : Array[0..MaxSquare] of recs; CTil31 : Integer; CTil32 : Integer; MovingTask : Array[0..MaxTask] of byte; NotBerhasil: Boolean; Procedure Square(a,b,c:integer); Function Ok(d,e:integer):Boolean; Begin If (MinX<=d) and (d<=MaxX) and (MinY<=e) and (e<=MaxY) and (Tiles[d,e]=xxx) and (Til2[d,e]=0) then Begin Til32[CTil32].X:=d;Til32[CTil32].Y:=e; Inc(CTil32); Ok:=True; NotBerhasil:=False; End else Ok:=False; End; Begin If Tiles[a,b]=c then Begin If Ok(a-1,b-1) then Tiles[a-1,b-1]:=c+1; If Ok(a ,b-1) then Tiles[a ,b-1]:=c+1; If Ok(a+1,b-1) then Tiles[a+1,b-1]:=c+1; If Ok(a+1,b ) then Tiles[a+1,b ]:=c+1; If Ok(a+1,b+1) then Tiles[a+1,b+1]:=c+1; If Ok(a ,b+1) then Tiles[a ,b+1]:=c+1; If Ok(a-1,b+1) then Tiles[a-1,b+1]:=c+1; If Ok(a-1,b ) then Tiles[a-1,b ]:=c+1; End; End; Procedure BackTrack(var aa,bb,cc:integer); Begin If Tiles[aa+1,bb ]=cc then Begin MovingTask[cc+1]:=CLeft; Til2[aa+1,bb ]:=2; aa:=aa+1; exit; end; If Tiles[aa-1,bb ]=cc then Begin MovingTask[cc+1]:=CRight; Til2[aa-1,bb ]:=2; aa:=aa-1; exit; end; If Tiles[aa ,bb-1]=cc then Begin MovingTask[cc+1]:=CDown; Til2[aa ,bb-1]:=2; bb:=bb-1; exit; end; If Tiles[aa ,bb+1]=cc then Begin MovingTask[cc+1]:=CUp ; Til2[aa ,bb+1]:=2; bb:=bb+1; exit; end; If Tiles[aa-1,bb-1]=cc then Begin MovingTask[cc+1]:=CRDown; Til2[aa-1,bb-1]:=2; aa:=aa-1; bb:=bb-1; exit; end; If Tiles[aa+1,bb-1]=cc then Begin MovingTask[cc+1]:=CLDown; Til2[aa+1,bb-1]:=2; aa:=aa+1; bb:=bb-1; exit; end; If Tiles[aa+1,bb+1]=cc then Begin MovingTask[cc+1]:=CLUp; Til2[aa+1,bb+1]:=2; aa:=aa+1; bb:=bb+1; exit; end; If Tiles[aa-1,bb+1]=cc then Begin MovingTask[cc+1]:=CRUp; Til2[aa-1,bb+1]:=2; aa:=aa-1; bb:=bb+1; exit; end; End; Begin Fillchar(Til31,Sizeof(Til31),0); Fillchar(Til32,Sizeof(Til32),0); Fillchar(MovingTask,Sizeof(MovingTask),9); i:=0; Tiles[Ak.X,Ak.Y]:=xxx; Tiles[Mul.X,Mul.Y]:=0; CTil31:=0; CTil32:=0; Til31[0].X:=Mul.X; Til31[0].Y:=Mul.Y; Repeat NotBerhasil:=True; For j:=0 to Ctil31 do Square(Til31[j].X,Til31[j].Y,i); CTil31:=CTil32; CTil32:=0; Move(Til32,Til31,2*CTil31); Inc(i); until (Tiles[Ak.X,Ak.Y]<>xxx) or NotBerhasil; If NotBerhasil then Begin j:=0; i:=1; Tiles[Ak.X,Ak.Y]:=xxx; Repeat y:=Ak.Y-i; if y<MinY then y:=MinY; Repeat x:=Ak.X-i; if X<MinX then X:=MinX; Repeat If Tiles[x,y]<>xxx then j:=1; inc(x); Until (x=Ak.X+i) or (x>MaxX) or (j>0); Inc(y); Until (y=Ak.Y+i) or (Y>MaxY) or (j>0); i:=i+1; Until j>0; x:=x-1; y:=y-1; Ak.X:=x; Ak.Y:=Y; gotoxy(Ak.X,Ak.y);write('#'); End; i:=Tiles[Ak.X,Ak.Y]; x:=Ak.X; y:=Ak.Y; MovingTask[0]:=1; Repeat Dec(i); BackTrack(X,Y,i); Until i=0; GOTOXY(1,22); i:=1; Clreol; Write('Steps : '); Repeat Write(MovingTask[i]); inc(i); until MovingTask[i]>CLUp; End; begin clrscr; Randomize; { making wall } Fillchar(Til2,Sizeof(Til2),0); for i:=1 to 40 do til2[i,10]:=1; for i:=21 to 70 do til2[i,15]:=1; for i:=11 to 50 do til2[i,18]:=1; for i:=42 to 80 do til2[i,10]:=1; for i:=1 to 10 do til2[30,i]:=1; for i:=7 to 15 do til2[60,i]:=1; for i:=10 to 20 do til2[20,i]:=1; for i:=12 to 20 do til2[30,i]:=1; for i:=1 to maxy do for j:=1 to maxx do Tiles[j,i]:=xxx; Repeat Ak.X:=Random(MaxX)+1; Ak.Y:=Random(MaxY)+1; { locate end position } Mul.X:=Random(MaxX)+1; Mul.Y:=Random(MaxY)+1; { locate start position } Until (Til2[Ak.X,Ak.Y]=0) and (Til2[Mul.X,Mul.Y]=0); ShowAll; Readkey; CariPath(10); ShowAll; GOTOXY(1,21);Write('Direction : 0-Up 1-RUp 2-Right 3-RDown 4-Down 5-LDown 6-Left 7-ULeft'); GOTOXY(1,23);Write(Tiles[Ak.X,Ak.Y],' steps for "A" to get "X".'); readkey; end.