PROGRAM LdActTbl;

{**************************************************************}
{                                                              }
{ LdActTbl - Load a Printer Action table.                      }
{                                                              }
{ Execute : ldacttbl [<filename>]                              }
{                                                              }
{           If no file name is present on the command line     }
{           then the program asks for one.  If only [RETURN]   }
{           is pressed, then the program exits.                }
{                                                              }
{           The table is loaded into the driver code space.    }
{                                                              }
{**************************************************************}

USES {$U /CCUTIL/CCLIB } CCdefn, CCcrtIO,
                         CCwndIO,
     {$U ccdcpio       } CCdcpIO,
     {$U ACTION.EQU    } BldActEQU;

CONST
       pgmVERSION      =   '[1.0a]';
       pgmNAME         =   'LDACTTBL';
       pgmTITLE        =   'Load Printer Action Table';

TYPE
     pActionTable      =   ^ActionTable;
VAR
     ActTbl :  ActionTable;
     pacttbl : pActionTable;

     FilName : String80;
     F : FILE OF ActionTable;

  PROCEDURE PrintTitle;
  BEGIN
    CrtAction(EraseALL);
    WRITE(pgmNAME, pgmVERSION,' - ', pgmTITLE);
  END;{PrintTitle}

  FUNCTION ChkPrinter : BOOLEAN;
  BEGIN {ChkPrinter}
    IF NOT PrtAvail THEN
       BEGIN
       PrintTitle;
       WRITELN('  ERROR => No printer driver available');
       END;

    ChkPrinter := PrtAvail;
  END; {ChkPrinter}

  FUNCTION Init : BOOLEAN;
  VAR  ior  : INTEGER;
  BEGIN {Init}
    CCcrtIOinit;
    CCwndIOinit;
    CCdcpIOinit;
    CrtAction(DefStrOn);

    FilName := '';

    ior := WinSystem(WsysCmd);
    Init := (ior = 0);
    IF ior <> 0 THEN EXIT(Init);

    Init := ChkPrinter;
  END; {Init}

  FUNCTION GetFname( VAR fname : String80 ) : BOOLEAN;
  BEGIN
    IF argc <> 0 THEN
        BEGIN
        fname := argv[1]^;
        GetFname := TRUE;
        END
    ELSE
        BEGIN
        PrintTitle; WRITELN;
        WRITE('Enter file name : ');
        IF GetString(fname)  <> Escape THEN
           GetFname := LENGTH(fname) <> 0
        ELSE GetFname := FALSE;
        END;
  END; {GetFname}

  FUNCTION GetFile( fname : String80 ) : BOOLEAN;
  BEGIN {GetFile}

    {$I-} RESET(F, fname); {$I+}
    GetFile := (IORESULT = 0);
    IF IORESULT <> 0 THEN
        BEGIN
        WRITE('  ERROR => Cannot open file.');
        EXIT(GetFile);
        END;

    {$I-} READ(F, ActTbl); {$I+}
    GetFile := (IORESULT = 0);
    IF IORESULT <> 0 THEN WRITE('  ERROR => Cannot read file.');

    {$I-} CLOSE(F); {$I+} {close of read should never fail}
  END; {GetFile}

  FUNCTION ValidTable : BOOLEAN;
  {check if table is valid  - all strings length less = to 5}
  VAR OK : BOOLEAN;

     FUNCTION ChkInch(ir : InchRcrd) : BOOLEAN;
     BEGIN
       WITH ir DO
         ChkInch := (LENGTH(SubSprFormAdv)  <= ACTSTRLEN) AND
                    (LENGTH(NrmlFormAdv)    <= ACTSTRLEN);
     END;

     FUNCTION ChkPitch(pr : PitchRcrd) : BOOLEAN;
     BEGIN
       WITH pr DO
         ChkPitch := (LENGTH(NrmlSpacing)  <= ACTSTRLEN) AND
                     (LENGTH(Micro1Extra)  <= ACTSTRLEN) AND
                     (LENGTH(Micro2Extra)  <= ACTSTRLEN) AND
                     (LENGTH(Micro3Extra)  <= ACTSTRLEN);
     END;

  BEGIN
    WITH ActTbl DO
      OK := (LENGTH(ULineOn)  <= ACTSTRLEN) AND
            (LENGTH(ULineOff) <= ACTSTRLEN) AND
            (LENGTH(BoldOn)   <= ACTSTRLEN) AND
            (LENGTH(BoldOff)  <= ACTSTRLEN) AND
            (LENGTH(RevrsLF)  <= ACTSTRLEN) AND
            ChkInch(SixLnInch)  AND
            ChkInch(EightLnIn)  AND
            ChkPitch(Pitch10)   AND
            ChkPitch(Pitch12);

    ValidTable := OK;
    IF NOT OK THEN WRITE('  ERROR => Invalid Table.');
  END; {ValidTable}

  FUNCTION MoveTable(VAR tbladr : pActionTable) : BOOLEAN;
  {if valid then move into driver space if room}
  VAR topdrvrs, botmcode, table : pBytes;
      save108, save10C : ^pBytes;
      l : LONGINT;
      i, tl : INTEGER;

  BEGIN
    save108 := POINTER($108);
    topdrvrs := save108^;
    tbladr := POINTER(ORD4(topdrvrs));
    save10C := POINTER($10C);
    botmcode := save10C^;
    l := ORD4(botmcode) - ORD4(topdrvrs);
    MoveTable := FALSE;

    IF l > SIZEOF(ActTbl) THEN
         BEGIN
         MoveTable := TRUE;
         tl := SIZEOF(ActTbl);
         IF ODD(tl) THEN tl := tl + 1;
         save108^ := POINTER(ORD4(topdrvrs) + tl);
         table := @ActTbl;
         FOR i := 0 TO (tl - 1) DO
              topdrvrs^[i] := table^[i];
         END
    ELSE WRITE('  ERROR => No room for Table.');
  END; {MoveTable}

  FUNCTION InstalTbl(tbladr : pActionTable) : BOOLEAN;
  {if moved to driver space then make unitstatus call to driver}
  BEGIN
    UNITSTATUS( PRT, tbladr^, FCINSTACT );
    InstalTbl := (IORESULT = 0);
    IF IORESULT <> 0 THEN WRITE('  ERROR => Failed to install Table.');
  END; {InstalTbl}

  PROCEDURE RemovTbl;
  VAR topdrvrs, botmcode, table : pBytes;
      save108, save10C : ^pBytes;
      tl : INTEGER;

  BEGIN
    save108 := POINTER($108);
    topdrvrs := save108^;
    save10C := POINTER($10C);
    botmcode := save10C^;

    tl := SIZEOF(ActTbl);
    IF ODD(tl) THEN tl := tl + 1;
    save108^ := POINTER(ORD4(topdrvrs) - tl);
  END;

  PROCEDURE LdFile( fname : String80 );
  BEGIN
    PrintTitle;
    IF GetFile(fname) THEN
       IF ValidTable THEN
          IF MoveTable(pacttbl) THEN
             IF NOT InstalTbl(pacttbl) THEN RemovTbl;
  END; {LdFile}

BEGIN {LdPrtAlt}
  IF Init THEN
       IF GetFname(FilName) THEN LdFile(FilName);
END. {LdPrtAlt}