PROGRAM NEWTTS (INPUT,OUTPUT);
  (*Complete version using the heap to the full*)
CONST
  MINSPERDAY = 1440;
  STREND = '@';  (*Marks the end of variable length string in array of char
                                            *)
  MAXSTL=30;  (*30 includes the strend!!*)

TYPE
  MINTIME = 0..MINSPERDAY; (*all times represented internally thus *)
  DAYTIME = PACKED ARRAY [1..5] OF CHAR; (*transput representation*)

  STRING = PACKED ARRAY [1..MAXSTL] OF CHAR;
                      (*for titles and transput of stations*)
  STATION = (EDINB,PETERB,ELY,CAMB,LONDX,LONDL,ROYST); (*no ordering*)

  REFCHANGE = ^CHANGE;
  CHANGE = RECORD
      AT :STATION;
      ARRT :MINTIME;
      WAIT :INTEGER;
     NEXT :REFCHANGE
    END;
       (*A list of changes attached to every journey to denote route etc.*)

  REFJOURNEY = ^JOURNEY;
  JOURNEY = RECORD
      DEPT, ARRT :MINTIME; (*departure & arrival times*)
      RS :REFCHANGE;  (*route synopsis i.e. changes*)
      NEXT :REFJOURNEY
    END;
         (* a timetable is proncipally a list of these*)

  REFTT = ^TIMETABLE;
  TIMETABLE = RECORD
      TITLE :STRING;
      FROM, DEST :STATION;
      TRAINS :REFJOURNEY
    END;
      (*Within a timetable journeys are in ascending order of departure
       time, and where >1 at given dept then on descending order of
       arrival time. Should make reducing easiest?*)

VAR
  ELKX,LKXR,RC,EP,PELY,ELYC, LLSC  :REFTT;
  TEMP, EPEC, EXRC, ELSC :REFTT;   (*The 3 intermediate routes*)

 (****** now procedures,  first basic output procedure *********)
  
  PROCEDURE PST(ST :STRING); (*prints a string*)
  VAR P :1..MAXSTL;
  BEGIN
    P:=1;
    WHILE ST[P]<>STREND DO BEGIN
      WRITE(ST[P]);
      P:=P+1
    END;
  END; (*of pst*)


(* Now conversion procedures, mostly for use during transput ******)

  FUNCTION STATOFST (ST :STRING) :STATION;
      (*Checks, crudely, for valid station string and returns the station
       Suspect coding won't work because of set limitations*)
  LABEL 999;  (*Abort exit from proc i.e. monitor and halt('**** ABORT *****')*)
  TYPE
    AZPOS=0..25;  (* uc letters within a..z*)

  VAR
    LETT1,LETT2,LETT8 :SET OF AZPOS;

  FUNCTION LP (C :CHAR) :INTEGER;
  BEGIN
    LP:= ORD(C)-ORD('A')
  END;
  BEGIN
    LETT1 := [LP('E'),LP('P'),LP('C'),LP('L'),LP('R')];
                               (*all possible first letters*)
    LETT2 := [LP('D'),LP('L')];   (*distinguishes Edinburg & Ely*)
    LETT8 := [LP('K'),LP('L')];   (* --- " ---    the LOndons *)

    IF NOT ( LP(ST[1]) IN LETT1) THEN GOTO 999;
    CASE ST[1] OF
     'P': STATOFST := PETERB;
     'C': STATOFST := CAMB;
     'R': STATOFST := ROYST;

     'E': BEGIN
        IF NOT( LP(ST[2]) IN LETT2) THEN GOTO 999;
        CASE ST[2] OF
         'D': STATOFST := EDINB;
         'L': STATOFST := ELY;
        END
       END;

     'L': BEGIN
        IF NOT( LP(ST[8]) IN LETT8) THEN GOTO 999;
        CASE ST[8] OF
         'K': STATOFST := LONDX;
         'L': STATOFST := LONDL;
        END;
      END; (*of case L*)
    END;  (*of case analysis*)

    IF FALSE THEN BEGIN  (*Only entered by explicit goto!!!*)
  999:
      WRITE('Invalid station string [');
      PST(ST);
      WRITELN(']');
      HALT('**** ABORT *****')
    END;
  END;  (*of station of string*)

  PROCEDURE STROFSTAT (ST :STATION; VAR S :STRING);
  BEGIN
    CASE ST OF
     EDINB:  S:='EDINBURGH@                    ';
     PETERB: S:='PETERBOROUGH@                 ';
     ELY:    S:='ELY@                          ';
     CAMB:   S:='CAMBRIDGE@                    ';
     LONDX:  S:='LONDON(KX)@                   ';
     LONDL:  S:='LONDON(LS)@                   ';
     ROYST:  S:='ROYSTON@                      ';
    END
  END; (*string of station*)

  FUNCTION MTOFDT (DT :DAYTIME) :MINTIME;
      (* verifies format hh.mm and range, 24 hour clock notation*)
  TYPE
    VALIDH = 0..23;
    VALIDM = 0..59;
  VAR
    VALIDHS :SET OF VALIDH;
    VALIDMS :SET OF VALIDM;
    HRS, MINS :INTEGER;

    FUNCTION DEC2( DT :DAYTIME; INDX :INTEGER) :BOOLEAN;
       (*verifies 2 adjacent characters in dt ([indx] & [indx+1]) are
        decimal digits*)
    TYPE
      DECDIGIT = '0'..'9'; (*a subrange of thecharacters*)
    VAR
      ALLDIGS :SET OF DECDIGIT;
      P   :INTEGER;
    BEGIN
      ALLDIGS := ['0'..'9']; (*i.e. all decimal digits*)
      DEC2 := TRUE;
      FOR P := INDX TO INDX+1 DO
        IF NOT(DT[P] IN ALLDIGS) THEN DEC2 := FALSE;
    END;  (*dec2*)

    FUNCTION IOF2 (DT :DAYTIME; INDX :INTEGER) :INTEGER;
      (*viz: that represented by the decimal digit pair*)
    BEGIN
     IOF2:= (ORD(DT[INDX])-ORD('0'))*10 + ORD(DT[INDX+1]) - ORD('0')
    END; (*of iof2*)
  BEGIN
    VALIDHS := [0..23]; (* a;; possible hours*)
    VALIDMS := [0..59]; (*all possible minutes*)

    IF NOT DEC2(DT,1) THEN BEGIN
      WRITELN('Non-decimal hours in time -',DT);
      HALT('**** ABORT *****')
    END;

    HRS := IOF2(DT,1);
    IF NOT (HRS IN VALIDHS) THEN BEGIN
      WRITELN('Hour value out of range -',HRS:2);
      HALT('**** ABORT *****')
    END;
              (* hours are O.K.*)
    IF NOT (DT[3]='.') THEN BEGIN
      WRITELN('Invalid time format, missing dot -',DT);
      HALT('**** ABORT *****')
    END;

    IF NOT DEC2(DT,4) THEN BEGIN
      WRITELN('Non-decimal minutes in time -', DT);
      HALT('**** ABORT *****')
    END;

    MINS := IOF2(DT,4);
    IF NOT(MINS IN VALIDMS) THEN BEGIN
      WRITELN('Minutes out of range in time-', DT);
      HALT('**** ABORT *****')
    END;
       (*Everything in the garden is lovely:-*)
    MTOFDT := 60*HRS +MINS;
  END;  (*of converting daytime to min time*)

  PROCEDURE DTOFMT ( MT :MINTIME; VAR DT :DAYTIME);
  TYPE
    UNIT = 0..9;
  VAR
    HOURS :INTEGER;
    MINS :INTEGER;
    HTENS,HUNITS,MTENS,MUNITS :UNIT;
    FUNCTION DECDIGIT(U :UNIT) :CHAR;
    BEGIN
      DECDIGIT:= CHR(U+ORD('0') )
    END;
  BEGIN
    HOURS:=MT DIV 60;
    MINS :=MT MOD 60;

    HTENS:= HOURS DIV 10;
    HUNITS:= HOURS MOD 10;
    MTENS:= MINS DIV 10;
    MUNITS:= MINS MOD 10;

    DT[1]:= DECDIGIT(HTENS);
    DT[2]:= DECDIGIT(HUNITS);
    DT[3]:='.';
    DT[4]:= DECDIGIT(MTENS);
    DT[5]:=DECDIGIT(MUNITS);
  END; (* of dt of mt*)

(* **** One and only principal input procedure, others are local to it ***)

  FUNCTION GETT :REFTT;  (* reads in one timetable*)
  CONST
    TERMINATOR='*'; (*terminates each time table, on a left margin*)
  
  VAR
    TT :REFTT;
    S :STRING;  (*used in intermediate stage getting stations*)

    PROCEDURE SKIPBLANKS; (* i.e.all blanks including newlines*)
    BEGIN
      WHILE (NOT EOF(INPUT)) AND (INPUT^=' ') DO GET(INPUT);
      IF EOF(INPUT) THEN BEGIN
        WRITELN('End of input while skipping blanks');
        HALT('**** ABORT *****')
      END;
    END; (*of skip blanks*)

    PROCEDURE SKIPSPACES;  (*I.e. not newlines*)
    BEGIN
      WHILE (NOT EOLN(INPUT)) AND (INPUT^=' ') DO GET(INPUT);
      IF EOLN(INPUT) THEN BEGIN
        WRITELN('End of line while skipping spaces');
        HALT('**** ABORT *****')
      END
    END;  (*of skip spaces*)

    PROCEDURE QUOTEDST (VAR RES :STRING);
       (*reads up to but not incl. a quote ("), initially input^="
        skips the terminating quote*)
    CONST
      QUOTE='"';
    VAR
      P  :INTEGER;
    BEGIN
      P:=0;
      IF INPUT^ <> QUOTE THEN BEGIN
        WRITELN('Invalid initial quotation in "quotedst" -',INPUT^);
        HALT('**** ABORT *****')
      END;
      GET(INPUT);  (*pass the initial quote*)
      WHILE (INPUT^  <> QUOTE) AND (P < MAXSTL-1) DO BEGIN
        P:=P+1;
        RES[P]:=INPUT^;
        GET(INPUT);
      END;
      RES[P+1]:=STREND;  (* Mark end of string *)
      IF INPUT^ <> QUOTE THEN BEGIN
        WRITELN('String too long [');
        PST(RES);
        WRITELN(']');
        HALT('**** ABORT *****')
      END;

      GET(INPUT);  (*pass terminating quote*)
    END;    (* of quoted string input*)

    PROCEDURE READTRAINS;  (*reads in the basic one train journeys*)
    VAR
      LAST :REFJOURNEY;
      LASTDEPT :MINTIME; (*Used to check ascending order*)

      FUNCTION NEXTJOURNEY :REFJOURNEY; (*reads arrival & dept time + sets up record*)
     VAR
       JNY :REFJOURNEY;
       DT :DAYTIME;

       PROCEDURE GETDT; (*in fact just read 5 characters!!*)
       VAR
         P :0..5;
       BEGIN
         FOR P:= 1 TO 5 DO BEGIN
           DT[P]:=INPUT^;
           GET(INPUT);
         END;
       END;   (*of getting day time*)

     BEGIN
       NEW(JNY);
       WITH JNY^ DO BEGIN
         SKIPBLANKS;
         GETDT;
         DEPT:= MTOFDT(DT);
         SKIPSPACES;
         GETDT;
         ARRT:= MTOFDT(DT);
         RS:=NIL;
         NEXT:=NIL;
       END;
       NEXTJOURNEY:=JNY;
     END;   (*of getting a journey*)

    BEGIN  (* of main body of read trains*)
      SKIPBLANKS;
      TT^.TRAINS:=NEXTJOURNEY;
      LAST:=TT^.TRAINS;
      SKIPBLANKS;
      WHILE INPUT^ <> TERMINATOR DO BEGIN
        LAST^.NEXT:=NEXTJOURNEY;
        LAST:=LAST^.NEXT;
        SKIPBLANKS
      END;
      GET(INPUT);   (* skip the terminator *)
    END;  (* of reading trains *)

    BEGIN  (*of gett*)
      NEW(TT);
      WITH TT^ DO BEGIN
        SKIPBLANKS;
        QUOTEDST(TITLE);
        SKIPBLANKS;
        QUOTEDST(S);
        FROM:= STATOFST(S);
        SKIPSPACES;
        QUOTEDST(S);
        DEST := STATOFST(S);
        TRAINS:=NIL;
        READTRAINS;
        GETT:=TT;
      END; (*of with*)
    END;  (*of gett!!*)

(**** Principal output procedure for time tables ********)

  PROCEDURE PRINTT (TT :REFTT);
  VAR
    ATRAIN :REFJOURNEY;
    S :STRING;   (* temp holding variable during output *)

    PROCEDURE SPACES( N :INTEGER);
    BEGIN
      WHILE N>0 DO BEGIN
        WRITE(' ');
        N:=N-1;
      END;
    END; (*spacing*)

    FUNCTION LENGTH (ST :STRING) :INTEGER;
    VAR
      RES :INTEGER;
    BEGIN
      RES:=0;
      REPEAT
        RES:=RES+1
      UNTIL ST[RES]=STREND;
      LENGTH:=RES-1
    END;  (*of length*)

    PROCEDURE CENTRE (ST :STRING; WIDTH :INTEGER; VAR CENT :STRING);
       (* pad out either end with spaces to width*)
    VAR
      LEFT,LGTH,RIGHT :0..MAXSTL; (* strictly MAXSTL-1 *)
    BEGIN
      IF WIDTH >= MAXSTL THEN BEGIN
        WRITE('Width in centre exceeds', MAXSTL-1:3, WIDTH:4);
        PST(ST);
        WRITELN;
        HALT('**** ABORT *****');
      END;
      LEFT:= WIDTH-LENGTH(ST); (*i.e. number neede altogether*)
      IF LEFT <0 THEN BEGIN
        WRITE('Width insufficient in centre ', WIDTH:4, '[');
        PST(ST);
        WRITELN(']');
        HALT('**** ABORT *****');
      END;
         (*parameters O.K.*)
      RIGHT:= LEFT DIV 2;
      LEFT := LEFT-RIGHT;
      FOR LGTH:= 1 TO LEFT DO CENT[LGTH]:=' ';
      FOR LGTH:= 1 TO LENGTH(ST) DO CENT[LEFT+LGTH]:=ST[LGTH];
      LGTH:= LEFT+LENGTH(ST);
      FOR LGTH:= LGTH+1 TO LGTH+RIGHT DO CENT[LGTH]:=' ';
      CENT[WIDTH+1]:=STREND;
    END;  (*of centre*)

    PROCEDURE PRINTJNY (RJ :REFJOURNEY);
          (*departure + arrival + rout synopsis*)
    VAR
      DT :DAYTIME; (* temp holding variablr *)

      PROCEDURE PRINTRS (RS :REFCHANGE);
              (*route synopsis bit*)
      VAR
        DT :DAYTIME;
        S  :STRING;   (*temp holding vars during output*)
      BEGIN  (*initially rj <> nil*)
        REPEAT
          WITH RS^ DO BEGIN
            SPACES(1);
            STROFSTAT(AT,S);
            PST(S);
            WRITE('(');
            DTOFMT(ARRT,DT);
            WRITE(DT);
            WRITE(':',WAIT:3,')' );
            RS:=NEXT;
          END;
        UNTIL RS = NIL;
      END;  (*of printrs*)

    BEGIN
      WITH RJ^ DO BEGIN
        SPACES(4);
        DTOFMT(DEPT,DT);
        WRITE(DT:5);
        SPACES(8);
        DTOFMT(ARRT,DT);
        WRITE(DT:5);
        IF RS <> NIL THEN BEGIN
           SPACES(1);
           PRINTRS(RS);
        END;
        WRITELN;
      END; (*with rj*)
    END; (*print jny*)

  BEGIN  (*printt proper*)
    WITH TT^ DO BEGIN
      WRITELN;
      WRITELN;
      SPACES( (26 - LENGTH(TITLE)) DIV 2 );
      PST(TITLE);
      WRITELN;
      WRITELN;
      STROFSTAT(FROM,S);
      CENTRE(S,13,S);
      PST(S);
      STROFSTAT(DEST,S);
      CENTRE(S,13,S);
      PST(S);
      WRITELN;

      ATRAIN:= TRAINS;
      WHILE ATRAIN <> NIL DO BEGIN
        PRINTJNY(ATRAIN);
        ATRAIN:=ATRAIN^.NEXT;
      END;
      WRITELN;
    END;  (*with tt*)
  END; (*of printt*)

PROCEDURE READIN7;  (* i.e. all given tables *)
  VAR
    N :1..7; (* a control variable*)
    TEMP :REFTT;

    PROCEDURE IDENTIFY(TT :REFTT); (* which one isi it?? *)
    BEGIN
      WITH TT^ DO BEGIN
        CASE FROM OF
        PETERB:  PELY:=TT;
        ELY:     ELYC:=TT;
        LONDX:   LKXR:=TT;
        ROYST:   RC  :=TT;
        LONDL:   LLSC:=TT;
        EDINB: CASE DEST OF
                PETERB: EP:=TT;
               LONDX:  ELKX:=TT;
               END;
        END;
      END; (* of with *)
    END; (* identification *)

  BEGIN
    FOR N:= 1 TO 7 DO BEGIN
      TEMP:= GETT;
      IDENTIFY(TEMP);
    END;
  END; (* of readin7 *)



(* === PREDICATE WHICH DEFINES JOURNEY ORDER WITHIN A TABLE == *)

  FUNCTION INORDER(J1,J2 :REFJOURNEY) :BOOLEAN;
           (* True if j1<=j2 in the ordering defined with
              the type definition of time tables *)
  VAR
    J1ARRT,J2ARRT :INTEGER;
  BEGIN
    IF J2 = NIL THEN
       INORDER := TRUE  (* The end of list case i.e. j1 never nil *)
    ELSE IF J1^.DEPT < J2^. DEPT THEN
      INORDER := TRUE
    ELSE IF J1^.DEPT = J2^.DEPT THEN BEGIN
      J1ARRT:=J1^.ARRT;
      IF J1ARRT < J1^.DEPT THEN J1ARRT:= J1ARRT+MINSPERDAY;
      J2ARRT:= J2^.ARRT;
      IF J2ARRT < J2^.DEPT THEN J2ARRT:= J1ARRT+MINSPERDAY;
      IF J2ARRT <= J1ARRT THEN
        INORDER := TRUE
      ELSE
        INORDER := FALSE
    END ELSE
        INORDER := FALSE
  END;  (* of in order *)


(* == UTILITY FOR CONNECTING & MERGING WHEN, CREATING JOURNEYS ==*)

  FUNCTION COPY (ORIGINAL :REFCHANGE) :REFCHANGE;
           (* make a copy of a changes list *)
  VAR
    RESULT, NEWCHNG, LASTCOPY :REFCHANGE;
  BEGIN
    IF ORIGINAL = NIL THEN
      RESULT := NIL
    ELSE BEGIN
      NEW(NEWCHNG);
      NEWCHNG^:=ORIGINAL^;  (* copy first cell *)
      RESULT:=NEWCHNG;
      LASTCOPY:=NEWCHNG; (* last one copied so far, includes
                          link to next to be copoed *)
      WHILE LASTCOPY^.NEXT<>NIL DO BEGIN
        NEW(NEWCHNG);
        NEWCHNG^:=LASTCOPY^.NEXT^;  (* copy cells *)
        LASTCOPY^.NEXT := NEWCHNG;   (* set up new link *)
        LASTCOPY := NEWCHNG
      END;
    END; (* IF *)
    COPY:=RESULT;   (* the result of function *)
  END; (*  of copying lists of changes *)
(* ===== THE PROCEDURE FOR  MAKING A CONNECTING TIME TABLE  *)


FUNCTION CONNECT (AB,BC :REFTT; MINWT,MAXWT :INTEGER) :REFTT;
        (* Minwt & maxwt are the limits of waiting for connexion
           which are allowed *)
  VAR
    AC :REFTT;  (* Holds the new tt during call *)
    ABJNY :REFJOURNEY;  (* References each ab journey in turn *)

    PROCEDURE MAKECONS;  (* Considers each bc train against given ab train
                            and inserts journey if they connect *)
    VAR
      BCJNY :REFJOURNEY; (* References each bc train in turn *)

      PROCEDURE INSERTJNY (NEWJNY :REFJOURNEY);
                   (* INserts new journey into existing AC table*)
      VAR
        POS, PROBE :REFJOURNEY;
                  (* POS contains ref to journey before new one *)
        FUNCTION FOLLOWS (PROBE :REFJOURNEY) :BOOLEAN;
                        (* TRUE iff new journey follows this one in the
                            ordering described with TT definition*)
        BEGIN
          WITH NEWJNY^ DO BEGIN
            IF PROBE = NIL THEN
              FOLLOWS := FALSE
            ELSE IF PROBE^.DEPT < DEPT THEN
              FOLLOWS := TRUE
            ELSE IF PROBE^.DEPT = DEPT THEN BEGIN
              IF ARRT <= PROBE^.ARRT THEN
                FOLLOWS := TRUE
              ELSE
                FOLLOWS := FALSE
            END ELSE
              FOLLOWS := FALSE
          END
        END;

      BEGIN (* inserting journey *)
        POS := NIL;
        PROBE := AC^.TRAINS;  (* The list to be altered *)
        WHILE FOLLOWS(PROBE) DO BEGIN
                (* New comes after probe so advance it *)
          POS := PROBE;
          PROBE := PROBE^.NEXT;
        END;
             (* INsert new after pos - unless pos =nil *)
        IF POS <> NIL THEN BEGIN
          NEWJNY^.NEXT := POS^.NEXT;
          POS^.NEXT := NEWJNY;
        END ELSE BEGIN
             (* THe list is empty  or newjny goes first  *)
          NEWJNY^.NEXT := AC^.TRAINS;
          AC^.TRAINS := NEWJNY;  (* New link is NIL initially *)
        END;
      END;  (* of inserting a new journey *)
      FUNCTION THEYCONNECT :BOOLEAN; (* Viz: abjny & bcjny *)
      VAR
        WAIT :INTEGER;     (* This procedure assumes all journeys take
                                less than 24 hours *)
      BEGIN
        WAIT := BCJNY^.DEPT - ABJNY^.ARRT;
        IF WAIT <0 THEN WAIT := WAIT+MINSPERDAY; (*  The wait lasts
                                                   over midnight *)
        IF (MINWT<=WAIT) AND (WAIT<=MAXWT) THEN
          THEYCONNECT := TRUE
        ELSE
          THEYCONNECT := FALSE
      END; (* of they connect *)

      FUNCTION COMPOSEJNY :REFJOURNEY; (* Given abjny & bcjny connect
                                       then make up a new journey *)
      VAR
        ACJNY :REFJOURNEY; (* Holds result until end of fn *)

        PROCEDURE MAKERS;  (* Make the new route synopsis
                              from ab & bc bits !!*)
        VAR
          CHNG :REFCHANGE;

          PROCEDURE APPEND( VAR HEAD :REFCHANGE; TAIL :REFCHANGE);
                  (* Tack new changes list onto existing one *)
          VAR
            LAST :REFCHANGE;  (* last in original list *)
          BEGIN
            IF HEAD = NIL THEN
              HEAD:= TAIL    (* Nothing tp append to *)
            ELSE BEGIN
              LAST:=HEAD;
              WHILE LAST^.NEXT <> NIL DO LAST:=LAST^.NEXT;
              LAST^.NEXT:=TAIL;
            END
          END; (* of appending *)


        BEGIN   (* Of make rs*)
          WITH ACJNY^ DO BEGIN
            RS:= COPY(ABJNY^.RS); (* first existing bit *)
                       (* make up the new bit *)
            NEW(CHNG);
            WITH CHNG^ DO BEGIN
              AT:= AB^.DEST;
              ARRT:= ABJNY^.ARRT;
              WAIT:= BCJNY^.DEPT-ARRT;
              IF WAIT<0 THEN WAIT:= WAIT+MINSPERDAY;
              NEXT:=NIL;
            END;
               (* tack on the newly created bit *)
            APPEND (RS, CHNG);
            APPEND(RS, COPY(BCJNY^.RS) );  (* tack on 2nd existing *)
          END; (* with *)
        END;  (* make rs *)

      BEGIN (* of composing new journey *)
        NEW(ACJNY);
        WITH ACJNY^ DO BEGIN
          DEPT:= ABJNY^.DEPT;
          ARRT:= BCJNY^.ARRT;
          MAKERS;
        END;
        COMPOSEJNY := ACJNY; (* the ultimate result *)
      END; (* of composing a journey *)

    BEGIN (* of making connexions *)
      BCJNY := BC^.TRAINS;    (* the first bc journey *)
      WHILE BCJNY <> NIL DO BEGIN
        IF THEYCONNECT THEN INSERTJNY( COMPOSEJNY );
        BCJNY:= BCJNY^.NEXT;
      END;
    END;   (* of make cons *)

  BEGIN (*  of connect proper *)
    NEW(AC);
    WITH AC^ DO BEGIN
      TITLE := AB^.TITLE;
      FROM:= AB^.FROM;
      DEST:= BC^.DEST;
      TRAINS := NIL;

      ABJNY:= AB^.TRAINS;    (* the first ab journey *)
      WHILE ABJNY <> NIL DO BEGIN
        MAKECONS;   (* consider all bc trains as posible connexions
                      to this ab train *)
        ABJNY := ABJNY^.NEXT;
      END;
    END; (* with *)
    CONNECT := AC;    (* ultimate result *)
  END;   (*  of conect  entirely *)




(* == PROCEDURE FOR MERGING 2 DIFFERENT ROUTES TO ONE =====*)

  FUNCTION MERGE (AXB, AYB :REFTT) :REFTT;
  VAR
    XJ,YJ :REFJOURNEY;  (* Those from axb & ayb to be compared *)
    XY :REFTT;   (*  the ultimate result *)
    JHEAD, LAST :REFJOURNEY; (* used in building new journeys *)

    FUNCTION COPYJNY ( ORIGINAL :REFJOURNEY) :REFJOURNEY;
                (* copies a journey , incl. copying rs's *)
    VAR
      NEWJ :REFJOURNEY;  (* the result *)
    BEGIN
      NEW(NEWJ);
      WITH NEWJ^ DO BEGIN
        DEPT := ORIGINAL^.DEPT;
        ARRT := ORIGINAL^.ARRT;
          RS := COPY( ORIGINAL^.RS);
        NEXT := NIL;
      END;
      COPYJNY := NEWJ;
    END;   (* copying a journey *)

  BEGIN
    NEW(XY);
    WITH XY^ DO BEGIN
      TITLE := AXB^.TITLE;
      FROM := AXB^.FROM;
      DEST := AXB^.DEST;
    END;

    (* Now merge copies of the journeys in each *)

    NEW(JHEAD);   (*  A dummy first in list  - for convenience *)
    LAST := JHEAD;  (* I.e. last in new list so far *)

    XJ := AXB^.TRAINS;
    YJ := AYB^.TRAINS;   (* the first pair for comparison *)

    WHILE XJ<>NIL  DO BEGIN (* runs to end of xlist *)
                        (* compare the 2 journeys *)
      IF INORDER(XJ,YJ) THEN BEGIN
        LAST^.NEXT := COPYJNY(XJ);
        XJ := XJ^.NEXT;
      END ELSE BEGIN
        LAST^.NEXT := COPYJNY(YJ);
        YJ := YJ^.NEXT;
      END;
      LAST := LAST^.NEXT;  (* Note latest addition *)
    END;
            (* finish off the YJ  tail *)
    WHILE YJ <> NIL DO BEGIN
      LAST^.NEXT := COPYJNY(YJ);
      LAST := LAST^.NEXT;
      YJ := YJ^.NEXT;
    END;

    (* List has been copied, attach to XY *)

    XY^.TRAINS := JHEAD^.NEXT;  (* omitting dummy *)
    DISPOSE(JHEAD);

    MERGE := XY;    (* ALL DONE *)
  END;  (* of merging *)




(* ===  THIRD MAJOR PROCEDURE, VIZ: REDUCE, MARKS USELESS TRAINS *)

  PROCEDURE REDUCE (VAR TT :TIMETABLE);
                (* It does so by marking their route synopses!! *)
  CONST
    MARKING=TRUE;   (* Indicates tjourneys should be marked*)
    NOTMARKING=FALSE;

  TYPE
    OVERTAKESTATE = (IMPOSSIBLE, POSSIBLE, ACTUAL);
                (* Relationship between 2 journeys v.a.v. overtaking *)
  VAR
    LASTDONE :BOOLEAN; (* true whem all journeys have been tried *)
    LAST :REFJOURNEY;  (* last one in journey list *)
    TRIAL:REFJOURNEY;  (* the one being tried *)
    PROBE:REFJOURNEY;  (* trial is compared with possible probes
                           until overtaking is impossible *)
    USELESS  :CHANGE;  (* the useless marker values *)

    FUNCTION PASSER :OVERTAKESTATE;
              (* could probe overtake trial ? *)
    VAR
      TARRT,PDEPT,PARRT :INTEGER; (* set up to allow for trains
                                     which cross midnight *)
    BEGIN
      TARRT := TRIAL^.ARRT;
      IF TARRT < TRIAL^.DEPT THEN TARRT := TARRT+MINSPERDAY;
                   (* trial crosses midnight *)
      PDEPT := PROBE^.DEPT;
      PARRT := PROBE^.ARRT;
      IF PARRT < PDEPT THEN PARRT:= PARRT+MINSPERDAY;
                  (* probe crosses midnight *)
     IF PDEPT < TRIAL^.DEPT THEN BEGIN
                     (* probe is a next day train *)
       PDEPT := PDEPT+MINSPERDAY;
       PARRT:=  PARRT+MINSPERDAY;
     END;

     PASSER := IMPOSSIBLE;
     IF PDEPT < TARRT THEN
        IF PARRT <= TARRT THEN
          PASSER:= ACTUAL
        ELSE
          PASSER := POSSIBLE;
    END;  (* of deciding passing state *)

    PROCEDURE ADVANCETRIAL ( MARKING :BOOLEAN);
            (* advances trial to next train, possibly marking 
               original as useless, plus noting if it passes
               last *)
    VAR
      MARKER :REFCHANGE;  (* copy of useless *)

    BEGIN
      REPEAT
        IF MARKING AND NOT LASTDONE THEN BEGIN
          NEW(MARKER);
          MARKER^ := USELESS;
          MARKER^.NEXT := TRIAL^.RS;
          TRIAL^.RS:=MARKER;  (*  link in the marker *)
        END;
        IF TRIAL = LAST THEN LASTDONE:=TRUE;
        TRIAL:=TRIAL^.NEXT;
      UNTIL TRIAL = PROBE;
    END;   (* of advancing trial *)


  BEGIN (* of reduce proper *)
           (* set up useless marker *)
     WITH USELESS DO BEGIN
       AT := EDINB;
     ARRT := 0;
     WAIT := 0;
     NEXT := NIL;
     END;

          (* link journeys in circular list, noting end *)
      LAST := TT.TRAINS;
      WHILE LAST^.NEXT <> NIL DO LAST:= LAST^.NEXT;
      LAST^.NEXT := TT.TRAINS;   (* noted & linked around *)

      (* N.B. Assumptions are that:-
              1. journeys <24hours long.
              2. >1 train in table.
              3. for any given journey there always exists another journey
                 which could not possibly overtake it, or it is
                  overtaken. *)

      LASTDONE := FALSE;
      TRIAL := TT.TRAINS;
      PROBE := TRIAL^.NEXT; (* first & 2nd journeys resp. *)

      REPEAT
        CASE PASSER OF
         ACTUAL: BEGIN
                  ADVANCETRIAL(MARKING);
                  PROBE:= PROBE^.NEXT;
                 END;
         POSSIBLE: PROBE:= PROBE^.NEXT;
         IMPOSSIBLE: BEGIN
                        IF TRIAL=LAST THEN LASTDONE := TRUE;
                        TRIAL := TRIAL^.NEXT;
                        PROBE := TRIAL^.NEXT;
                     END;
        END; (* of case *)
      UNTIL LASTDONE;
                      (* all journeys have been tried *)
      LAST^.NEXT := NIL;  (* break the circular list *)
    END;  (* of reducing *)



BEGIN  (* MAIN PROGRAM *)
  READIN7;
  TEMP := CONNECT(ELKX,LKXR,10,120);
  WRITELN('Edinburgh to Roystong via King''s Cross');
  PRINTT(TEMP);

  EXRC := CONNECT(TEMP,RC,10,120);
  WRITELN('Edinburgh to Cambridge via King''s Cross & Royston');
  PRINTT(EXRC);

  TEMP:= CONNECT(EP,PELY,10,120);
  WRITELN('  to Ely via Peterborough');
  PRINTT(TEMP);
  EPEC := CONNECT (TEMP,ELYC,10,120);
  WRITELN(' to Cambridge via Peterboro'', Ely');
  PRINTT(EPEC);

  TEMP := MERGE(EXRC,EPEC);
  WRITELN( '  via Ely or via Royston ');
  PRINTT(TEMP);

  ELSC := CONNECT( ELKX, LLSC, 30,240);
  WRITELN(' via Liverpool St.');
  PRINTT(ELSC);

  TEMP := MERGE (TEMP,ELSC);
  WRITELN(' complete table via 3 routes');
  PRINTT(TEMP);

  REDUCE (TEMP^);
  WRITELN(' The final, reduced, timetable ');
  PRINTT(TEMP);

END.