View.Set ("graphics:max,max")
const CITY := 1
const GRASS := 2
const FOREST := 3
const MOUNTAIN := 4
const ROAD := 5
const SHALLOW := 6
const WATER := 7
const SHORE := 8
var openListx, openListy, openListg, openListh, openListf : array 1 .. 100 of int
var closeListx, closeListy : array 1 .. 100 of int
var map : array 1 .. 100, 1 .. 60 of int
var mapPass : array 1 .. 100, 1 .. 60 of boolean
var terrainTypes : array 1 .. 8 of int := init (42, 48, 2, 66, 15, 53, 55, 91)
var mx, my, mb, gridx, gridy, font, readtest, lowest : int
var parentx, parenty, startx, starty, endx, endy, tempx, tempy, count : int := 0
font := Font.New ("Verdana:10")
startx := 9
parentx := startx
starty := 10
parenty := starty
endx := 60
endy := 40
proc drawMap
%DRAWS THE MAP
for i : 1 .. 100
for j : 1 .. 60
drawbox ((i * 10), (j * 10), (i * 10) + 10, (j * 10) + 10, black)
end for
end for
end drawMap
proc grid (var gridx, gridy : int, var mapPass : array 1 .. *, 1 .. * of boolean)
% CHECKS GRID FOR PASSIBILITY - IF RED THEN CANNOT PASS
mousewhere (mx, my, mb)
gridx := mx div 10
gridy := my div 10
for i : 1 .. 100
for j : 1 .. 60
if whatdotcolor (((i * 10) + 1), ((j * 10) + 1)) = red then
mapPass (i, j) := true
end if
end for
end for
end grid
proc fillgrid
% LAYS DOWN AN OBSTACLE EVERYTIME CLICKED
if mb = 1 then
drawfill (mx, my, red, black)
end if
end fillgrid
proc setGotoStop
Font.Draw ("X", startx * 10 + 1, starty * 10 + 1, font, black)
Font.Draw ("X", endx * 10 + 1, endy * 10 + 1, font, black)
end setGotoStop
proc searchPath
% SEARCHES A PATH BETWEEN THE OBSTACLES -A* PATHFINDING
open : readtest, "test.txt", put
openListx (1) := parentx
openListy (1) := parenty
for s : 2 .. 9
% ALL SPACES MINUS THE PARENT
for i : 1 .. 3
% X AXIS
for j : 1 .. 3
%Y AXIS
tempx := ((startx - 2) + i)
tempy := ((starty - 2) + j)
if mapPass (tempx, tempy) not= true then
if tempx = startx and tempy = starty then
else
openListx (s) := tempx
openListy (s) := tempy
put : readtest, openListx (s), "X", openListy (s), "Y ", i, " ", j, " "
% Calculate H
openListh (s) := round (abs (sqrt (intreal ((endx - tempx) ** 2) + intreal ((endy - tempy) ** 2))))
put : readtest, "H value of :", openListh (s)
% Calculate G
if (i = 1 and j = 1) or (i = 3 and j = 3) or (i = 1 and j = 3) or (i = 3 and j = 1) then % Diagonal or Orthogonal?
openListg (s) := 14
else
openListg (s) := 10
end if
put : readtest, "G value of :", openListg (s)
% Calculate F
openListf (s) := openListh (s) + openListg (s)
put : readtest, "F value of :", openListf (s)
% SCREWS UP IF ONE OR NO SPACE IS AVAILABLE
for decreasing k : s .. 2
if openListf (k) < openListf (s) then
lowest := k
put : readtest, "THE NEXT SQUARE IS (", openListx (lowest), ",", openListy (lowest), ") "
closeListx (2) := openListx (lowest)
closeListy (2) := openListy (lowest)
end if
end for
end if
end if
end for
end for
put : readtest, " "
end for
closeListx (1) := openListx (1)
closeListy (1) := openListy (1)
for q : 1 .. 2
put : readtest, " DEFINITE SQUARES", closeListx (q), "x", closeListy (q), "y", q
end for
close : readtest
end searchPath
for z : 1 .. 100
for h : 1 .. 60
mapPass (z, h) := false
end for
end for
drawMap
loop
grid (gridx, gridy, mapPass)
fillgrid
setGotoStop
locate (1, 150)
put gridx, " ", gridy, " " ..
locate (2, 145)
if mx > 10 and mx < 1010 and my > 10 and my < 610 then
put mapPass (mx div 10, my div 10)
else
put " Not on grid "
end if
if mb = 1 and mx >= maxx - 20 then
searchPath
end if
end loop