MODULE PSPRINT;

(* Author:         Andrew Trevorrow
   Implementation: University of Hamburg Modula-2 under VAX/VMS version 4.x
   Date Started:   July, 1986
   Released:       September, 1986 (version 1.0)

   Description:
   PSPRINT can print a variety of file formats on a range of PostScript
   printers.  See the PSPRINT User Guide and System Guide for more details.
   Much of the command line parsing is done by DCL according to PSPRINT.CLD.
   Most of the semantic checking is done here.  If everything seems okay then
   we run a device-specific command file.

   If /DEVICE=LW then we do @TEX_PS:LW_PRINT P1 P2 P3 P4 P5 P6 P7 P8
   where
      P1 = complete file specification
      P2 = file format (DVI or PS or TEXT or TWO or WIDE)
      P3 = options for PSDVI
      P4 = options for PRINT
      P5 = /NOTE value ("" if not used)
      P6 = /COPIES value (1 if not used)
      P7 = /OUTPUT value ("" if not used)
      P8 = "bbbb<prep>" where b = Y or N and represents the status of the
           boolean qualifiers /DELETE, /LANDSCAPE, /BANNER, /MANUALFEED
           and <prep> is the /PREP value

   If /DEVICE=PS40 then we do @TEX_PS:PS40_PRINT P1 P2 P3 P4 P5 P6 P7 P8
   where P1 to P7 are as above but
      P8 = "bb<prep>" where b = Y or N and represents the status of the
           boolean qualifiers /DELETE, /LANDSCAPE
           and <prep> is the /PREP value

   If /DEVICE=LINO then we do @TEX_PS:LINO_PRINT P1 P2 P3 P4 P5 P6 P7 P8
   where P1 to P7 are as above but
      P8 = "bbbbbsss<prep>" where b = Y or N and represents the status of the
           boolean qualifiers /DELETE, /LANDSCAPE, /CUTMARKS, /LOWRES, /BANNER
           and sss = /SIZE value (PSPRINT.CLD defines legal values and default)
           and <prep> is the /PREP value

   Note that DCL allows a maximum of 8 parameters, so a lot of information
   has to be packed into P8.

   Revised:
   January, 1987
 - The /REVERSE qualifier is no longer used.  The order in which DVI pages
   are translated (by PSDVI) is best left specified in the COM file.
   (Note that /NOREVERSE on PSPRINT never actually worked!)
 - Released version 1.1 in January, 1987

   November, 1987 (while at The Open University)
 - Added /DEVICE qualifier.  PSPRINT needs to run a different command file
   for each type of PostScript printer currently supported.
 - Added /CONSERVE_VM and /NOCONSERVE_VM qualifiers.  If neither is present
   then a default setting is used that depends on the /DEVICE value.
 - Added Linotronic-specific qualifiers (/CUTMARKS, /LOWRES, /SIZE).
   These are simply ignored if /DEVICE does not equal LINO.
 - Released version 2.0 in December, 1987

   June--August, 1988 (while at Aston University)
 - Added /QUEUE qualifier for sites with more than one printer.
 - Added /BANNER and /MANUALFEED qualifiers for LW.
 - Added /TWO and /WIDE text formats.
 - Added /OUTPUT qualifer so user can save PostScript output in a given file
   rather than send it to a print queue.
 - The /REVERSE qualifier is back in again!  It is treated like /CONSERVE_VM.
 - Added /INCREMENT qualifier to simplify both-sided printing.
 - Added /FONT_DIRECTORY qualifier to allow users to override the default
   font directory used by PSDVI.  This could be handy for Metafont users.
 - Added more PSDVI qualifiers: /HOFFSET, /VOFFSET, /XSIZE, /YSIZE,
   /RESOLUTION, /PSPREFIX, /TFM_DIRECTORY and /DUMMY_FONT.
   Most users will never need to use any of these.
 - All these new qualifiers have required some reorganisation of the
   parameters passed into the various command files.
 - Released version 3.0 in August, 1988

   September--October, 1989 (while at Aston University, 2nd time)
 - Added /BANNER qualifier for LINO.
 - Added /PREP qualifier so user can include a modified Laser Prep.
 - /REVERSE and /CONSERVE_VM defaults are now specified in the
   device-specific COM files.
 - Released version 3.1 in October, 1989
*)

FROM VMS IMPORT
   SYS$EXIT;

FROM CommandLanguageInterface IMPORT
   CLI$PRESENT, CLI$GET_VALUE;

FROM CommonInputOutputProcedures IMPORT
   LIB$DO_COMMAND;

FROM FileSystem IMPORT
   File, Open, Name, Done, Close;

FROM InOut IMPORT
   Write, WriteString, WriteLn;


CONST
   NULL = 0C;   (* SYSDEP: terminates a non-full string *)

TYPE
   string = ARRAY [0..79] OF CHAR;

VAR
   filespec, ext, device, value : string;
   status  : CARDINAL;
   f       : File;
   command : ARRAY [0..255] OF CHAR;
   format  : (dvifile,psfile,textfile,twofile,widefile);
   printer : (LINO,LW,PS40);


(******************************************************************************)

PROCEDURE GetValue (qualifier : ARRAY OF CHAR;
                    VAR s     : ARRAY OF CHAR) : BOOLEAN;

(* GetValue should only be called for those qualifiers that have a value.
   If given qualifier is present then we get value and return TRUE,
   otherwise FALSE.
*)

VAR i, status : CARDINAL;

BEGIN
IF ODD(CLI$PRESENT(qualifier)) THEN
   status := CLI$GET_VALUE(qualifier,s);   (* PSPRINT.CLD ensures value *)
   i := HIGH(s);
   WHILE (i > 0) AND (s[i] = ' ') DO       (* remove trailing blanks *)
      s[i] := NULL;                        (* SYSDEP: pad with NULLs *)
      DEC(i);
   END;
   RETURN TRUE;
ELSE
   s[0] := NULL;
   RETURN FALSE;
END;
END GetValue;

(******************************************************************************)

PROCEDURE ExplicitExt (fname   : ARRAY OF CHAR;
                       VAR ext : ARRAY OF CHAR) : BOOLEAN;

(* SYSDEP: VAX/VMS files have an extension of the form ".xxx...xxx;version".
   If the given file specification contains an extension then
   TRUE is returned (and ext will be string after '.' but before any ';').
*)

VAR i, l, pos : CARDINAL;   ch : CHAR;

BEGIN
pos := LEN(fname);
l := pos;
ext[0] := NULL;
WHILE pos > 0 DO       (* search backwards looking for . or : or ] *)
   DEC(pos);
   ch := fname[pos];
   IF ch = '.' THEN    (* extract extension *)
      i := 0;
      INC(pos);
      WHILE (pos <= HIGH(fname))
            AND (fname[pos] <> NULL) AND (fname[pos] <> ';') DO
         ext[i] := fname[pos];
         INC(i); INC(pos);
      END;
      IF i <= HIGH(ext) THEN ext[i] := NULL END;
      RETURN TRUE;
   ELSIF (ch = ':') OR (ch = ']') THEN   (* don't need to look further *)
      RETURN FALSE;
   END;
END;
RETURN FALSE;
END ExplicitExt;

(******************************************************************************)

PROCEDURE Append (VAR s1 : ARRAY OF CHAR; s2 : ARRAY OF CHAR);

(* Append s2 to s1. *)

VAR i, j : CARDINAL;

BEGIN
i := LEN(s1);
j := 0;
WHILE (i <= HIGH(s1)) AND (j <= HIGH(s2)) AND (s2[j] <> NULL) DO
   s1[i] := s2[j];
   INC(i);
   INC(j);
END;
(* check for overflow *)
IF (i > HIGH(s1)) AND (j <= HIGH(s2)) AND (s2[j] <> NULL) THEN
   WriteString('No room to append '); WriteString(s2); WriteLn;
   ErrorHalt;
END;
IF i <= HIGH(s1) THEN s1[i] := NULL END;
END Append;

(******************************************************************************)

PROCEDURE Equal (s1 : ARRAY OF CHAR; s2 : ARRAY OF CHAR) : BOOLEAN;

(* Return TRUE iff s1 = s2. *)

VAR i : CARDINAL;

BEGIN
i := 0;
LOOP
   IF (i > HIGH(s1)) OR (s1[i] = NULL) THEN      (* end of s1 *)
      RETURN (i > HIGH(s2)) OR (s2[i] = NULL);
   ELSIF (i > HIGH(s2)) OR (s2[i] = NULL) THEN   (* end of s2 *)
      RETURN s1[i] = NULL;
   ELSIF s1[i] <> s2[i] THEN
      RETURN FALSE;
   END;
   INC(i);
END;
END Equal;

(******************************************************************************)

PROCEDURE ErrorHalt;

(* Call SYS$EXIT with a magic number that will set ERROR status without
   causing any spurious CLI message.
*)

VAR dummy : CARDINAL;

BEGIN
dummy := SYS$EXIT(10000002H);
END ErrorHalt;

(******************************************************************************)

PROCEDURE AppendFilespec;

BEGIN
IF GetValue('FILESPEC',filespec) THEN
   IF NOT ExplicitExt(filespec,ext) THEN   (* assume DVI file if no extension *)
      Append(filespec,'.DVI');             (* append .DVI *)
      format := dvifile;
   ELSIF Equal(ext,'DVI') THEN
      format := dvifile;
   ELSIF Equal(ext,'PS') THEN
      format := psfile;                    (* PostScript file *)
   ELSE
      format := textfile;                  (* ordinary text file *)
   END;
   Open(f,filespec,FALSE);
   IF Done() THEN                          (* given file exists *)
      Name(f,filespec);                    (* full file specification *)
      Append(command,filespec);
      Close(f);
   ELSE
      WriteString("Couldn't open ");
      WriteString(filespec); Write('!'); WriteLn;
      ErrorHalt;
   END;
ELSE
   (* PSPRINT.CLD should prevent this ever happening, but play safe *)
   WriteString('File not given!'); WriteLn;
   ErrorHalt;
END;
END AppendFilespec;

(******************************************************************************)

PROCEDURE AppendFormat;

(* /DVI, /PS, /TEXT, /TWO or /WIDE can override the implicit file format.
   PSPRINT.CLD should ensure that only one of these is allowed.
*)

BEGIN
IF ODD(CLI$PRESENT('DVI')) THEN
   format := dvifile;
ELSIF ODD(CLI$PRESENT('PS')) THEN
   format := psfile;
ELSIF ODD(CLI$PRESENT('TEXT')) THEN
   format := textfile;
ELSIF ODD(CLI$PRESENT('TWO')) THEN
   format := twofile;
ELSIF ODD(CLI$PRESENT('WIDE')) THEN
   format := widefile;
END;
CASE format OF
   dvifile  : Append(command,' DVI');
 | psfile   : Append(command,' PS');
 | textfile : Append(command,' TEXT');
 | twofile  : Append(command,' TWO');
 | widefile : Append(command,' WIDE');
ELSE
   WriteString('BUG! Unknown file format!'); WriteLn;
   ErrorHalt;
END;
END AppendFormat;

(******************************************************************************)

PROCEDURE DVIcheck (qual : ARRAY OF CHAR);

(* The given qualifier is only allowed with a DVI file. *)

BEGIN
IF format <> dvifile THEN
   WriteString(qual);
   WriteString(' is only allowed with a DVI file!'); WriteLn;
   ErrorHalt;
END;
END DVIcheck;

(******************************************************************************)

PROCEDURE AppendPSDVIoptions;

(* Check for the PSDVI qualifiers allowed by PSPRINT.CLD. *)

BEGIN
Append(command,' "');
IF GetValue('PAGES',value) THEN
   DVIcheck('/PAGES');   Append(command,'/PAG=');   Append(command,value);
END;
IF GetValue('INCREMENT',value) THEN
   DVIcheck('/INC');     Append(command,'/INC=');   Append(command,value);
END;
IF GetValue('MAGNIFICATION',value) THEN
   DVIcheck('/MAG');     Append(command,'/MAG=');   Append(command,value);
END;
IF GetValue('UNITS',value) THEN
   DVIcheck('/UNITS');   Append(command,'/UN=');    Append(command,value);
END;
IF GetValue('HOFFSET',value) THEN
   DVIcheck('/HOFF');    Append(command,'/HOFF=');  Append(command,value);
END;
IF GetValue('VOFFSET',value) THEN
   DVIcheck('/VOFF');    Append(command,'/VOFF=');  Append(command,value);
END;
IF GetValue('XSIZE',value) THEN
   DVIcheck('/XSIZE');   Append(command,'/XSIZ=');  Append(command,value);
END;
IF GetValue('YSIZE',value) THEN
   DVIcheck('/YSIZE');   Append(command,'/YSIZ=');  Append(command,value);
END;
IF GetValue('TFM_DIRECTORY',value) THEN
   DVIcheck('/TFM');     Append(command,'/TFM=');   Append(command,value);
END;
IF GetValue('PSPREFIX',value) THEN
   DVIcheck('/PSPRE');   Append(command,'/PSPR=');  Append(command,value);
END;
IF GetValue('FONT_DIRECTORY',value) THEN
   DVIcheck('/FONT');    Append(command,'/FONT=');  Append(command,value);
END;
IF GetValue('DUMMY_FONT',value) THEN
   DVIcheck('/DUMMY');   Append(command,'/DUMM=');  Append(command,value);
END;
IF GetValue('RESOLUTION',value) THEN
   DVIcheck('/RES');     Append(command,'/RES=');   Append(command,value);
END;
IF ODD(CLI$PRESENT('STATS')) THEN
   DVIcheck('/STATS');   Append(command,'/ST');
END;
IF ODD(CLI$PRESENT('CONSERVE_VM')) THEN
   DVIcheck('/CONS');    Append(command,'/CONS');
ELSIF ODD(CLI$PRESENT('NOCONSERVE_VM')) THEN
   DVIcheck('/NOCONS');  Append(command,'/NOCONS');
END;
IF ODD(CLI$PRESENT('REVERSE')) THEN
   DVIcheck('/REV');     Append(command,'/REV');
ELSIF ODD(CLI$PRESENT('NOREVERSE')) THEN
   DVIcheck('/NOREV');   Append(command,'/NOREV');
END;
Append(command,'"');
END AppendPSDVIoptions;

(******************************************************************************)

PROCEDURE AppendPRINToptions;

BEGIN
Append(command,' "');
IF ODD(CLI$PRESENT('NOTIFY')) THEN         (* /NOTIFY given *)
   Append(command,'/NOTI');
ELSE
   Append(command,'/NONOTI');
END;
IF GetValue('FORM',value) THEN             (* /FORM=formtype given *)
   Append(command,'/FORM=');
   Append(command,value);
END;
IF GetValue('QUEUE',value) THEN            (* /QUEUE=qname given *)
   Append(command,'/QUE=');
   Append(command,value);
END;
Append(command,'"');
END AppendPRINToptions;

(******************************************************************************)

PROCEDURE AppendNote;

VAR i : INTEGER;

BEGIN
Append(command,' "');
IF GetValue('NOTE',value) THEN
   IF printer = PS40 THEN
      (* PrintServer 40 handles any (,),\ characters in /NOTE value *)
      Append(command,value);
   ELSE
      (* For LaserWriter and Linotronic we must
         make sure that any (,),\ characters are prefixed with \
         otherwise we'll probably get a PostScript error when storing
         the /NOTE value into a string.  This kludge should not be necessary
         for the other string values that appear on the banner page.
      *)
      FOR i := 0 TO LEN(value)-1 DO
         CASE value[i] OF
            '(' : Append(command,'\(');
          | ')' : Append(command,'\)');
          | '\' : Append(command,'\\');
         ELSE     Append(command,value[i]);
         END;
      END;
   END;
END;
Append(command,'"');
END AppendNote;

(******************************************************************************)

PROCEDURE AppendCopies;

BEGIN
IF GetValue('COPIES',value) THEN
   Append(command,' ');
   Append(command,value);
ELSE
   Append(command,' 1');
END;
END AppendCopies;

(******************************************************************************)

PROCEDURE AppendOutput;

BEGIN
IF GetValue('OUTPUT',value) THEN
   Append(command,' ');
   Append(command,value);
ELSE
   Append(command,' ""');
END;
END AppendOutput;

(******************************************************************************)

PROCEDURE AppendPrep;

BEGIN
IF GetValue('PREP',value) THEN
   Append(command,value);
END;
END AppendPrep;

(******************************************************************************)

PROCEDURE AppendLWFlags;

BEGIN
Append(command,' "');
IF ODD(CLI$PRESENT('DELETE')) THEN
   Append(command,'Y');                    (* /DELETE *)
ELSE
   Append(command,'N');
END;
IF ODD(CLI$PRESENT('LANDSCAPE')) THEN
   Append(command,'Y');                    (* /LANDSCAPE *)
ELSE
   Append(command,'N');
END;
IF ODD(CLI$PRESENT('BANNER')) THEN
   Append(command,'Y');                    (* /BANNER *)
ELSE
   Append(command,'N');
END;
IF ODD(CLI$PRESENT('MANUALFEED')) THEN
   Append(command,'Y');                    (* /MANUALFEED *)
ELSE
   Append(command,'N');
END;
AppendPrep;                                (* /PREP *)
Append(command,'"');
END AppendLWFlags;

(******************************************************************************)

PROCEDURE AppendLINOFlags;

BEGIN
Append(command,' "');
IF ODD(CLI$PRESENT('DELETE')) THEN
   Append(command,'Y');                    (* /DELETE *)
ELSE
   Append(command,'N');
END;
IF ODD(CLI$PRESENT('LANDSCAPE')) THEN
   Append(command,'Y');                    (* /LANDSCAPE *)
ELSE
   Append(command,'N');
END;
IF ODD(CLI$PRESENT('CUTMARKS')) THEN
   Append(command,'Y');                    (* /CUTMARKS *)
ELSE
   Append(command,'N');
END;
IF ODD(CLI$PRESENT('LOWRES')) THEN
   Append(command,'Y');                    (* /LOWRES *)
ELSE
   Append(command,'N');
END;
IF ODD(CLI$PRESENT('BANNER')) THEN
   Append(command,'Y');                    (* /BANNER *)
ELSE
   Append(command,'N');
END;
IF GetValue('SIZE',value) THEN             (* /SIZE value *)
   Append(command,value);
ELSE
   Append(command,'???');                  (* PSPRINT.CLD should prevent this *)
END;
AppendPrep;                                (* /PREP *)
Append(command,'"');
END AppendLINOFlags;

(******************************************************************************)

PROCEDURE AppendPS40Flags;

BEGIN
Append(command,' "');
IF ODD(CLI$PRESENT('DELETE')) THEN
   Append(command,'Y');                    (* /DELETE *)
ELSE
   Append(command,'N');
END;
IF ODD(CLI$PRESENT('LANDSCAPE')) THEN
   Append(command,'Y');                    (* /LANDSCAPE *)
ELSE
   Append(command,'N');
END;
AppendPrep;                                (* /PREP *)
Append(command,'"');
END AppendPS40Flags;

(******************************************************************************)

BEGIN
IF GetValue('DEVICE',device) THEN
   IF Equal(device,'LW') THEN
      printer := LW;
      command := '@TEX_PS:LW_PRINT ';
   ELSIF Equal(device,'LINO') THEN
      printer := LINO;
      command := '@TEX_PS:LINO_PRINT ';
   ELSIF Equal(device,'PS40') THEN
      printer := PS40;
      command := '@TEX_PS:PS40_PRINT ';
   ELSE
      (* PSPRINT.CLD should prevent this ever happening, but play safe *)
      WriteString('Unexpected /DEVICE value: ');
      WriteString(device); WriteLn;
      ErrorHalt;
   END;
ELSE
   (* PSPRINT.CLD should prevent this ever happening, but play safe *)
   WriteString('/DEVICE value not present!'); WriteLn;
   ErrorHalt;
END;
AppendFilespec;              (* P1 *)
AppendFormat;                (* P2 *)
AppendPSDVIoptions;          (* P3 *)
AppendPRINToptions;          (* P4 *)
AppendNote;                  (* P5 *)
AppendCopies;                (* P6 *)
AppendOutput;                (* P7 *)
CASE printer OF              (* P8 is device-specific *)
   LW   : AppendLWFlags;
|  LINO : AppendLINOFlags;
|  PS40 : AppendPS40Flags;
END;
(* DEBUG
WriteString(command); WriteLn;
GUBED *)
status := LIB$DO_COMMAND(command);
(* we should never get here *)
WriteString('BUG! Error in DO_COMMAND!'); WriteLn; ErrorHalt;
END PSPRINT.