sync on sync rate 0 saferandomize() mazewidth=20 mazeheight=20 dim cellwall(mazewidth+1,mazeheight+1,2) dim cellstatus(mazewidth+1,mazeheight+1) dim Sstackx((mazewidth+1)*(mazeheight+1)) dim Sstacky((mazewidth+1)*(mazeheight+1)) mapwidth=mazewidth*2+1 mapheight=mazeheight*2+1 dim map(mapwidth,mapheight) dim Path(mapwidth,mapheight) dim PathCom(mapwidth,mapheight) dim flooddata(mapwidth,mapheight) dim ProbablePath#(mapwidth,mapheight) dim invisiblewall(mapwidth,mapheight) dim Pendpointx(0) dim Pendpointy(0) dim Highestflood(0) dim Preypath(mapwidth,mapheight) dim Preypathx(mapwidth*mapheight) dim Preypathy(mapwidth*mapheight) dim Preypathl(0) dim Predpath(mapwidth,mapheight) dim Predpathx(mapwidth*mapheight) dim Predpathy(mapwidth*mapheight) dim Predpathl(0) dim Highestfloodpred(0) dim flooddatapred(mapwidth,mapheight) predhistory=10 dim oldpredx(predhistory) dim oldpredy(predhistory) for x=1 to mazewidth cellwall(x,1,2)=1 cellwall(x,mazeheight+1,2)=1 cellstatus(x,0)=3 cellstatus(x,mazeheight+1)=3 next x for y=1 to mazeheight cellwall(1,y,1)=1 cellwall(mazewidth+1,y,1)=1 cellstatus(0,y)=3 cellstatus(mazewidth+1,y)=3 next y for x=1 to mazewidth for y=1 to mazeheight cellwall(x,y,1)=1 cellwall(x,y,2)=1 next y next x gosub GenerateMaze convertmazetomap(mazewidth,mazeheight) gosub FindCommonPaths fillfloodarray(2,2,predx,predy,0,mapwidth,mapheight,predhistory) calculatepropablepath(mapwidth,mapheight,preddis) playerx=2 playery=2 preyx=2 preyy=2 AStarPathFinder(mapwidth,mapheight,preyx,preyy,(rnd(mazewidth-2)+1)*2,(rnd(mazeheight-2)+1)*2,2) preypathon=1 predx=mapwidth-1 predy=mapheight-1 AStarPathFinder(mapwidth,mapheight,predx,predy,preyx,preyy,1) predpathon=1 oldtimer=timer() preddis=0 dim col(6) col(1)=rgb(255,0,0) col(2)=rgb(255,255,0) col(3)=rgb(0,255,0) col(4)=rgb(0,255,255) col(5)=rgb(0,0,255) col(6)=rgb(255,0,255) viewmode=1 endpoint=1 do cls rgb(255,255,255) if keystate(49)=1 : rem n key viewmode=1 endif if keystate(21)=1 : rem y key viewmode=2 endif if keystate(32)=1 : rem d key viewmode=3 endif if keystate(46)=1 : rem c key viewmode=4 endif if keystate(33)=1 : rem f key viewmode=5 endif if keystate(25)=1 : rem p key viewmode=6 endif if keystate(18)=1 : rem e key if oldekey=0 endpoint=1-endpoint endif endif oldekey=keystate(18) if keystate(23)=1 : rem i key if oldikey=0 disinvwall=1-disinvwall endif endif oldikey=keystate(23) if keystate(35)=1 : rem h key if oldhkey=0 dishistory=1-dishistory endif endif oldhkey=keystate(35) if timer()-oldtimer>(500/((spacekey()+1)*((controlkey()*20)+1))) rem Prey AI oldpreyx=preyx oldpreyy=preyy preyx=preypathx(preypathon) preyy=preypathy(preypathon) preypathon=preypathon+1 oldpreddis=preddis undim flooddatapred(mapwidth,mapheight) dim flooddatapred(mapwidth,mapheight) fillfloodarraypred(predx,predy,mapwidth,mapheight) preddis=flooddatapred(preyx,preyy) if preypathon>=preypathl(0) or preypath(predx,predy)=1 or preddis<10 and oldpreddis>preddis preypathon=2 intrap=2 repeat if intrap=2 intrap=intrap(preyx,preyy,predx,predy,mapwidth,mapheight) up=flooddatapred(preyx,preyy-1) right=flooddatapred(preyx+1,preyy) down=flooddatapred(preyx,preyy+1) left=flooddatapred(preyx-1,preyy) centre=flooddatapred(preyx,preyy) if (up=0 or up>=centre) and (right=0 or right>=centre) and (down=0 or down>=centre) and (left=0 or left>=centre) intrap=1 endif endif if intrap=0 coordinates$=Randdestination(preyx,preyy,predx,predy,mapwidth,mapheight) endx=val(left$(coordinates$,2)) endy=val(right$(coordinates$,2)) else endx=(rnd(mazewidth-2)+1)*2 endy=(rnd(mazeheight-2)+1)*2 while endx>=preyx-1 and endy>=preyy-1 and endx<=preyx+1 and endy<=preyy+1 endx=(rnd(mazewidth-2)+1)*2 endy=(rnd(mazeheight-2)+1)*2 endwhile endif undim preypath(mapwidth,mapheight) dim preypath(mapwidth,mapheight) AStarPathFinder(mapwidth,mapheight,preyx,preyy,endx,endy,2) undim flooddatapred(mapwidth,mapheight) dim flooddatapred(mapwidth,mapheight) fillfloodarraypred(predx,predy,mapwidth,mapheight) temppreyx=preypathx(2) temppreyy=preypathy(2) temppreddis=flooddatapred(temppreyx,temppreyy) until temppreddis>10 or preddis<temppreddis or intrap=1 undim flooddatapred(mapwidth,mapheight) dim flooddatapred(mapwidth,mapheight) fillfloodarraypred(predx,predy,mapwidth,mapheight) preddis=flooddatapred(preyx,preyy) endif direction=0 if preyx=oldpreyx and preyy=oldpreyy-1 then direction=1 if preyx=oldpreyx+1 and preyy=oldpreyy then direction=2 if preyx=oldpreyx and preyy=oldpreyy+1 then direction=3 if preyx=oldpreyx-1 and preyy=oldpreyy then direction=4 preypath(preyx,preyy)=0 rem Predator AI if returnkey()=0 if preyx=predx and preyy=predy then end predx=predpathx(predpathon) predy=predpathy(predpathon) predpathon=predpathon+1 PePx=Pendpointx(0) PePy=Pendpointy(0) if Predx=PePx and Predy=PePy or preddis<20 and preypath(preyx,preyy)=0 or predpathon>=predpathl(0) or PreyNoWhereToRun(preyx,preyy,predx,predy,mapwidth,mapheight)=1 undim predpath(mapwidth,mapheight) dim predpath(mapwidth,mapheight) AStarPathFinder(mapwidth,mapheight,predx,predy,Preyx,Preyy,1) predpathon=2 endif if invisiblewall(preyx,preyy)=1 undim invisiblewall(mapwidth,mapheight) dim invisiblewall(mapwidth,mapheight) endif invisiblewall(preyx,preyy)=1 if inkey$()="m" then suspend for mouse undim flooddata(mapwidth,mapheight) dim flooddata(mapwidth,mapheight) fillfloodarray(preyx,preyy,predx,predy,direction,mapwidth,mapheight,predhistory) calculatepropablepath(mapwidth,mapheight,preddis) PePx=Pendpointx(0) PePy=Pendpointy(0) if Predpath(PePx,PePy)=0 and preddis>=10 undim predpath(mapwidth,mapheight) dim predpath(mapwidth,mapheight) AStarPathFinder(mapwidth,mapheight,predx,predy,PePx,PePy,1) predpathon=2 endif predpath(predx,predy)=0 endif for i=predhistory to 1 step -1 oldpredx(i)=oldpredx(i-1) oldpredy(i)=oldpredy(i-1) next i oldpredx(0)=predx oldpredy(0)=predy if preyx=predx and preyy=predy then end oldtimer=timer() endif if viewmode=1 then gosub DisplayMap if viewmode=2 or viewmode=3 then gosub DisplayMapPath if viewmode=4 then gosub DisplayMapCPaths if viewmode=5 then gosub DisplayMapFlood if viewmode=6 then gosub DisplayMapPPath set text font "MS Gothic",1 set text size 12 ink 255,0 text 425,10,"Predator distance from prey: "+str$(preddis) text 425,318,"Hold spacebar to speed up" ink 0,0 text 425,88,"Press 'n' to see blank maze." text 425,100,"Press 'y' to see prey path." text 425,112,"Press 'd' to see predator path." text 425,124,"Press 'c' to see most common " text 435,136,"paths of map." text 425,148,"Press 'f' to see prey flood." text 435,160,"(Each cell's distance from" text 435,172,"the prey)" text 425,184,"Press 'p' to see prey's most" text 435,196,"likely paths." text 425,220,"Press 'e' to toggle prey's" text 435,232,"most likely end point." text 435,244,"(For predator to aim for)" text 425,256,"Press 'i' to toggle invisible" text 435,268,"wall (helps predator get prey)" text 425,280,"Press 'h' to toggle predator" text 435,292,"history (helps predator get prey)" if disinvwall=1 ink 0,0 for x=1 to mapwidth for y=1 to mapheight if invisiblewall(x,y)=1 then box x*10+3,y*10+3,x*10+8,y*10+8 next y next x endif if dishistory=1 ink rgb(250,150,150),0 for i=1 to predhistory circle oldpredx(i)*10+5,oldpredy(i)*10+5,4 next i endif if endpoint=1 ink 0,0 circle Pendpointx(0)*10+5,Pendpointy(0)*10+5,4 endif ink rgb(0,200,0),0 circle preyx*10+5,preyy*10+5,4 ink rgb(200,0,0),0 circle predx*10+5,predy*10+5,4 sync loop end GenerateMaze: cellx=rnd(mazewidth-1)+1 celly=rnd(mazeheight-1)+1 oldcellx=cellx oldcelly=celly Sstack=0 repeat cellstatus(cellx,celly)=2 if cellstatus(cellx,celly-1)=0 cellstatus(cellx,celly-1)=1 Sstack=Sstack+1 Sstackx(Sstack)=cellx Sstacky(Sstack)=celly-1 endif if cellstatus(cellx+1,celly)=0 cellstatus(cellx+1,celly)=1 Sstack=Sstack+1 Sstackx(Sstack)=cellx+1 Sstacky(Sstack)=celly endif if cellstatus(cellx,celly+1)=0 cellstatus(cellx,celly+1)=1 Sstack=Sstack+1 Sstackx(Sstack)=cellx Sstacky(Sstack)=celly+1 endif if cellstatus(cellx-1,celly)=0 cellstatus(cellx-1,celly)=1 Sstack=Sstack+1 Sstackx(Sstack)=cellx-1 Sstacky(Sstack)=celly endif sideactive=0 side1not=0 side2not=0 side3not=0 side4not=0 repeat side=rnd(3)+1 if side=1 if cellstatus(cellx,celly-1)=2 cellwall(cellx,celly,2)=0 sideactive=1 else side1not=1 endif endif if side=2 if cellstatus(cellx+1,celly)=2 cellwall(cellx+1,celly,1)=0 sideactive=1 else side2not=1 endif endif if side=3 if cellstatus(cellx,celly+1)=2 cellwall(cellx,celly+1,2)=0 sideactive=1 else side3not=1 endif endif if side=4 if cellstatus(cellx-1,celly)=2 cellwall(cellx,celly,1)=0 sideactive=1 else side4not=1 endif endif if side1not=1 and side2not=1 and side3not=1 and side4not=1 then allnot=1 else allnot=0 until sideactive=1 or allnot=1 sidestandby=0 side1not=0 side2not=0 side3not=0 side4not=0 repeat side=rnd(3)+1 if side=1 if cellstatus(cellx,celly-1)=1 cellstatus(cellx,celly-1)=2 cellx=cellx : celly=celly-1 for i=1 to Sstack if Sstackx(i)=cellx and Sstacky(i)=celly then Sstackx(i)=0 : Sstacky(i)=0 next i sidestandby=1 oldsidemove=1 else side1not=1 endif endif if side=2 if cellstatus(cellx+1,celly)=1 cellstatus(cellx+1,celly)=2 cellx=cellx+1 : celly=celly for i=1 to Sstack if Sstackx(i)=cellx and Sstacky(i)=celly then Sstackx(i)=0 : Sstacky(i)=0 next i sidestandby=1 oldsidemove=2 else side2not=1 endif endif if side=3 if cellstatus(cellx,celly+1)=1 cellstatus(cellx,celly+1)=2 cellx=cellx : celly=celly+1 for i=1 to Sstack if Sstackx(i)=cellx and Sstacky(i)=celly then Sstackx(i)=0 : Sstacky(i)=0 next i sidestandby=1 oldsidemove=3 else side3not=1 endif endif if side=4 if cellstatus(cellx-1,celly)=1 cellstatus(cellx-1,celly)=2 cellx=cellx-1 : celly=celly for i=1 to Sstack if Sstackx(i)=cellx and Sstacky(i)=celly then Sstackx(i)=0 : Sstacky(i)=0 next i sidestandby=1 oldsidemove=4 else side4not=1 endif endif if side1not=1 and side2not=1 and side3not=1 and side4not=1 then allnot=1 : oldsidemove=0 else allnot=0 until sidestandby=1 or allnot=1 if allnot=1 if Sstackx(Sstack)=0 and Sstacky(Sstack)=0 for i=Sstack to 0 step -1 if Sstackx(i)>0 and Sstacky(i)>0 cellx=Sstackx(i) celly=Sstacky(i) for i=1 to Sstack if Sstackx(i)=cellx and Sstacky(i)=celly then Sstackx(i)=0 : Sstacky(i)=0 next i Sstackx(i)=0 Sstacky(i)=0 exit endif next i if i<1 then alldone=1 Sstack=i-1 else cellx=Sstackx(Sstack) celly=Sstacky(Sstack) for i=1 to Sstack if Sstackx(i)=cellx and Sstacky(i)=celly then Sstackx(i)=0 : Sstacky(i)=0 next i endif endif until alldone=1 for i=1 to 50 cellwall(rnd(mazewidth-2)+2,rnd(mazewidth-2)+2,rnd(1)+1)=0 next i return FindCommonPaths: ink rgb(255,255,0),0 box 1,1,3,3 sync for x=1 to mapwidth for y=1 to mapheight PathCom(x,y)=1 next y next x sync rate 0 for i=1 to 100 startx=(rnd(mazewidth-2)+1)*2 starty=(rnd(mazeheight-2)+1)*2 endx=(rnd(mazewidth-2)+1)*2 endy=(rnd(mazeheight-2)+1)*2 AStarPathFinderCP(mapwidth,mapheight,startx,starty,endx,endy) next i return DisplayMap: cls rgb(255,255,255) ink 0,0 for x=1 to mapwidth for y=1 to mapheight if map(x,y)=1 then box x*10+1,y*10+1,x*10+10,y*10+10 next y next x return DisplayMapPath: cls rgb(255,255,255) ink 0,0 for x=1 to mapwidth for y=1 to mapheight ink rgb(255,255,255),0 if map(x,y)=1 then ink 0,0 if viewmode=2 if preypath(x,y)=1 then ink rgb(155,0,255),0 else if predpath(x,y)=1 then ink rgb(155,0,255),0 endif box x*10+1,y*10+1,x*10+10,y*10+10 next y next x return DisplayMapCPaths: cls rgb(255,255,255) ink 0,0 for x=1 to mapwidth for y=1 to mapheight if map(x,y)=1 ink 0,0 else status=pathCom(x,y)*10 if status>1275 repeat status=status-1275 until status<=1275 endif if status<255 r=255 g=255-status b=255-status endif if status>=255 and status<510 r=255 g=status-255 b=0 endif if status>=510 and status<765 r=255-(status-510) g=255 b=0 endif if status>=765 and status<1020 r=0 g=255 b=status-765 endif if status>=1020 r=0 g=255-(status-1020) b=255 endif ink rgb(r,g,b),0 endif box x*10+1,y*10+1,x*10+10,y*10+10 next y next x return DisplayMapFlood: cls rgb(255,255,255) set text font "Courier New",1 set text size 10 ink 0,0 for x=1 to mapwidth for y=1 to mapheight if map(x,y)=1 ink 0,0 else flood=Flooddata(x,y)*5 if flood>1275 repeat flood=flood-1275 until flood<=1275 endif if flood<255 r=255 g=255-flood b=255-flood endif if flood>=255 and flood<510 r=255 g=flood-255 b=0 endif if flood>=510 and flood<765 r=255-(flood-510) g=255 b=0 endif if flood>=765 and flood<1020 r=0 g=255 b=flood-765 endif if flood>=1020 r=0 g=255-(flood-1020) b=255 endif ink rgb(r,g,b),0 endif box x*10+1,y*10+1,x*10+10,y*10+10 next y next x return DisplayMapFloodtext: cls rgb(255,255,255) set text font "Courier New",1 set text size 10 ink 0,0 for x=1 to mapwidth for y=1 to mapheight if map(x,y)=1 then box x*10+1,y*10+1,x*10+10,y*10+10 text x*10,y*10,str$(flooddata(x,y)) next y next x return DisplayMapPPath: ink 0,0 for x=1 to mapwidth for y=1 to mapheight if map(x,y)=1 ink 0,0 else PPath=ProbablePath#(x,y)*50 if PPath>1275 repeat PPath=PPath-1275 until PPath<=1275 endif if PPath<255 r=255 g=255-PPath b=255-PPath endif if PPath>=255 and PPath<510 r=255 g=PPath-255 b=0 endif if PPath>=510 and PPath<765 r=255-(PPath-510) g=255 b=0 endif if PPath>=765 and PPath<1020 r=0 g=255 b=PPath-765 endif if PPath>=1020 r=0 g=255-(PPath-1020) b=255 endif ink rgb(r,g,b),0 endif box x*10+1,y*10+1,x*10+10,y*10+10 next y next x return end function saferandomize() dim notsafe(20) notsafe(2)=1 notsafe(4)=1 notsafe(5)=1 notsafe(6)=1 notsafe(17)=1 repeat randomize timer() seed=rnd(20) until notsafe(seed)=0 randomize seed undim notsafe(20) endfunction function convertmazetomap(mazewidth,mazeheight) mapwidth=mazewidth*2+1 mapheight=mazeheight*2+1 for x=1 to mazewidth+1 for y=1 to mazeheight+1 mapx=x*2-1 mapy=y*2-1 if cellwall(x,y,1)=1 or cellwall(x,y,2)=1 then map(mapx,mapy)=1 if cellwall(x,y,1)=1 then map(mapx,mapy+1)=1 : map(mapx,mapy+2)=1 if cellwall(x,y,2)=1 then map(mapx+1,mapy)=1 : map(mapx+2,mapy)=1 next y next x endfunction Function AStarPathFinder(mapwidth,mapheight,startx,starty,endx,endy,predprey) if startx=endx and starty=endy if predprey=1 Predpath(startx,starty)=1 Predpathx(1)=startx Predpathy(1)=starty Predpathl(0)=1 else Preypath(startx,starty)=1 Preypathx(1)=startx Preypathy(1)=starty Preypathl(0)=1 endif else dim NodeOC(mapwidth,mapheight) dim Nodestack(mapwidth,mapheight) dim Openlistx(mapwidth*mapheight) dim Openlisty(mapwidth*mapheight) dim Oparentx(mapwidth*mapheight) dim Oparenty(mapwidth*mapheight) dim ONodeG(mapwidth*mapheight) dim ONodeH(mapwidth*mapheight) dim ONodeF(mapwidth*mapheight) dim Cparentx(mapwidth*mapheight) dim Cparenty(mapwidth*mapheight) dim CNodeG(mapwidth*mapheight) dim CNodeH(mapwidth*mapheight) dim CNodeF(mapwidth*mapheight) dim Closelistx(mapwidth*mapheight) dim Closelisty(mapwidth*mapheight) Opens=0 Closed=0 Opens=Opens+1 NodeOC(startx,starty)=1 NodeStack(startx,starty)=Opens Openlistx(Opens)=startx Openlisty(Opens)=starty ONodeG(Opens)=0 ONodeH(Opens)=sqrt((startx-endx)^2+abs(starty-endy)^2)*10 ONodeF(Opens)=ONodeG(Opens)+ONodeH(Opens) OParentx(Opens)=0 OParenty(Opens)=0 NoPath=0 endfound=0 endloop=0 Node=1 Nodex=startx Nodey=starty repeat Closed=Closed+1 NodeOC(nodex,nodey)=2 NodeStack(nodex,nodey)=Closed Closelistx(Closed)=nodex Closelisty(Closed)=nodey CNodeG(Closed)=ONodeG(Node) CNodeH(Closed)=ONodeH(Node) CNodeF(Closed)=ONodeF(Node) CParentx(Closed)=OParentx(Node) CParenty(Closed)=OParenty(Node) ONodeG(Node)=-1 ONodeH(Node)=-1 ONodeF(Node)=-1 OParentx(Node)=-1 OParenty(Node)=-1 if nodex=endx and nodey=endy then endfound=1 x=nodex : y=nodey-1 if Map(x,y)=0 if NodeOC(x,y)=0 NodeOC(x,y)=1 Opens=Opens+1 NodeStack(x,y)=Opens Openlistx(Opens)=x Openlisty(Opens)=y ONodeG(Opens)=10+CNodeG(closed) ONodeH(Opens)=sqrt((x-endx)^2+abs(y-endy)^2)*10 ONodeF(Opens)=ONodeG(Opens)+ONodeH(Opens) OParentx(Opens)=nodex OParenty(Opens)=nodey else if NodeOC(x,y)=1 Stack=NodeStack(x,y) if CNodeG(Closed)+10<ONodeG(Stack) ONodeG(Stack)=CNodeG(Closed)+10 ONodeF(Stack)=ONodeG(Stack)+ONodeH(Stack) OParentx(Stack)=nodex OParenty(Stack)=nodey endif endif endif endif x=nodex+1 : y=nodey-1 if Map(x,y)=0 and Map(nodex+1,nodey)=0 and Map(nodex,nodey-1)=0 if NodeOC(x,y)=0 NodeOC(x,y)=1 Opens=Opens+1 NodeStack(x,y)=Opens Openlistx(Opens)=x Openlisty(Opens)=y ONodeG(Opens)=14+CNodeG(closed) ONodeH(Opens)=sqrt((x-endx)^2+abs(y-endy)^2)*10 ONodeF(Opens)=ONodeG(Opens)+ONodeH(Opens) OParentx(Opens)=nodex OParenty(Opens)=nodey else if NodeOC(x,y)=1 Stack=NodeStack(x,y) if CNodeG(Closed)+14<ONodeG(Stack) ONodeG(Stack)=CNodeG(Closed)+14 ONodeF(Stack)=ONodeG(Stack)+ONodeH(Stack) OParentx(Stack)=nodex OParenty(Stack)=nodey endif endif endif endif x=nodex+1 : y=nodey if Map(x,y)=0 if NodeOC(x,y)=0 NodeOC(x,y)=1 Opens=Opens+1 NodeStack(x,y)=Opens Openlistx(Opens)=x Openlisty(Opens)=y ONodeG(Opens)=10+CNodeG(closed) ONodeH(Opens)=sqrt((x-endx)^2+abs(y-endy)^2)*10 ONodeF(Opens)=ONodeG(Opens)+ONodeH(Opens) OParentx(Opens)=nodex OParenty(Opens)=nodey else if NodeOC(x,y)=1 Stack=NodeStack(x,y) if CNodeG(Closed)+10<ONodeG(Stack) ONodeG(Stack)=CNodeG(Closed)+10 ONodeF(Stack)=ONodeG(Stack)+ONodeH(Stack) OParentx(Stack)=nodex OParenty(Stack)=nodey endif endif endif endif x=nodex+1 : y=nodey+1 if Map(x,y)=0 and Map(nodex+1,nodey)=0 and Map(nodex,nodey+1)=0 if NodeOC(x,y)=0 NodeOC(x,y)=1 Opens=Opens+1 NodeStack(x,y)=Opens Openlistx(Opens)=x Openlisty(Opens)=y ONodeG(Opens)=14+CNodeG(closed) ONodeH(Opens)=sqrt((x-endx)^2+abs(y-endy)^2)*10 ONodeF(Opens)=ONodeG(Opens)+ONodeH(Opens) OParentx(Opens)=nodex OParenty(Opens)=nodey else if NodeOC(x,y)=1 Stack=NodeStack(x,y) if CNodeG(Closed)+14<ONodeG(Stack) ONodeG(Stack)=CNodeG(Closed)+14 ONodeF(Stack)=ONodeG(Stack)+ONodeH(Stack) OParentx(Stack)=nodex OParenty(Stack)=nodey endif endif endif endif x=nodex : y=nodey+1 if Map(x,y)=0 if NodeOC(x,y)=0 NodeOC(x,y)=1 Opens=Opens+1 NodeStack(x,y)=Opens Openlistx(Opens)=x Openlisty(Opens)=y ONodeG(Opens)=10+CNodeG(closed) ONodeH(Opens)=sqrt((x-endx)^2+abs(y-endy)^2)*10 ONodeF(Opens)=ONodeG(Opens)+ONodeH(Opens) OParentx(Opens)=nodex OParenty(Opens)=nodey else if NodeOC(x,y)=1 Stack=NodeStack(x,y) if CNodeG(Closed)+10<ONodeG(Stack) ONodeG(Stack)=CNodeG(Closed)+10 ONodeF(Stack)=ONodeG(Stack)+ONodeH(Stack) OParentx(Stack)=nodex OParenty(Stack)=nodey endif endif endif endif x=nodex-1 : y=nodey+1 if Map(x,y)=0 and Map(nodex-1,nodey)=0 and Map(nodex,nodey+1)=0 if NodeOC(x,y)=0 NodeOC(x,y)=1 Opens=Opens+1 NodeStack(x,y)=Opens Openlistx(Opens)=x Openlisty(Opens)=y ONodeG(Opens)=14+CNodeG(closed) ONodeH(Opens)=sqrt((x-endx)^2+abs(y-endy)^2)*10 ONodeF(Opens)=ONodeG(Opens)+ONodeH(Opens) OParentx(Opens)=nodex OParenty(Opens)=nodey else if NodeOC(x,y)=1 Stack=NodeStack(x,y) if CNodeG(Closed)+14<ONodeG(Stack) ONodeG(Stack)=CNodeG(Closed)+14 ONodeF(Stack)=ONodeG(Stack)+ONodeH(Stack) OParentx(Stack)=nodex OParenty(Stack)=nodey endif endif endif endif x=nodex-1 : y=nodey if Map(x,y)=0 if NodeOC(x,y)=0 NodeOC(x,y)=1 Opens=Opens+1 NodeStack(x,y)=Opens Openlistx(Opens)=x Openlisty(Opens)=y ONodeG(Opens)=10+CNodeG(closed) ONodeH(Opens)=sqrt((x-endx)^2+abs(y-endy)^2)*10 ONodeF(Opens)=ONodeG(Opens)+ONodeH(Opens) OParentx(Opens)=nodex OParenty(Opens)=nodey else if NodeOC(x,y)=1 Stack=NodeStack(x,y) if CNodeG(Closed)+10<ONodeG(Stack) ONodeG(Stack)=CNodeG(Closed)+10 ONodeF(Stack)=ONodeG(Stack)+ONodeH(Stack) OParentx(Stack)=nodex OParenty(Stack)=nodey endif endif endif endif x=nodex-1 : y=nodey-1 if Map(x,y)=0 and Map(nodex-1,nodey)=0 and Map(nodex,nodey-1)=0 if NodeOC(x,y)=0 NodeOC(x,y)=1 Opens=Opens+1 NodeStack(x,y)=Opens Openlistx(Opens)=x Openlisty(Opens)=y ONodeG(Opens)=14+CNodeG(closed) ONodeH(Opens)=sqrt((x-endx)^2+abs(y-endy)^2)*10 ONodeF(Opens)=ONodeG(Opens)+ONodeH(Opens) OParentx(Opens)=nodex OParenty(Opens)=nodey else if NodeOC(x,y)=1 Stack=NodeStack(x,y) if CNodeG(Closed)+14<ONodeG(Stack) ONodeG(Stack)=CNodeG(Closed)+14 ONodeF(Stack)=ONodeG(Stack)+ONodeH(Stack) OParentx(Stack)=nodex OParenty(Stack)=nodey endif endif endif endif cOpen=0 cF=1000000 for i=1 to Opens if ONodeF(i)>-1 if ONodeF(i)<cF cOpen=i cF=ONodeF(i) endif endif next i Node=cOpen Nodex=Openlistx(Node) Nodey=Openlisty(Node) if Node=0 and endfound=0 then noPath=1 until NoPath=1 or endfound=1 if NoPath=0 nodex=endx nodey=endy Stack=NodeStack(nodex,nodey) nodex=CParentx(Stack) nodey=CParenty(Stack) pathon=1 repeat pathon=pathon+1 Stack=NodeStack(nodex,nodey) nodex=CParentx(Stack) nodey=CParenty(Stack) until nodex=startx and nodey=starty nodex=endx nodey=endy Stack=NodeStack(nodex,nodey) nodex=CParentx(Stack) nodey=CParenty(Stack) pathon=pathon+1 if predprey=1 Predpath(endx,endy)=1 Predpathx(pathon)=endx Predpathy(pathon)=endy Predpathl(0)=pathon else Preypath(endx,endy)=1 Preypathx(pathon)=endx Preypathy(pathon)=endy Preypathl(0)=pathon endif repeat pathon=pathon-1 if predprey=1 Predpath(nodex,nodey)=1 Predpathx(pathon)=nodex Predpathy(pathon)=nodey else Preypath(nodex,nodey)=1 Preypathx(pathon)=nodex Preypathy(pathon)=nodey endif Stack=NodeStack(nodex,nodey) nodex=CParentx(Stack) nodey=CParenty(Stack) until nodex=startx and nodey=starty pathon=pathon-1 if pathon<>1 then end if predprey=1 Predpath(startx,starty)=1 Predpathx(pathon)=startx Predpathy(pathon)=starty else Preypath(startx,starty)=1 Preypathx(pathon)=startx Preypathy(pathon)=starty endif else cls Print "No Path!!!!!" suspend for key endif undim NodeOC(mapwidth,mapheight) undim Nodestack(mapwidth,mapheight) undim Openlistx(mapwidth*mapheight) undim Openlisty(mapwidth*mapheight) undim Oparentx(mapwidth*mapheight) undim Oparenty(mapwidth*mapheight) undim ONodeG(mapwidth*mapheight) undim ONodeH(mapwidth*mapheight) undim ONodeF(mapwidth*mapheight) undim Cparentx(mapwidth*mapheight) undim Cparenty(mapwidth*mapheight) undim CNodeG(mapwidth*mapheight) undim CNodeH(mapwidth*mapheight) undim CNodeF(mapwidth*mapheight) undim Closelistx(mapwidth*mapheight) undim Closelisty(mapwidth*mapheight) endif endfunction Function AStarPathFinderCP(mapwidth,mapheight,startx,starty,endx,endy) if startx=endx and starty=endy pathcom(startx,starty)=pathcom(startx,starty)+1 else dim NodeOC(mapwidth,mapheight) dim Nodestack(mapwidth,mapheight) dim Openlistx(mapwidth*mapheight) dim Openlisty(mapwidth*mapheight) dim Oparentx(mapwidth*mapheight) dim Oparenty(mapwidth*mapheight) dim ONodeG(mapwidth*mapheight) dim ONodeH(mapwidth*mapheight) dim ONodeF(mapwidth*mapheight) dim Cparentx(mapwidth*mapheight) dim Cparenty(mapwidth*mapheight) dim CNodeG(mapwidth*mapheight) dim CNodeH(mapwidth*mapheight) dim CNodeF(mapwidth*mapheight) dim Closelistx(mapwidth*mapheight) dim Closelisty(mapwidth*mapheight) Opens=0 Closed=0 Opens=Opens+1 NodeOC(startx,starty)=1 NodeStack(startx,starty)=Opens Openlistx(Opens)=startx Openlisty(Opens)=starty ONodeG(Opens)=0 ONodeH(Opens)=sqrt((startx-endx)^2+abs(starty-endy)^2)*10 ONodeF(Opens)=ONodeG(Opens)+ONodeH(Opens) OParentx(Opens)=0 OParenty(Opens)=0 NoPath=0 endfound=0 endloop=0 Node=1 Nodex=startx Nodey=starty repeat Closed=Closed+1 NodeOC(nodex,nodey)=2 NodeStack(nodex,nodey)=Closed Closelistx(Closed)=nodex Closelisty(Closed)=nodey CNodeG(Closed)=ONodeG(Node) CNodeH(Closed)=ONodeH(Node) CNodeF(Closed)=ONodeF(Node) CParentx(Closed)=OParentx(Node) CParenty(Closed)=OParenty(Node) ONodeG(Node)=-1 ONodeH(Node)=-1 ONodeF(Node)=-1 OParentx(Node)=-1 OParenty(Node)=-1 if nodex=endx and nodey=endy then endfound=1 x=nodex : y=nodey-1 if Map(x,y)=0 if NodeOC(x,y)=0 NodeOC(x,y)=1 Opens=Opens+1 NodeStack(x,y)=Opens Openlistx(Opens)=x Openlisty(Opens)=y ONodeG(Opens)=10+CNodeG(closed) ONodeH(Opens)=sqrt((x-endx)^2+abs(y-endy)^2)*10 ONodeF(Opens)=ONodeG(Opens)+ONodeH(Opens) OParentx(Opens)=nodex OParenty(Opens)=nodey else if NodeOC(x,y)=1 Stack=NodeStack(x,y) if CNodeG(Closed)+10<ONodeG(Stack) ONodeG(Stack)=CNodeG(Closed)+10 ONodeF(Stack)=ONodeG(Stack)+ONodeH(Stack) OParentx(Stack)=nodex OParenty(Stack)=nodey endif endif endif endif x=nodex+1 : y=nodey-1 if Map(x,y)=0 and Map(nodex+1,nodey)=0 and Map(nodex,nodey-1)=0 if NodeOC(x,y)=0 NodeOC(x,y)=1 Opens=Opens+1 NodeStack(x,y)=Opens Openlistx(Opens)=x Openlisty(Opens)=y ONodeG(Opens)=14+CNodeG(closed) ONodeH(Opens)=sqrt((x-endx)^2+abs(y-endy)^2)*10 ONodeF(Opens)=ONodeG(Opens)+ONodeH(Opens) OParentx(Opens)=nodex OParenty(Opens)=nodey else if NodeOC(x,y)=1 Stack=NodeStack(x,y) if CNodeG(Closed)+14<ONodeG(Stack) ONodeG(Stack)=CNodeG(Closed)+14 ONodeF(Stack)=ONodeG(Stack)+ONodeH(Stack) OParentx(Stack)=nodex OParenty(Stack)=nodey endif endif endif endif x=nodex+1 : y=nodey if Map(x,y)=0 if NodeOC(x,y)=0 NodeOC(x,y)=1 Opens=Opens+1 NodeStack(x,y)=Opens Openlistx(Opens)=x Openlisty(Opens)=y ONodeG(Opens)=10+CNodeG(closed) ONodeH(Opens)=sqrt((x-endx)^2+abs(y-endy)^2)*10 ONodeF(Opens)=ONodeG(Opens)+ONodeH(Opens) OParentx(Opens)=nodex OParenty(Opens)=nodey else if NodeOC(x,y)=1 Stack=NodeStack(x,y) if CNodeG(Closed)+10<ONodeG(Stack) ONodeG(Stack)=CNodeG(Closed)+10 ONodeF(Stack)=ONodeG(Stack)+ONodeH(Stack) OParentx(Stack)=nodex OParenty(Stack)=nodey endif endif endif endif x=nodex+1 : y=nodey+1 if Map(x,y)=0 and Map(nodex+1,nodey)=0 and Map(nodex,nodey+1)=0 if NodeOC(x,y)=0 NodeOC(x,y)=1 Opens=Opens+1 NodeStack(x,y)=Opens Openlistx(Opens)=x Openlisty(Opens)=y ONodeG(Opens)=14+CNodeG(closed) ONodeH(Opens)=sqrt((x-endx)^2+abs(y-endy)^2)*10 ONodeF(Opens)=ONodeG(Opens)+ONodeH(Opens) OParentx(Opens)=nodex OParenty(Opens)=nodey else if NodeOC(x,y)=1 Stack=NodeStack(x,y) if CNodeG(Closed)+14<ONodeG(Stack) ONodeG(Stack)=CNodeG(Closed)+14 ONodeF(Stack)=ONodeG(Stack)+ONodeH(Stack) OParentx(Stack)=nodex OParenty(Stack)=nodey endif endif endif endif x=nodex : y=nodey+1 if Map(x,y)=0 if NodeOC(x,y)=0 NodeOC(x,y)=1 Opens=Opens+1 NodeStack(x,y)=Opens Openlistx(Opens)=x Openlisty(Opens)=y ONodeG(Opens)=10+CNodeG(closed) ONodeH(Opens)=sqrt((x-endx)^2+abs(y-endy)^2)*10 ONodeF(Opens)=ONodeG(Opens)+ONodeH(Opens) OParentx(Opens)=nodex OParenty(Opens)=nodey else if NodeOC(x,y)=1 Stack=NodeStack(x,y) if CNodeG(Closed)+10<ONodeG(Stack) ONodeG(Stack)=CNodeG(Closed)+10 ONodeF(Stack)=ONodeG(Stack)+ONodeH(Stack) OParentx(Stack)=nodex OParenty(Stack)=nodey endif endif endif endif x=nodex-1 : y=nodey+1 if Map(x,y)=0 and Map(nodex-1,nodey)=0 and Map(nodex,nodey+1)=0 if NodeOC(x,y)=0 NodeOC(x,y)=1 Opens=Opens+1 NodeStack(x,y)=Opens Openlistx(Opens)=x Openlisty(Opens)=y ONodeG(Opens)=14+CNodeG(closed) ONodeH(Opens)=sqrt((x-endx)^2+abs(y-endy)^2)*10 ONodeF(Opens)=ONodeG(Opens)+ONodeH(Opens) OParentx(Opens)=nodex OParenty(Opens)=nodey else if NodeOC(x,y)=1 Stack=NodeStack(x,y) if CNodeG(Closed)+14<ONodeG(Stack) ONodeG(Stack)=CNodeG(Closed)+14 ONodeF(Stack)=ONodeG(Stack)+ONodeH(Stack) OParentx(Stack)=nodex OParenty(Stack)=nodey endif endif endif endif x=nodex-1 : y=nodey if Map(x,y)=0 if NodeOC(x,y)=0 NodeOC(x,y)=1 Opens=Opens+1 NodeStack(x,y)=Opens Openlistx(Opens)=x Openlisty(Opens)=y ONodeG(Opens)=10+CNodeG(closed) ONodeH(Opens)=sqrt((x-endx)^2+abs(y-endy)^2)*10 ONodeF(Opens)=ONodeG(Opens)+ONodeH(Opens) OParentx(Opens)=nodex OParenty(Opens)=nodey else if NodeOC(x,y)=1 Stack=NodeStack(x,y) if CNodeG(Closed)+10<ONodeG(Stack) ONodeG(Stack)=CNodeG(Closed)+10 ONodeF(Stack)=ONodeG(Stack)+ONodeH(Stack) OParentx(Stack)=nodex OParenty(Stack)=nodey endif endif endif endif x=nodex-1 : y=nodey-1 if Map(x,y)=0 and Map(nodex-1,nodey)=0 and Map(nodex,nodey-1)=0 if NodeOC(x,y)=0 NodeOC(x,y)=1 Opens=Opens+1 NodeStack(x,y)=Opens Openlistx(Opens)=x Openlisty(Opens)=y ONodeG(Opens)=14+CNodeG(closed) ONodeH(Opens)=sqrt((x-endx)^2+abs(y-endy)^2)*10 ONodeF(Opens)=ONodeG(Opens)+ONodeH(Opens) OParentx(Opens)=nodex OParenty(Opens)=nodey else if NodeOC(x,y)=1 Stack=NodeStack(x,y) if CNodeG(Closed)+14<ONodeG(Stack) ONodeG(Stack)=CNodeG(Closed)+14 ONodeF(Stack)=ONodeG(Stack)+ONodeH(Stack) OParentx(Stack)=nodex OParenty(Stack)=nodey endif endif endif endif cOpen=0 cF=1000000 for i=1 to Opens if ONodeF(i)>-1 if ONodeF(i)<cF cOpen=i cF=ONodeF(i) endif endif next i Node=cOpen Nodex=Openlistx(Node) Nodey=Openlisty(Node) if Node=0 and endfound=0 then noPath=1 until NoPath=1 or endfound=1 if NoPath=0 nodex=endx nodey=endy Stack=NodeStack(nodex,nodey) nodex=CParentx(Stack) nodey=CParenty(Stack) repeat pathcom(nodex,nodey)=pathcom(nodex,nodey)+1 Stack=NodeStack(nodex,nodey) nodex=CParentx(Stack) nodey=CParenty(Stack) until nodex=startx and nodey=starty pathcom(startx,starty)=pathcom(startx,starty)+1 pathcom(endx,endy)=pathcom(endx,endy)+1 else cls 0 ink 255,0 Print "No Path!!!!!" sync suspend for key endif undim NodeOC(mapwidth,mapheight) undim Nodestack(mapwidth,mapheight) undim Openlistx(mapwidth*mapheight) undim Openlisty(mapwidth*mapheight) undim Oparentx(mapwidth*mapheight) undim Oparenty(mapwidth*mapheight) undim ONodeG(mapwidth*mapheight) undim ONodeH(mapwidth*mapheight) undim ONodeF(mapwidth*mapheight) undim Cparentx(mapwidth*mapheight) undim Cparenty(mapwidth*mapheight) undim CNodeG(mapwidth*mapheight) undim CNodeH(mapwidth*mapheight) undim CNodeF(mapwidth*mapheight) undim Closelistx(mapwidth*mapheight) undim Closelisty(mapwidth*mapheight) endif endfunction function fillfloodarray(sourcex,sourcey,predx,predy,direction,mapwidth,mapheight,predhistory) if direction=1 then map(sourcex,sourcey+1)=1 if direction=2 then map(sourcex-1,sourcey)=1 if direction=3 then map(sourcex,sourcey-1)=1 if direction=4 then map(sourcex+1,sourcey)=1 map(predx,predy)=1 for i=0 to predhistory opx=oldpredx(i) opy=oldpredy(i) map(opx,opy)=1 next i Highestflood(0)=0 dim stackx(mapwidth*mapheight) dim stacky(mapwidth*mapheight) dim stackS(mapwidth*mapheight) stack=1 flooddata(sourcex,sourcey)=1 stackx(stack)=sourcex stacky(stack)=sourcey mapfilled=0 while mapfilled=0 StackSs=0 for i=1 to stack if stackS(i)=0 sx=stackx(i) sy=stacky(i) if flooddata(sx,sy)>Highestflood(0) then Highestflood(0)=flooddata(sx,sy) up=0 : right=0 : down=0 : left=0 x=sx : y=sy-1 if map(x,y)=0 and flooddata(x,y)=0 and invisiblewall(x,y)=0 : rem up flooddata(x,y)=flooddata(sx,sy)+1 stack=stack+1 Stackx(stack)=x Stacky(stack)=y else up=1 endif x=sx+1 : y=sy if map(x,y)=0 and flooddata(x,y)=0 and invisiblewall(x,y)=0 : rem right flooddata(x,y)=flooddata(sx,sy)+1 stack=stack+1 Stackx(stack)=x Stacky(stack)=y else right=1 endif x=sx : y=sy+1 if map(x,y)=0 and flooddata(x,y)=0 and invisiblewall(x,y)=0 : rem down flooddata(x,y)=flooddata(sx,sy)+1 stack=stack+1 Stackx(stack)=x Stacky(stack)=y else down=1 endif x=sx-1 : y=sy if map(x,y)=0 and flooddata(x,y)=0 and invisiblewall(x,y)=0 : rem left flooddata(x,y)=flooddata(sx,sy)+1 stack=stack+1 Stackx(stack)=x Stacky(stack)=y else left=1 endif if up=1 and right=1 and down=1 and left=1 StackS(i)=1 endif else StackSs=StackSs+1 endif next i if StackSs>=stack then mapfilled=1 endwhile undim stackx(mapwidth*mapheight) undim stacky(mapwidth*mapheight) undim stackS(mapwidth*mapheight) rem start if direction=1 then map(sourcex,sourcey+1)=0 if direction=2 then map(sourcex-1,sourcey)=0 if direction=3 then map(sourcex,sourcey-1)=0 if direction=4 then map(sourcex+1,sourcey)=0 remend map(predx,predy)=0 for i=0 to predhistory opx=oldpredx(i) opy=oldpredy(i) map(opx,opy)=0 next i endfunction function fillfloodarraypred(sourcex,sourcey,mapwidth,mapheight) Highestfloodpred(0)=0 dim stackx(mapwidth*mapheight) dim stacky(mapwidth*mapheight) dim stackS(mapwidth*mapheight) stack=1 flooddatapred(sourcex,sourcey)=1 stackx(stack)=sourcex stacky(stack)=sourcey mapfilled=0 count=0 while mapfilled=0 StackSs=0 for i=1 to stack if stackS(i)=0 sx=stackx(i) sy=stacky(i) if flooddatapred(sx,sy)>Highestfloodpred(0) then Highestfloodpred(0)=flooddatapred(sx,sy) up=0 : right=0 : down=0 : left=0 x=sx : y=sy-1 if map(x,y)=0 and flooddatapred(x,y)=0 : rem up flooddatapred(x,y)=flooddatapred(sx,sy)+1 stack=stack+1 Stackx(stack)=x Stacky(stack)=y else up=1 endif x=sx+1 : y=sy if map(x,y)=0 and flooddatapred(x,y)=0 : rem right flooddatapred(x,y)=flooddatapred(sx,sy)+1 stack=stack+1 Stackx(stack)=x Stacky(stack)=y else right=1 endif x=sx : y=sy+1 if map(x,y)=0 and flooddatapred(x,y)=0 : rem down flooddatapred(x,y)=flooddatapred(sx,sy)+1 stack=stack+1 Stackx(stack)=x Stacky(stack)=y else down=1 endif x=sx-1 : y=sy if map(x,y)=0 and flooddatapred(x,y)=0 : rem left flooddatapred(x,y)=flooddatapred(sx,sy)+1 stack=stack+1 Stackx(stack)=x Stacky(stack)=y else left=1 endif if up=1 and right=1 and down=1 and left=1 StackS(i)=1 endif else StackSs=StackSs+1 endif next i if StackSs>=stack then mapfilled=1 endwhile undim stackx(mapwidth*mapheight) undim stacky(mapwidth*mapheight) undim stackS(mapwidth*mapheight) endfunction function intrap(preyx,preyy,predx,predy,mapwidth,mapheight) dim flooddatatrap(mapwidth,mapheight) dim stackx(mapwidth*mapheight) dim stacky(mapwidth*mapheight) dim stackS(mapwidth*mapheight) dim stackV(mapwidth*mapheight) stack=1 flooddatatrap(predx,predy)=1 stackx(stack)=predx stacky(stack)=predy highestvaluble=0 mapfilled=0 while mapfilled=0 StackSs=0 for i=1 to stack if stackS(i)=0 sx=stackx(i) sy=stacky(i) if sx=preyx and sy=preyy then StackV(i)=1 valuble=StackV(i) if valuble=1 and flooddatatrap(sx,sy)>highestvaluble then highestvaluble=flooddatatrap(sx,sy) up=0 : right=0 : down=0 : left=0 x=sx : y=sy-1 if map(x,y)=0 and flooddatatrap(x,y)=0 : rem up flooddatatrap(x,y)=flooddatatrap(sx,sy)+1 stack=stack+1 Stackx(stack)=x Stacky(stack)=y StackV(stack)=Valuble else up=1 endif x=sx+1 : y=sy if map(x,y)=0 and flooddatatrap(x,y)=0 : rem right flooddatatrap(x,y)=flooddatatrap(sx,sy)+1 stack=stack+1 Stackx(stack)=x Stacky(stack)=y StackV(stack)=Valuble else right=1 endif x=sx : y=sy+1 if map(x,y)=0 and flooddatatrap(x,y)=0 : rem down flooddatatrap(x,y)=flooddatatrap(sx,sy)+1 stack=stack+1 Stackx(stack)=x Stacky(stack)=y StackV(stack)=Valuble else down=1 endif x=sx-1 : y=sy if map(x,y)=0 and flooddatatrap(x,y)=0 : rem left flooddatatrap(x,y)=flooddatatrap(sx,sy)+1 stack=stack+1 Stackx(stack)=x Stacky(stack)=y StackV(stack)=Valuble else left=1 endif if up=1 and right=1 and down=1 and left=1 StackS(i)=1 endif else StackSs=StackSs+1 endif next i if StackSs>=stack then mapfilled=1 endwhile if highestvaluble-flooddatatrap(preyx,preyy)<=5 then intrap=1 else intrap=0 undim stackx(mapwidth*mapheight) undim stacky(mapwidth*mapheight) undim stackS(mapwidth*mapheight) undim stackV(mapwidth*mapheight) undim flooddatatrap(mapwidth,mapheight) endfunction intrap function Randdestination(preyx,preyy,predx,predy,mapwidth,mapheight) map(predx,predy)=1 dim flooddatadest(mapwidth,mapheight) dim stackx(mapwidth*mapheight) dim stacky(mapwidth*mapheight) dim stackS(mapwidth*mapheight) stack=1 flooddatadest(preyx,preyy)=1 stackx(stack)=preyx stacky(stack)=preyy mapfilled=0 while mapfilled=0 StackSs=0 for i=1 to stack if stackS(i)=0 sx=stackx(i) sy=stacky(i) up=0 : right=0 : down=0 : left=0 x=sx : y=sy-1 if map(x,y)=0 and flooddatadest(x,y)=0 : rem up flooddatadest(x,y)=flooddatadest(sx,sy)+1 stack=stack+1 Stackx(stack)=x Stacky(stack)=y else up=1 endif x=sx+1 : y=sy if map(x,y)=0 and flooddatadest(x,y)=0 : rem right flooddatadest(x,y)=flooddatadest(sx,sy)+1 stack=stack+1 Stackx(stack)=x Stacky(stack)=y else right=1 endif x=sx : y=sy+1 if map(x,y)=0 and flooddatadest(x,y)=0 : rem down flooddatadest(x,y)=flooddatadest(sx,sy)+1 stack=stack+1 Stackx(stack)=x Stacky(stack)=y else down=1 endif x=sx-1 : y=sy if map(x,y)=0 and flooddatadest(x,y)=0 : rem left flooddatadest(x,y)=flooddatadest(sx,sy)+1 stack=stack+1 Stackx(stack)=x Stacky(stack)=y else left=1 endif if up=1 and right=1 and down=1 and left=1 StackS(i)=1 endif else StackSs=StackSs+1 endif next i if StackSs>=stack then mapfilled=1 endwhile repeat stackpos=rnd(stack-1)+1 destx=stackx(stackpos) desty=stacky(stackpos) until preyx<destx-1 or preyy<desty-1 or preyx>destx+1 or preyy>desty+1 destx$=str$(destx) desty$=str$(desty) if len(destx$)<2 then destx$="0"+destx$ if len(desty$)<2 then desty$="0"+desty$ coordinates$=destx$+desty$ undim stackx(mapwidth*mapheight) undim stacky(mapwidth*mapheight) undim stackS(mapwidth*mapheight) undim flooddatadest(mapwidth,mapheight) map(predx,predy)=0 endfunction coordinates$ function PreyNoWhereToRun(preyx,preyy,predx,predy,mapwidth,mapheight) map(predx,predy)=1 dim flooddataNWTR(mapwidth,mapheight) dim stackx(mapwidth*mapheight) dim stacky(mapwidth*mapheight) dim stackS(mapwidth*mapheight) stack=1 flooddataNWTR(preyx,preyy)=1 stackx(stack)=preyx stacky(stack)=preyy mapfilled=0 while mapfilled=0 StackSs=0 for i=1 to stack if stackS(i)=0 sx=stackx(i) sy=stacky(i) up=0 : right=0 : down=0 : left=0 x=sx : y=sy-1 if map(x,y)=0 and flooddataNWTR(x,y)=0 : rem up flooddataNWTR(x,y)=1 stack=stack+1 Stackx(stack)=x Stacky(stack)=y else up=1 endif x=sx+1 : y=sy if map(x,y)=0 and flooddataNWTR(x,y)=0 : rem right flooddataNWTR(x,y)=1 stack=stack+1 Stackx(stack)=x Stacky(stack)=y else right=1 endif x=sx : y=sy+1 if map(x,y)=0 and flooddataNWTR(x,y)=0 : rem down flooddataNWTR(x,y)=1 stack=stack+1 Stackx(stack)=x Stacky(stack)=y else down=1 endif x=sx-1 : y=sy if map(x,y)=0 and flooddataNWTR(x,y)=0 : rem left flooddataNWTR(x,y)=1 stack=stack+1 Stackx(stack)=x Stacky(stack)=y else left=1 endif if up=1 and right=1 and down=1 and left=1 StackS(i)=1 endif else StackSs=StackSs+1 endif next i if StackSs>=stack then mapfilled=1 endwhile if flooddataNWTR(predx,predy-1)>0 and flooddataNWTR(predx+1,predy)>0 and flooddataNWTR(predx,predy+1)>0 and flooddataNWTR(predx-1,predy)>0 NWTR=1 else NWTR=0 endif undim stackx(mapwidth*mapheight) undim stacky(mapwidth*mapheight) undim stackS(mapwidth*mapheight) undim flooddataNWTR(mapwidth,mapheight) map(predx,predy)=0 endfunction NWTR function calculatepropablepath(mapwidth,mapheight,preddis) for x=1 to mapwidth for y=1 to mapheight if map(x,y)=0 distance#=Flooddata(x,y) if distance#>0 distance#=sqrt(distance#) ProbablePath#(x,y)=pathCom(x,y)/distance# else ProbablePath#(x,y)=0 endif endif next y next x largest#=0 largest2#=0 lx=0 ly=0 mindis=10 if mindis>Highestflood(0)-1 then mindis=Highestflood(0)-1 for x=1 to mapwidth for y=1 to mapheight if ProbablePath#(x,y)>largest# and Flooddata(x,y)>mindis and Flooddata(x,y)<40 lx=x : ly=y largest#=ProbablePath#(x,y) endif if ProbablePath#(x,y)>largest2# largest2#=ProbablePath#(x,y) endif next y next x for x=1 to mapwidth for y=1 to mapheight if ProbablePath#(x,y)>0 ProbablePath#(x,y)=ProbablePath#(x,y)/largest2#*20 endif next y next x Pendpointx(0)=lx Pendpointy(0)=ly endfunction