/*   Autodist : Sets up distribution paths.
 +   To Use : /pipe dump SECTS >> FILE dump data
 +            /cms autodist {dist-sector}
 +            ......Wait a while
 +            Once done you can send the commands to the server with
 +            /quote distribution paths a
 +   Another fine product of Dwarven Development.
 +   Note: This should work for all pre-Chainsaw 3.0 version of empire
 +         but I do recomend checking stuff out because I am not 100%
 +         confident with the path choices (They 'SEEMED' okay to me)
 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 +      path.x.y     : Final path for sector x,y
 +      mpc.x.y      : Cost for the final path for sector x,y
 +      mpath        : Current minimum path
 +      minimum_cost : Current minimum cost
 +      des.x.y      : designation for x,y
 +      eff.x.y      : efficiency of x,y
 +      MAX_COST     : Maximum path cost (number of nonfree sectors*100)
*/
mx.1=-2;mx.2=-1;mx.3=1;mx.4=2;mx.5=1;mx.6=-1
my.1=0;my.2=-1;my.3=-1;my.4=0;my.5=1;my.6=1
endpath='h';comma=',';path.='hhhhhhhhhhh';mpc.=999999
                             /* Keep us from going through mountains */
MAX_COST=1000
call Read_Dump
'erase distribution paths'
parse arg xd','yd
ranges=yd miny '-1' xd minx '-1' yd miny '-1' xd+1 maxx 1 yd+1 maxy 1 xd minx '-1' yd+1 maxy 1 xd+1 maxx 1
say words(ranges) ':' ranges
do i=1 to words(ranges) by 6
  do y=word(ranges,i) to word(ranges,i+1) by word(ranges,i+2)
    do x=word(ranges,i+3) to word(ranges,i+4) by word(ranges,i+5)
      if (des.x.y=='') then iterate
      minimum_cost=999999;mpath='hhhhhhhhhhh'
      garbage=Find_Path(x,y,'',0,'')
      if mpath=='hhhhhhhhhhh' then mpath='h No Available Path'
      if minimum_cost==999999 then minimum_cost=999998
      path.x.y=mpath;mpc.x.y=minimum_cost
      say 'dist '||x||','||y path.x.y||'h'    '(' mpc.x.y ')'
      push 'dist '||x||','||y path.x.y||'h'    '(' mpc.x.y ')'
      'execio 1 diskw distribution paths a (finis'
    end
  end
end
exit
 
Find_Path: procedure expose des. eff. mx. my. xd yd minimum_cost mpath MAX_COST path. mpc. cost.
x=arg(1);y=arg(2);cpath=arg(3);ccost=arg(4);sects=arg(5)
if mpc.x.y^='999999' then do
  if path.x.y=='NAPath' then return 'NAPath999998'
  if ((mpc.x.y+ccost<minimum_cost)&(length(cpath||path.x.y)<11)) then do
      minimum_cost=mpc.x.y+ccost
      mpath=cpath||path.x.y
      return cpath||path.x.y||mpc.x.y+ccost
  end
  else return 'nopath999999'
end
if index(sects,x||','||y)^=0 then return 'nopath999999'
if length(cpath)>10 then return 'nopath999999'
if (abs(x-xd)>20-(2*length(cpath)) | abs(y-yd)>10-length(cpath)) then
  return 'nopath999999'
if ccost>MAX_COST then return 'nopath999999'
if ccost>minimum_cost then return 'nopath999999'
if ccost=minimum_cost & length(cpath)>=length(mpath) then
  return 'nopath999999'
if (x==xd & y==yd) then do
  if ccost<minimum_cost then do
    minimum_cost=ccost
    mpath=cpath
    return cpath||'h'||ccost
  end
  else return 'nopath999999'
end
/* Check to make sure we aren't making the path longer than it needs to
   be */
select
  when right(cpath,2)=='gn' then return 'nopath999999'
  when right(cpath,2)=='ng' then return 'nopath999999'
  when right(cpath,2)=='gu' then return 'nopath999999'
  when right(cpath,2)=='ug' then return 'nopath999999'
  when right(cpath,2)=='jb' then return 'nopath999999'
  when right(cpath,2)=='bj' then return 'nopath999999'
  when right(cpath,2)=='jy' then return 'nopath999999'
  when right(cpath,2)=='yj' then return 'nopath999999'
  otherwise nop
end
/* Build a list of everything we have access to from this sector */
adjacent=''
do i=1 to 6
  testx=x+mx.i;testy=y+my.i
  if des.testx.testy^='' then adjacent=adjacent x+mx.i','y+my.i
end
/* Order them so we try the cheapest first */
adjacent=Order_Adjacent(adjacent)
do i=1 to words(adjacent)
  test=word(adjacent,i)
  parse var test mx','my
/* Figure out what directional move we are making */
  select
    when (my==y & mx>x) then move='j'
    when (my==y & mx<x) then move='g'
    when (my>y & mx>x) then move='n'
    when (my>y & mx<x) then move='b'
    when (my<y & mx>x) then move='u'
    when (my<y & mx<x) then move='y'
  end
/* Go that route */
  bpath.i=Find_Path(mx,my,cpath||move,ccost+cost.mx.my,sects x||','||y)
end
/* Find the cheapest of these paths and return its ccost */
mincost='nopath999999'
do i=1 to words(adjacent)
  parse var bpath.i path(endpath)ccost
  parse var mincost minpath(endpath)mccost
  if ccost<mccost then mincost=bpath.i
end
return mincost
 
Order_Adjacent: procedure expose des. eff. xd yd MAX_COST ccost cost.
old=arg(1);new=''
if (index(test,xd','yd)^=0) then return xd','yd
  do while (words(old)>0)
  cheapest=1000000
  do i=1 to words(old)
    test=word(old,i)
    xloc=left(test,index(test,',')-1);yloc=right(test,length(test)-index(test,','))
    if cost.xloc.yloc<cheapest then do
      cheapest=cost.xloc.yloc
      cheapx=xloc;cheapy=yloc
    end
    else if cost.xloc.yloc=cheapest then do
      if (abs(cheapx-xd)+abs(cheapy-yd)>abs(xloc-xd)+abs(yloc-yd)) then do
        cheapest=cost.xloc.yloc
        cheapx=xloc;cheapy=yloc
      end
    end
  end
  match=cheapx','cheapy
  old=delstr(old,wordindex(old,wordpos(match,old)),length(match))
  if ccost+cheapest<=MAX_COST then new=new match
end
return new
 
 
Read_Dump:
des.='';eff.=''
maxx=-99;minx=99;maxy=-99;miny=99
'execio * diskr dump data a (finis'
pull line;pull line;pull line
do queued()-1
  parse pull x y rest
  parse var rest des.x.y . eff.x.y .
  maxx=max(maxx,x);minx=min(minx,x);maxy=max(maxy,y);miny=min(miny,y)
  select
    when des.x.y=='+' then cost.x.y=100-eff.x.y
    when des.x.y=='=' then cost.x.y=100-eff.x.y
    when des.x.y=='^' then cost.x.y=12700-eff.x.y
    when des.x.y=='-' then cost.x.y=400-eff.x.y
    otherwise cost.x.y=200-eff.x.y
  end
end
parse pull line
return