MODULE ROUTE;
FROM VILLAGES IMPORT vinfo,villagenotype,loadvillages,
       links,noofvillages,villageinfotype,linknotype;
FROM STDIO IMPORT GOTOXY,WRSTR,WAITKEY,
       CLS,WRLN,RDSTR,WRCHAR,WRSUBSTR;
FROM MAINREAD IMPORT entrych;
FROM STRINGS IMPORT LENGTH,SEARCH;
FROM NUMIO IMPORT STRTOCARD,WRCARD;
FROM R3IO IMPORT WRR3FIX;
FROM SYSTEM IMPORT ADDRESS,ADR,TSIZE;
FROM FASTO IMPORT WRITEAT;
FROM GRAPH0 IMPORT SETATTRS;
CONST edit  =07I;
      down  =0AI;
      up    =0BI;
      enter =0DI;
TYPE dmtype=(none,prov,set);
     vinfo2type=
     RECORD
       prev:villagenotype;
       distto:REAL3;
       dmode:dmtype;
     END;

PROCEDURE vsearch(S1:ARRAY OF CHAR;VAR v:villagenotype):BOOLEAN;
VAR P:ADDRESS;
    n:CARDINAL;
BEGIN
P:=ADR(vinfo);n:=noofvillages;
IF SEARCH(P,n,TSIZE(villageinfotype),S1) THEN
  v:=noofvillages-n+1;
  RETURN TRUE 
 ELSE RETURN FALSE END
END vsearch;
 
PROCEDURE selectvillage(VAR v:villagenotype):BOOLEAN;

PROCEDURE NUMERIC(ch:CHAR):BOOLEAN;
HEX CD 1B 2D 3F C9 END NUMERIC;
 
CONST pageup='.';pagedown=',';
VAR S1:ARRAY [0..16] OF CHAR;
  OK,redo:BOOLEAN;
  y,try,digit,temp:CARDINAL;
  vn,vtop,vbot,vi:villagenotype;
  ch:CHAR;
 
BEGIN
CLS;GOTOXY(1,4);
IF noofvillages=0 THEN 
  WRSTR('No data loaded - Press a key');
  ch:=WAITKEY();
  RETURN FALSE END;
WRSTR('Type number or name of place');
WRLN;
WRSTR('  or press ENTER for a list');
ch:=WAITKEY();
IF ch=edit THEN 
  RETURN FALSE END;
GOTOXY(3,7);entrych:=ch;
RDSTR(S1);
IF LENGTH(S1)<>0 THEN
  IF NUMERIC(S1[0]) THEN
    temp:=STRTOCARD(S1,OK);
    IF OK AND (temp<=noofvillages) THEN 
      v:=temp;RETURN TRUE END;
   ELSIF vsearch(S1,v) THEN 
    RETURN TRUE END END;
CLS;vtop:=1;vn:=1;redo:=TRUE;
LOOP vbot:=vtop+23;
  IF vbot>noofvillages THEN 
    vbot:=noofvillages END;
  IF redo THEN GOTOXY(0,0);
    FOR vi:=vtop TO vbot DO
      WRCHAR(' ');WRCARD(vi,3);
      WRCHAR(' ');
      WRSUBSTR(vinfo[vi].name,0,20);
      WRLN;redo:=FALSE END END;
  y:=vn-vtop;
  SETATTRS(1,y,24,30H);
  ch:=WAITKEY();
  SETATTRS(1,y,24,38H);
  CASE ch OF
   up:try:=0;
    IF vn=vtop THEN
      IF vtop>1 THEN 
        DEC(vtop);DEC(vn);
        redo:=TRUE END;
     ELSE DEC(vn) END|
   down:try:=0;
    IF vn=vbot THEN 
      IF vbot<noofvillages THEN 
        INC(vtop);INC(vn);
        redo:=TRUE END
     ELSE INC(vn) END|
   pageup:try:=0;
    IF vtop>25 THEN DEC(vtop,24)
      ELSE vtop:=1 END;
    vn:=vtop;redo:=TRUE|
   pagedown:try:=0;
    temp:=noofvillages-vbot;
    IF temp>24 THEN INC(vtop,24)
     ELSIF temp>0 THEN
      vtop:=noofvillages-23 END;
     vn:=vtop;redo:=TRUE|
   '0'..'9':
    digit:=ORD(ch)-ORD('0');
    try:=try*10+digit;
    IF try<>0 THEN redo:=TRUE;
      IF try>noofvillages THEN 
        try:=digit END;
      vn:=try;
      IF noofvillages>=vn+23 THEN 
        vtop:=vn
       ELSIF noofvillages<=23 THEN 
        vtop:=1
       ELSE 
        vtop:=noofvillages-23 END END|
   enter: v:=vn;RETURN TRUE|
   edit: v:=vn;RETURN FALSE END END;
END selectvillage;
 
VAR vinfo2:ARRAY villagenotype OF vinfo2type;
    v1,v2:villagenotype;
    y:SHORTCARD;
 
PROCEDURE networkfrom(v1:villagenotype);
VAR v,vm:villagenotype;
    tdist,mindist:REAL3;
    minset:BOOLEAN;
    numset:CARDINAL;
    l:linknotype;
BEGIN
numset:=0;
WITH vinfo2[v1] DO 
  distto:=RL3(0);
  dmode:=prov END;
REPEAT minset:=FALSE;
  FOR v:=1 TO noofvillages DO
    WITH vinfo2[v] DO
      IF (dmode=prov) AND (NOT minset OR (distto<=mindist)) THEN
        vm:=v;mindist:=distto;
        minset:=TRUE END END END;
  vinfo2[vm].dmode:=set;
  INC(numset);
  WITH vinfo[vm] DO
    FOR l:=linkst TO linkst+linknum-1 DO
      WITH links[l] DO
        tdist:=mindist+dist;
        WITH vinfo2[vnum] DO
          IF (dmode=none) OR 
            ((dmode=prov) AND (tdist<distto)) THEN
            distto:=tdist;dmode:=prov;
            prev:=vm END END END END END;
 UNTIL NOT minset;
END networkfrom;
 
VAR rtch:CHAR;
PROCEDURE routeto(v:villagenotype);
BEGIN
IF vinfo2[v].dmode<>set THEN
  WRITEAT(1,2,'No path there on network');
  rtch:=WAITKEY();RETURN END;
IF v<>v1 THEN 
  routeto(vinfo2[v].prev) END;
INC(y);
IF y=22 THEN
  WRITEAT(0,23,'Press a key for next page');
  rtch:=WAITKEY();y:=0;CLS END;
WRITEAT(0,y,vinfo[v].name);WRLN;
END routeto;
 
VAR v:villagenotype;
    ch:CHAR;
BEGIN
loadvillages;
REPEAT
  FOR v:=1 TO noofvillages DO 
    vinfo2[v].dmode:=none END;
  REPEAT CLS;GOTOXY(0,0);
    WRSTR('Enter start of route');
   UNTIL selectvillage(v1);
  networkfrom(v1);
  REPEAT
    REPEAT CLS;GOTOXY(0,0);
      WRSTR('Enter destination')
     UNTIL selectvillage(v2);
    CLS;y:=0;
    routeto(v2);
    GOTOXY(0,22);
    WRSTR('Distance is: ');
    WRR3FIX(vinfo2[v2].distto,5,2);
    WRITEAT(0,23,'Another Destination?');
    ch:=WAITKEY() 
   UNTIL (CAP(ch)<>'Y');
  WRITEAT(0,23,'Another Start?      ');
  ch:=WAITKEY() 
 UNTIL (CAP(ch)<>'Y')
END ROUTE.
