PROGRAM identify (input,output);

   { The following declarations specify the manner in which time tables
     are represented. They MUST be INCLUDED in any time table program.}

      {  C O N S T   D E C L A R A T I O N S }

CONST
   minsperday = 1440;    {minutes in one day }
   numberofstations = 7;
   maxstringlength=12;   {the length of the longest station string PETER....}
   maxwait = 240;        {longest time between any  connexions}


      { T Y P E    D E C L A R A T I O N S }

TYPE

   mintime = 0..minsperday;    {internal representation of all times}
   hourtime = packed array[1..5] of char;
                               {external representation HH.MM }

   station = (edin, peter, ely, camb, lkx, lls, roy);
                               {internal representaion of  stations}
   stationstring = packed array[1..maxstringlength] of char;
                               {external representation of stations}

   changeinfoptr = ^changeinfo;
   changeinfo = record          { record any changes involved in a list}
                  place :station;   {at which change occurrs orllx for lls}
                  arrt :mintime;    {arrival time }
                  wait :0..maxwait; {interval before departure}
                  next :changeinfoptr
                end;

  journeyptr= ^journey;
  journey = record        { the basic time table entry }
             dept, arrt :mintime;   {time of (complete) journey}
             change1 :changeinfoptr;  { detail of change(s) or nil}
             marked :boolean;
             next :journeyptr
            end;

  ttableptr = ^ttable;
  ttable = record
             from, dest :station;   { all journeys are between these 2 places}
             first :journeyptr   { the first journey}
                                  { journeys are in ascending order of dept}
           end;


VAR
  ep,pe,ec,          { the Peterborough route }
  elkx,lkxr,rc,      { the Royston route }
  llsc :ttableptr;              { Liverpool street}
  epec,              {ed-pet-ely-camb}
  elrc,              {ed-kx-roy-camb}
  elsc,              {ed-lks-lls-c}
  fulltable,         {all routes, all trains }
  temp :ttableptr;


   {      C O N V E R S I O N       P R O C E D U R E S        }
     { needed between internal and external representations }
             { of times and of stations }

PROCEDURE mintohour(mt :mintime; var ht :hourtime); extern;
FUNCTION  hourtomin(ht :hourtime) :mintime; extern;
PROCEDURE stationtostr(st :station; var s :stationstring); extern;
FUNCTION  strtostation(s :stationstring) :station; extern;
                                {This is a crude comparison which looks
                                 only at key distinguishing characters!!}




  { I N P U T      A N D     O U T P U T   P R O C E D U R E S }
      { i.e. they read or print one time table }

PROCEDURE  readtt(var inp :text; var tt :ttableptr); extern;
                                                {Program halted if any
                                                 input errors detected!}
PROCEDURE writett (var out :text; tt :ttableptr); extern;
                                              { Prints one table in standard
                                                form on file "out"}


{     E N D    O F   P R E - D E F I N E D    P R O C E D U R E S }


  PROCEDURE getdata;   { reads and verifies 7 tables}
  VAR
    n :1..7;   { control variable}

    PROCEDURE identify1;     { reads and indentifies 1 time table}
    VAR
      temp :ttableptr;

      PROCEDURE printstat;    {identify the ttable in temp}
      VAR
        s :stationstring;
      BEGIN
        stationtostr(temp^.from, s);
        write(s, ' to ');
        stationtostr(temp^.dest,s);
        write(s);
      END;

      PROCEDURE copythrough(var p :ttableptr);   { checks no duplicates}
      BEGIN
        if p=nil then p:=temp
        else begin
          write('Duplicate time table ');
          printstat;
          writeln;
        end;
      END;    {of copying thrugh}



      PROCEDURE unknown;
      BEGIN
        write('Unknown table from ');
        printstat;
        writeln;
      END;

    BEGIN  {identifying 1}
      readtt(input,temp);

      with temp^ do
      case dest of
        peter: if from=edin then copythrough(ep)
                            else unknown;
        ely:   if from=peter then copythrough(pe)
                             else unknown;
        lkx:   if from=edin then copythrough(elkx)
                           else unknown;
        roy:  if from=lkx then copythrough(lkxr)
                           else unknown;

        camb: case from of
                ely : copythrough(ec);
                roy:  copythrough(rc);
                lls:  copythrough(llsc);
                edin,peter,
                lkx, camb:  unknown;
              end;
   
        edin,lls: unknown;
      end;
 
    END;   {identifying 1}

  BEGIN { reading in all the  data }

     ep:=nil; pe:=nil; ec:=nil;
     elkx:=nil; lkxr:=nil; rc:=nil;
     llsc:=nil;

     for n:= 1 to 7 do identify1;
  END;
        { of identification of input }


         { useful function for connecting and merging? }

  FUNCTION timediff(t1,t2 :mintime) :mintime;
  VAR t :integer;
  BEGIN
    t := t1-t2;
    if t<0 then t := t+minsperday;
    timediff := t;
  END;   {time diff fn}

  PROCEDURE connect(ab,bc :ttableptr; var abc :ttableptr; minw,maxw :mintime);
  VAR
    abj,              { points at each one in turn }
    lastacj :journeyptr;  {the last journey within abc }

    PROCEDURE makeallconns (abj :journeyptr);
    VAR bcj :journeyptr;     {points at each bc journey in turn }

      FUNCTION connects(abj,bcj :journeyptr) :boolean;
      VAR wait :mintime;
      BEGIN  {connects function}
        wait:= timediff(bcj^.dept,abj^.arrt);
        connects:= (minw<=wait) and (wait<=maxw);
      END;   {connects function}

      FUNCTION makenewchange: changeinfoptr;
      VAR
        res,                 {the ultimate  result }
        chg :changeinfoptr;  { for the new info }

      BEGIN  { of make new change }
        {This procedure  makes the simplifying assumption that
         at most one of abj & bcj have non-nil change and that
         the change  is a single record. }

        res:=nil;
        with abj^ do 
          if change1<>nil then begin
            new(res);
            res^ := change1^;
          end;
                   { Now the new change info proper:- }
        new(chg);
        with chg^ do begin
          place := bc^.from;    {L(ls) in the one critical case }
          arrt := abj^.arrt;
          wait := timediff(bcj^.dept,arrt);
          next:=nil;
        end;
                   { Include in the result }
        if res<>nil then
           res^.next := chg
        else
           res:=chg;
                   { Finally the bcj part?? }
        if bcj^.change1<>nil then begin
          new(chg^.next);
          chg^.next^ := bcj^.change1^
        end;

        makenewchange := res;

      END;  {of making changeinfo }

      PROCEDURE addconn(abj,bcj :journeyptr);  { adds to connected table}

      VAR  acj :journeyptr;    { the new journey record }
      BEGIN    {of addconn}
        new(acj);
        with acj^ do begin
          dept := abj^.dept;
          arrt := bcj^.arrt;
          change1:= makenewchange;
         marked := false;
          next := nil;
        end;
              { set up so now place on ac list }
        if lastacj <> nil then
          lastacj^.next:=acj
        else
          abc^.first := acj;
        lastacj := acj;
      END;     {of addconn}

    BEGIN   {of makealconns}
      bcj:= bc^.first;
      while bcj<>nil do begin
        if connects(abj,bcj) then addconn(abj,bcj);
        bcj:=bcj^.next;
      end;

    END;  {of makeallconns }

  BEGIN {of connect}
    new(abc);        {the conected table }
    with abc^ do begin
      from := ab^.from;
      dest := bc^.dest;
      first := nil;
    end;
    lastacj := nil;   {there are no abc journeys yet }

            { go through each ab journey in turn:- }
    abj := ab^.first;
    while abj <> nil do begin
      makeallconns(abj);
      abj:=abj^.next;
    end;

  END;   {connecting}


  PROCEDURE  merge (tt1,tt2 :ttableptr; var tt12 :ttableptr);

                        {Given 2 timetables from A to B but via different
                         routes, it forms a single table including both
                         routes in one. }
  VAR
    tt1j, tt2j  :journeyptr;    {the 2 points within the 2 journey lists }
    mg :journeyptr;          { the new journey }

    last12j :journeyptr;   {the  last in the new table}

   FUNCTION copyj( jp :journeyptr) :journeyptr;

         { Copies a complete journey entry for the new table }
   VAR
     res :journeyptr;  { the  ultimate result }

     FUNCTION copychlist (chp :changeinfoptr) :changeinfoptr;
     VAR
       chg :changeinfoptr;

     BEGIN
       if chp=nil then
         copychlist:=nil
       else begin
         new(chg);
         chg^ := chp^;
         chg^.next := copychlist(chp^.next);
         copychlist:=chg;
       end;
     END; { of copying changes }

    BEGIN  {copying a journey }
      new(res);
      res^ := jp^;
      res^.change1 := copychlist(jp^.change1);
      copyj := res;
    END;

  BEGIN  { merging ici }
    new(tt12);
    with tt12^ do begin
      from:=tt1^.from;
      dest:=tt2^.dest;
      first:=nil;
      new(first);  { a dummy to start with - remove at end }
     first^.next:=nil;
     last12j:=first;
    end;
    { Now thebasic loop which cause the merging to take place, in the
      event that both tables contain same departure time then take
      journey with later arrival first???}

    tt1j := tt1^.first;
    tt2j := tt2^.first;

    while (tt1j<>nil) and (tt2j<>nil) do begin
           { select one of them and copy it}
      if tt1j^.dept < tt2j^.dept then begin
        mg := tt1j;
        tt1j := tt1j^.next;
        end
      else if tt2j^.dept < tt1j^.dept then begin
        mg := tt2j;
        tt2j := tt2j^.next;
        end
      else if tt1j^.arrt < tt2j^.arrt then begin
        mg := tt2j;
        tt2j := tt2j^.next;
        end
      else begin
        mg := tt1j;
        tt1j := tt1j^.next;
      end;
      last12j^.next := copyj(mg);
      last12j := last12j^.next;
    end;     { of looping round both lists }

    while tt1j <> nil do begin
       last12j^.next := copyj(tt1j);
       tt1j := tt1j^.next;
       last12j:=last12j^.next;
    end;
    while tt2j <> nil do begin
       last12j^.next := copyj(tt2j);
       tt2j := tt2j^.next;
      last12j:=last12j^.next;
    end;

             { Finally remove  initial dummy }
    tt12^.first := tt12^.first^.next;

  END;    { of merging }

  PROCEDURE marktt(var tt :ttableptr);
                   {This procedure marks all the useful trains in
                    the given timetable.}

  VAR
    potu,     {potentially useful journey}
    potov     {potential overtaker}
          :journeyptr;

    FUNCTION overtakes(j1,j2 :journeyptr) :boolean;
                   {returns true if:-
                         ji is overtaken by j2
                    N.B.}
    VAR
      d1,a1,d2,a2 :integer;    {departure and arrival time on the
                                full time scale}
    BEGIN
      with j1^ do begin
        d1:=dept;
        a1:=arrt;
      end;
      with j2^ do begin
        d2:=dept;
        a2:=arrt;
      end;

      if d1>a1 then a1:=a1+minsperday;    {over midnight journey}
      if d2>a2 then a2:=a2+minsperday;    {  "     "        "   }

      if d2<d1 then begin  { same day j2 can't possibly overtake so}
        d2:=d2+minsperday; { try same train next day}
        a2:=a2+minsperday;
      end;
               {at last set up for genuine comparison }
               { identical departure and arrival is not an overtaker!!}

      overtakes := (d1<d2) and (a2<=a1) or (d1=d2) and (a2<a1)
    END;

  BEGIN {of marktt proper }
    potu:=tt^.first;
    while potu<>nil do begin
      potu^.marked := true;    { provisionally a useful train}
      potov:=tt^.first;
                               {the simple N-squared algorithm!!!}
      with potu^ do
        while marked and (potov<>nil) do begin
          if overtakes(potu,potov) then marked:=false;
          potov:=potov^.next;
        end;
      potu:=potu^.next;
    end;
  END;


BEGIN  {of  M A I N     P R O G R A M    P R O P E R }


  getdata;

  connect(ep,pe,temp,10,60);
  connect(temp,ec,epec,10,60);


  connect(elkx,lkxr,temp,10,60);
  connect(temp,rc,elrc,10,60);

  connect(elkx,llsc,elsc,60,240);

  writeln ('Connections made.');

  merge(epec, elrc, temp);

  merge(temp, elsc, fulltable);

  writeln('Full table generated');
  writeln; writeln;

  marktt(fulltable);
  writett(output,fulltable);
  writeln;  writeln;

END.