{$T-}
program ACCOUNTER;
const NL=CHR(10);
      CR=CHR(13);
      FF=CHR(12);
      RAD50HEL=13012;  {RAD50 OF 'HEL'}
      RAD50BYE=4205;   {RAD50 OF 'BYE'}
      RAD50TON=32614;  {RAD50 OF 'TON'}
      RAD50UIC=-31573; {RAD50 OF 'UIC'}
type
PACKET = record
  TSK1    : INTEGER;
  TASK    : INTEGER;
  PROG    : CHAR;
  GROUP   : CHAR;
  DEVICE  : array[0..1] of CHAR;
  UNIT    : INTEGER;
  YEAR    : INTEGER;
  MONTH   : INTEGER;
  DAY     : INTEGER;
  HOUR    : INTEGER;
  MINUTE  : INTEGER;
  SECOND  : INTEGER;
  OLDPROG : CHAR;
  OLDGROUP: CHAR;
  FILL1   : INTEGER;
end;
STATE = (ON,OFF,CHANGE,BOOT);
TIME = record
  HOUR    : INTEGER;
  MINUTE  : INTEGER;
  SECOND  : INTEGER;
end;
NODEPTR = @NODE;
NODE = record
  FWRD    : NODEPTR;
  BACK    : NODEPTR;
  GROUP   : CHAR;
  PROG    : CHAR;
  TOTAL   : TIME;
  STATUS  : STATE;
  CURTIME : TIME;
  NUMTERM : INTEGER;
end;
SEARCHKEY = (NONE,ADD,FOUND,END);
PRINTKEY = (YES,NO);
var
  PACKETFILE : file of PACKET;
  INREC : PACKET;
  LIST  : TEXT;
  LISTHEAD : NODEPTR;
  CURNODE  : NODEPTR;
  THISTIME : TIME;
  THISSTATUS : STATE;
  NEWNODE : NODEPTR;
  SEARCH : SEARCHKEY;
  PACKETGROUP : INTEGER;
  PACKETPROG : INTEGER;
  PRINT : PRINTKEY;
  CH : CHAR;
  LIST_DEVICE : array [0..3] of CHAR;

  function OCTDEC( OCTVAL:INTEGER ) : INTEGER;
    var DECIMAL    : INTEGER;
        REMAINDER  : INTEGER;
        NEWVAL     : INTEGER;
    begin
      DECIMAL := OCTVAL mod 8;
      REMAINDER := OCTVAL div 8;
      if REMAINDER#0 then
       begin
        NEWVAL := OCTDEC(REMAINDER);
        NEWVAL := 10 * NEWVAL;
        DECIMAL := DECIMAL + NEWVAL
       end;
      OCTDEC := DECIMAL;
    end;
  procedure WRITEUNIT( UNIT:INTEGER );
    var DEC : INTEGER;
    begin
      DEC := OCTDEC(UNIT);
      if DEC<10 then WRITE(LIST,'0');
      WRITE(LIST,DEC,':')
    end;
  procedure WRITEUIC( GROUP:INTEGER ; PROG:INTEGER );
    var DEC:INTEGER;
    begin
      DEC := OCTDEC(GROUP);
      WRITE(LIST,'[',DEC:3,',');
      DEC := OCTDEC(PROG);
      WRITE(LIST,DEC:3,']')
    end;
  procedure ADDTIME( var LAST:TIME;var NOW:TIME;var SUM:TIME;FACTOR:INTEGER );
  var DELTA : TIME;
  begin
    DELTA.HOUR := NOW.HOUR - LAST.HOUR;
    if DELTA.HOUR < 0 then DELTA.HOUR := DELTA.HOUR + 24;
    DELTA.MINUTE := NOW.MINUTE - LAST.MINUTE;
    DELTA.SECOND := NOW.SECOND - LAST.SECOND;
    if DELTA.SECOND < 0 then begin
      DELTA.SECOND := DELTA.SECOND + 60;
      DELTA.MINUTE := DELTA.MINUTE - 1
    end;
    if DELTA.MINUTE < 0 then begin
      DELTA.MINUTE := DELTA.MINUTE + 60;
      DELTA.HOUR := DELTA.HOUR - 1
    end;
    DELTA.HOUR := FACTOR * DELTA.HOUR;
    DELTA.MINUTE := FACTOR * DELTA.MINUTE;
    DELTA.SECOND := FACTOR * DELTA.SECOND;
    SUM.HOUR := SUM.HOUR + DELTA.HOUR;
    SUM.MINUTE := SUM.MINUTE + DELTA.MINUTE;
    SUM.SECOND := SUM.SECOND + DELTA.SECOND;
    SUM.MINUTE := SUM.MINUTE +  SUM.SECOND div 60;
    SUM.SECOND := SUM.SECOND mod 60;
    SUM.HOUR := SUM.HOUR + SUM.MINUTE div 60;
    SUM.MINUTE := SUM.MINUTE mod 60;
  end;
  procedure INSERT( LOC:NODEPTR; NEW:NODEPTR );
  begin
    NEW@.FWRD := LOC;       {Forward pointer of NEW points to LOC}
    NEW@.BACK := LOC@.BACK; {Backward pointer of NEW points to LOC's backward}
    LOC@.BACK := NEW;       {Backward pointer of LOC points to NEW}
    NEW@.BACK@.FWRD := NEW; {Forward pointer of node preceeding NEW points to NEW}
  end;

  procedure SETTIME( var SOURCE:TIME; var DEST:TIME );
  begin
    DEST.HOUR := SOURCE.HOUR;
    DEST.MINUTE := SOURCE.MINUTE;
    DEST.SECOND := SOURCE.SECOND
  end;
  procedure SUMMARIZE;
  begin
      CURNODE := LISTHEAD@.FWRD;
      SEARCH := NONE;
      while (CURNODE#LISTHEAD) & (PACKETGROUP>ORD(CURNODE@.GROUP)) do
        CURNODE := CURNODE@.FWRD;
      if CURNODE=LISTHEAD then SEARCH := END
        else if PACKETGROUP=ORD(CURNODE@.GROUP) then
          begin
          while (CURNODE#LISTHEAD) & (PACKETGROUP=ORD(CURNODE@.GROUP))
                & (PACKETPROG>ORD(CURNODE@.PROG)) do
            CURNODE := CURNODE@.FWRD;
          if CURNODE=LISTHEAD then SEARCH := END
            else if PACKETGROUP#ORD(CURNODE@.GROUP) then SEARCH := ADD
            else if PACKETPROG#ORD(CURNODE@.PROG) then SEARCH := ADD
            else SEARCH := FOUND
          end
        else SEARCH := ADD;

      case SEARCH of
        NONE:WRITE(OUT,NL,CR,'Bad error....');
        ADD,END:if THISSTATUS=OFF then
          begin if PRINT=YES then WRITE(LIST,NL,CR,'No logon...') end
            else begin
              NEW(NEWNODE);  INSERT( CURNODE , NEWNODE );
              with NEWNODE@ do begin
                TOTAL.HOUR := 0;
                TOTAL.MINUTE := 0;
                TOTAL.SECOND := 0;
                STATUS := ON;
                SETTIME( THISTIME ,   CURTIME );
                GROUP := INREC.GROUP;
                PROG := INREC.PROG;
                NUMTERM := 1
              end
            end;
        FOUND:if (CURNODE@.STATUS=OFF) & (THISSTATUS=OFF) then
          with CURNODE@ do begin
            if PRINT=YES then WRITE(LIST,NL,CR,'No logon....') end
            else if STATUS=OFF then
              begin
                STATUS:=ON;
                NUMTERM := 1;
                SETTIME( THISTIME , CURTIME )
              end
            else if THISSTATUS=ON then
              begin
                if PRINT=YES then WRITE(LIST,NL,CR,'Double logon...');
                NUMTERM := NUMTERM + 1
              end
            else begin
              ADDTIME(CURTIME,THISTIME,TOTAL,NUMTERM );
              SETTIME( CURTIME , THISTIME );
              NUMTERM := NUMTERM - 1;
              if NUMTERM=0 then STATUS := OFF
            end
          end
  end;

begin
  RESET(PACKETFILE,'[1,1]LOGGER.DAT ');
  LIST_DEVICE[2] := ':'; LIST_DEVICE[3] := ' ';
  WRITE(OUT,NL,CR,'Do you want to print logon summary? (Y/N):');
  BREAK(OUT);  READ(INP,CH);
  WRITE(OUT,NL,CR,'Indicate listing device..  "TI" or "CL">');
  BREAK(OUT);  READ(INP,LIST_DEVICE[0],LIST_DEVICE[1]);
  WRITE(OUT,NL,CR,'Listing device is ',LIST_DEVICE); BREAK(OUT);
  if (CH='Y') ! (CH='y') then PRINT := YES else PRINT := NO;
  if PRINT=YES then REWRITE(LIST,LIST_DEVICE);
  NEW(LISTHEAD);
  with LISTHEAD@ do begin
    FWRD := LISTHEAD;
    BACK := LISTHEAD;
    GROUP := CHR(0);
    PROG := CHR(0);
  end;
  while ~EOF(PACKETFILE) do
    begin
      INREC := PACKETFILE@; GET(PACKETFILE);
      if INREC.TASK=RAD50HEL then THISSTATUS := ON;
      if INREC.TASK=RAD50BYE then THISSTATUS := OFF;
      if INREC.TASK=RAD50TON then THISSTATUS := BOOT;
      if INREC.TASK=RAD50UIC then THISSTATUS := CHANGE;
      PACKETGROUP := ORD(INREC.GROUP);
      PACKETPROG := ORD(INREC.PROG);
      THISTIME.HOUR := INREC.HOUR;
      THISTIME.MINUTE := INREC.MINUTE;
      THISTIME.SECOND := INREC.SECOND;
      if PRINT=YES then begin
        WRITE(LIST,NL,CR,INREC.DEVICE);
        WRITEUNIT( INREC.UNIT );
        WRITEUIC( PACKETGROUP , PACKETPROG );
        if THISSTATUS=ON then WRITE(LIST,' Logged on at   ');
        if THISSTATUS=OFF then WRITE(LIST,' Logged off at  ');
        if THISSTATUS=BOOT then WRITE(LIST,' Booted at      ');
        if THISSTATUS=CHANGE then WRITE(LIST,' Changed UIC at ');
        WRITE(LIST,INREC.HOUR:2,':',INREC.MINUTE:2,':');
        WRITE(LIST,INREC.SECOND:2,' on ',INREC.MONTH:2);
        WRITE(LIST,'/',INREC.DAY:2,'/',INREC.YEAR:2);
      end;
      if THISSTATUS=BOOT then begin
        CURNODE := LISTHEAD@.FWRD;
        while CURNODE#LISTHEAD do begin
          CURNODE@.STATUS := OFF;
          ADDTIME( CURNODE@.CURTIME,THISTIME,CURNODE@.TOTAL,CURNODE@.NUMTERM);
          CURNODE@.NUMTERM := 0;
          CURNODE := CURNODE@.FWRD
        end;
        THISSTATUS := ON
      end;
      if THISSTATUS=CHANGE then begin
        THISSTATUS := ON;
        SUMMARIZE;
        THISSTATUS := OFF;
        PACKETGROUP := ORD(INREC.OLDGROUP);
        PACKETPROG := ORD(INREC.OLDPROG);
        INREC.GROUP := INREC.OLDGROUP;
        INREC.PROG := INREC.OLDPROG
      end;
      SUMMARIZE;
    end;

  REWRITE(LIST,LIST_DEVICE);
  CURNODE := LISTHEAD@.FWRD;
  while CURNODE#LISTHEAD do
    begin
      WRITE(LIST,NL,CR,'Logon time for ');
      WRITEUIC( ORD(CURNODE@.GROUP) , ORD(CURNODE@.PROG) );
      WRITE(LIST,' is ',CURNODE@.TOTAL.HOUR:6,':');
      WRITE(LIST,CURNODE@.TOTAL.MINUTE:2,':');
      WRITE(LIST,CURNODE@.TOTAL.SECOND:2,', and status is ');
      if CURNODE@.STATUS=ON then WRITE(LIST,'logged on.')
        else WRITE(LIST,'logged off.');
      CURNODE := CURNODE@.FWRD
    end;
  BREAK(LIST);
  WRITE(OUT,NL,CR,'I AM DONE....',NL,CR);
  BREAK(OUT)
end.