IMPLEMENTATION MODULE Options;

(* Author:         Andrew Trevorrow
   Implementation: University of Hamburg Modula-2 under VAX/VMS version 4
   Date Started:   August, 1986

   Description:
   This module uses CLI routines to extract the DVI file parameter
   and qualifier values from the PSDVI command line.

   Revised:
   November, 1987 (while at The Open University)
 - Added /TFM_DIRECTORY and /CONSERVE_VM qualifiers.

   June--August, 1988 (while at Aston University)
 - Added /PSPREFIX, /INCREMENT, /HOFFSET and /VOFFSET qualifiers.
*)

FROM CommandLanguageInterface IMPORT
   CLI$PRESENT,
   CLI$GET_VALUE;

FROM Conversions IMPORT
   StringToCard, StringToReal, Done;

FROM TermOut IMPORT
   Write, WriteString, WriteLn, Halt;

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

VAR
   value : stringvalue;   (* temporary string *)

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

PROCEDURE GetDVIFile;

(* Get DVI file name from command line. *)

VAR i, status : CARDINAL;

BEGIN
DVIname := '';
status := CLI$GET_VALUE('FILESPEC',DVIname);   (* CLD ensures it is there *)
i := HIGH(DVIname);
WHILE (i > 0) AND (DVIname[i] = ' ') DO        (* remove trailing blanks *)
   DVIname[i] := NULL;                         (* SYSDEP: pad with NULLs *)
   DEC(i);
END;
IF DVIname[i] = ':' THEN                       (* assume logical name *)
   (* no need to translate *)
ELSE
   INC(i);   (* = LEN(DVIname) *)
   IF NOT ExplicitExt(DVIname) THEN            (* append .DVI *)
      IF i + 3 <= HIGH(DVIname) THEN
         DVIname[i]   := '.';
         DVIname[i+1] := 'D';
         DVIname[i+2] := 'V';
         DVIname[i+3] := 'I';
      ELSE   (* user has given a mighty long file spec! *)
         WriteString('DVI file specification is too long!'); WriteLn;
         WriteString(DVIname); WriteLn;
         Halt(2);
      END;
   END;
END;
(* bad DVIname will be detected upon open in main module *)
END GetDVIFile;

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

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

(* SYSDEP: VAX/VMS files have an extension of the form ".xxx", also known as
   the file type.  If given file specification contains an extension then
   TRUE is returned, otherwise FALSE.
*)

VAR pos : CARDINAL;   ch : CHAR;

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

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

PROCEDURE GetCardinal (qualifier : ARRAY OF CHAR; VAR n : CARDINAL);

(* Check if qualifier is present.  If so, then make sure given value is
   a positive integer, and return via n.  If not present then return 0.
*)

VAR i, status : CARDINAL;

BEGIN
IF ODD(CLI$PRESENT(qualifier)) THEN             (* CLD ensures it has a value *)
   status := CLI$GET_VALUE(qualifier,value);
   i := HIGH(value);
   WHILE (i > 0) AND (value[i] = ' ') DO        (* remove trailing blanks *)
      value[i] := NULL;                         (* SYSDEP: pad with NULLs *)
      DEC(i);
   END;
   n := StringToCard(value);
   IF Done() AND (n > 0) THEN
      (* return *)
   ELSE
      WriteString('Bad /'); WriteString(qualifier);
      WriteString(' value: '); WriteString(value); WriteLn;
      WriteString('Specify a positive integer.'); WriteLn;
      Halt(2);
   END;
ELSE
   n := 0;                                      (* qualifier not present *)
END;
END GetCardinal;

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

PROCEDURE GetPosDimension (qualifier : ARRAY OF CHAR; VAR pixels : CARDINAL);

(* Check if qualifier is present.  If so, then make sure given value is
   a valid positive dimension, convert and return via pixels.
   A valid positive dimension consists of a positive integer or real number
   followed by a two-letter unit in any case.
*)

VAR
   i, status : CARDINAL;
   r : REAL;
   ch1, ch2 : CHAR;
   units : validunits;

BEGIN
IF ODD(CLI$PRESENT(qualifier)) THEN             (* CLD ensures it has a value *)
   status := CLI$GET_VALUE(qualifier,value);
   i := HIGH(value);
   WHILE (i > 0) AND (value[i] = ' ') DO        (* remove trailing blanks *)
      value[i] := NULL;                         (* SYSDEP: pad with NULLs *)
      DEC(i);
   END;
   IF i = 0 THEN i := 1 END;
   (* extract units *)
   IF    (Cap(value[i-1]) = 'I') AND (Cap(value[i]) = 'N') THEN
      units := in;
   ELSIF (Cap(value[i-1]) = 'C') AND (Cap(value[i]) = 'M') THEN
      units := cm;
   ELSIF (Cap(value[i-1]) = 'M') AND (Cap(value[i]) = 'M') THEN
      units := mm;
   ELSIF (Cap(value[i-1]) = 'P') AND (Cap(value[i]) = 'C') THEN
      units := pc;
   ELSIF (Cap(value[i-1]) = 'P') AND (Cap(value[i]) = 'T') THEN
      units := pt;
   ELSIF (Cap(value[i-1]) = 'B') AND (Cap(value[i]) = 'P') THEN
      units := bp;
   ELSIF (Cap(value[i-1]) = 'P') AND (Cap(value[i]) = 'X') THEN
      units := px;
   ELSE
      WriteString('Bad units in /'); WriteString(qualifier);
      WriteString(' dimension: '); WriteString(value); WriteLn;
      WriteString('Last two letters should be IN, CM, MM, PC, PT, BP or PX.');
      WriteLn;
      Halt(2);
   END;
   ch1 := value[i-1];             (* remember letters in units *)
   ch2 := value[i];
   value[i]   := NULL;            (* remove units *)
   value[i-1] := NULL;
   r := StringToReal(value);
   IF Done() AND (r > 0.0) THEN   (* convert r to pixels *)
      CASE units OF
         in : pixels := TRUNC(r * FLOAT(resolution) + 0.5) |
         cm : pixels := TRUNC((r / 2.54) * FLOAT(resolution) + 0.5) |
         mm : pixels := TRUNC((r / 25.4) * FLOAT(resolution) + 0.5) |
         pc : pixels := TRUNC((r / 72.27) * 12.0 * FLOAT(resolution) + 0.5) |
         pt : pixels := TRUNC((r / 72.27) * FLOAT(resolution) + 0.5) |
         bp : pixels := TRUNC((r / 72.0) * FLOAT(resolution) + 0.5) |
         px : pixels := TRUNC(r + 0.5)
      END;
   ELSE
      value[i-1] := ch1;          (* restore units *)
      value[i]   := ch2;
      WriteString('Bad /'); WriteString(qualifier);
      WriteString(' value: '); WriteString(value); WriteLn;
      WriteString('Specify a positive dimension.'); WriteLn;
      Halt(2);
   END;
ELSE
   pixels := 0;                   (* qualifier not present *)
END;
END GetPosDimension;

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

PROCEDURE GetDimension (qualifier : ARRAY OF CHAR; VAR pixels : INTEGER);

(* Check if qualifier is present.  If so, then make sure given value is
   a valid dimension, convert and return via pixels.
   A valid dimension consists of an integer or real number (possibly negative)
   followed by a two-letter unit in any case.
*)

VAR
   i, status : CARDINAL;
   r : REAL;
   ch1, ch2 : CHAR;
   units : validunits;

BEGIN
IF ODD(CLI$PRESENT(qualifier)) THEN             (* CLD ensures it has a value *)
   status := CLI$GET_VALUE(qualifier,value);
   i := HIGH(value);
   WHILE (i > 0) AND (value[i] = ' ') DO        (* remove trailing blanks *)
      value[i] := NULL;                         (* SYSDEP: pad with NULLs *)
      DEC(i);
   END;
   IF i = 0 THEN i := 1 END;
   (* extract units *)
   IF    (Cap(value[i-1]) = 'I') AND (Cap(value[i]) = 'N') THEN
      units := in;
   ELSIF (Cap(value[i-1]) = 'C') AND (Cap(value[i]) = 'M') THEN
      units := cm;
   ELSIF (Cap(value[i-1]) = 'M') AND (Cap(value[i]) = 'M') THEN
      units := mm;
   ELSIF (Cap(value[i-1]) = 'P') AND (Cap(value[i]) = 'C') THEN
      units := pc;
   ELSIF (Cap(value[i-1]) = 'P') AND (Cap(value[i]) = 'T') THEN
      units := pt;
   ELSIF (Cap(value[i-1]) = 'B') AND (Cap(value[i]) = 'P') THEN
      units := bp;
   ELSIF (Cap(value[i-1]) = 'P') AND (Cap(value[i]) = 'X') THEN
      units := px;
   ELSE
      WriteString('Bad units in /'); WriteString(qualifier);
      WriteString(' dimension: '); WriteString(value); WriteLn;
      WriteString('Last two letters should be IN, CM, MM, PC, PT, BP or PX.');
      WriteLn;
      Halt(2);
   END;
   ch1 := value[i-1];             (* remember letters in units *)
   ch2 := value[i];
   value[i]   := NULL;            (* remove units *)
   value[i-1] := NULL;
   r := StringToReal(value);
   IF Done() THEN                 (* convert r to pixels *)
      CASE units OF
         in : pixels := TRUNC(ABS(r) * FLOAT(resolution) + 0.5) |
         cm : pixels := TRUNC((ABS(r)/2.54) * FLOAT(resolution) + 0.5) |
         mm : pixels := TRUNC((ABS(r)/25.4) * FLOAT(resolution) + 0.5) |
         pc : pixels := TRUNC((ABS(r)/72.27) * 12.0 * FLOAT(resolution) + 0.5) |
         pt : pixels := TRUNC((ABS(r)/72.27) * FLOAT(resolution) + 0.5) |
         bp : pixels := TRUNC((ABS(r)/72.0) * FLOAT(resolution) + 0.5) |
         px : pixels := TRUNC(ABS(r) + 0.5)
      END;
      IF r < 0.0 THEN pixels := -pixels END;
   ELSE
      value[i-1] := ch1;          (* restore units *)
      value[i]   := ch2;
      WriteString('Bad /'); WriteString(qualifier);
      WriteString(' value: '); WriteString(value); WriteLn;
      WriteString('Specify a valid dimension.'); WriteLn;
      Halt(2);
   END;
ELSE
   pixels := 0;                   (* qualifier not present *)
END;
END GetDimension;

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

PROCEDURE Cap (ch : CHAR) : CHAR;

(* Hamburg's CAP is stupid; do my own. *)

BEGIN
IF (ch < 'a') OR (ch > 'z') THEN
   RETURN ch;
ELSE
   RETURN CAP(ch);
END;
END Cap;

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

PROCEDURE GetString (qualifier : ARRAY OF CHAR;
                     VAR s     : ARRAY OF CHAR);

(* Check if qualifier is present.  If so, then get value and return via s.
   If qualifier not present then return empty string.
*)

VAR i, status : CARDINAL;

BEGIN
IF ODD(CLI$PRESENT(qualifier)) THEN          (* CLD ensures it has a value *)
   status := CLI$GET_VALUE(qualifier,s);
   i := HIGH(s);
   WHILE (i > 0) AND (s[i] = ' ') DO         (* remove trailing blanks *)
      s[i] := NULL;                          (* SYSDEP: pad with NULLs *)
      DEC(i);
   END;
ELSE
   s[0] := NULL;                             (* SYSDEP: LEN(s) will be 0 *)
END;
(* the main module will detect bad s value sooner or later *)
END GetString;

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

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

(* Append s2 to s1. *)

VAR i, j : CARDINAL;

BEGIN
i := LEN(s1);   (* SYSDEP: assumes s1 ends with NULL, unless full *)
j := 0;
WHILE (i <= HIGH(s1)) AND (j <= HIGH(s2)) AND (s2[j] <> NULL) DO
   s1[i] := s2[j];
   INC(i);
   INC(j);
END;
(* DEBUG
IF (i > HIGH(s1)) AND (j <= HIGH(s2)) AND (s2[j] <> NULL) THEN
   WriteString('No room to append '); WriteString(s2); WriteLn;
   Halt(2);
END;
GUBED *)
IF i <= HIGH(s1) THEN s1[i] := NULL END;
END Append;

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

PROCEDURE GetUnits;

(* Check if /UNITS is present.  If so, then make sure given value is
   valid and set units.
*)

VAR i, status : CARDINAL;   ch1, ch2 : CHAR;

BEGIN
IF ODD(CLI$PRESENT('UNITS')) THEN               (* CLD ensures it has a value *)
   status := CLI$GET_VALUE('UNITS',value);
   i := HIGH(value);
   WHILE (i > 0) AND (value[i] = ' ') DO        (* remove trailing blanks *)
      value[i] := NULL;                         (* SYSDEP: pad with NULLs *)
      DEC(i);
   END;
   ch1 := Cap(value[0]);
   ch2 := Cap(value[1]);
   IF    (ch1 = 'I') AND (ch2 = 'N') THEN
      units := in;
   ELSIF (ch1 = 'C') AND (ch2 = 'M') THEN
      units := cm;
   ELSIF (ch1 = 'M') AND (ch2 = 'M') THEN
      units := mm;
   ELSIF (ch1 = 'P') AND (ch2 = 'C') THEN
      units := pc;
   ELSIF (ch1 = 'P') AND (ch2 = 'T') THEN
      units := pt;
   ELSIF (ch1 = 'B') AND (ch2 = 'P') THEN
      units := bp;
   ELSIF (ch1 = 'P') AND (ch2 = 'X') THEN
      units := px;
   ELSE
      WriteString('Bad /UNITS value: '); WriteString(value); WriteLn;
      WriteString('Specify IN, CM, MM, PC, PT, BP or PX.'); WriteLn;
      Halt(2);
   END;
ELSE
   units := px;   (* if /UNITS not present *)
END;
END GetUnits;

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

PROCEDURE GetPages;

(* Check if /PAGES is present.  If so then subrange will be TRUE.
   /PAGES can accept any value of the form "first:final" where first and/or
   final can be a DVI page (positive integer), or TeX page ([i0. ... .i9]),
   or empty.  If first empty then firstDVIpage = 1; if final empty then
   finalDVIpage = MAX(CARDINAL).  If ":final" is omitted then
   finalDVIpage = firstDVIpage.
   If first/final is a TeX page specification (i.e., starts with '[')
   then first/finalDVIpage is set to 0 and first/finalTeXpage contains the
   given string (and parsing is done by the main module).
*)

VAR i, j, status, len : CARDINAL;

BEGIN
IF ODD(CLI$PRESENT('PAGES')) THEN               (* CLD ensures it has a value *)
   status := CLI$GET_VALUE('PAGES',value);
   i := HIGH(value);
   WHILE (i > 0) AND (value[i] = ' ') DO        (* remove trailing blanks *)
      value[i] := NULL;                         (* SYSDEP: pad with NULLs *)
      DEC(i);
   END;
   len := i + 1;                                (* length of value *)
   firstTeXpage := '';
   finalTeXpage := '';
   i := 0;
   WHILE (i < len) AND (value[i] <> ':') DO     (* extract first page *)
      firstTeXpage[i] := value[i];
      INC(i);
   END;
   IF value[0] = ':' THEN                       (* first page not given *)
      firstDVIpage := 1;
   ELSIF firstTeXpage[0] = '[' THEN             (* TeX page given *)
      firstDVIpage := 0;
   ELSE                                         (* DVI page given *)
      firstDVIpage := StringToCard(firstTeXpage);
      IF NOT Done() OR (firstDVIpage = 0) THEN
         WriteString('/PAGES error! Bad first page: ');
         WriteString(firstTeXpage); WriteLn;
         Halt(2);
      END;
   END;
   IF i = len THEN                              (* no colon; /PAGES=n or [t] *)
      IF firstTeXpage[0] = '[' THEN
         finalTeXpage := firstTeXpage;          (* [t] = [t]:[t] *)
         finalDVIpage := 0;
      ELSE
         finalDVIpage := firstDVIpage;          (* n = n:n *)
      END;
   ELSE                                         (* value[i] = ':' *)
      INC(i);
      j := 0;
      WHILE i < len DO                          (* extract final page *)
         finalTeXpage[j] := value[i];
         INC(i); INC(j);
      END;
      IF j = 0 THEN                             (* no page after ':' *)
         finalDVIpage := MAX(CARDINAL);
      ELSIF finalTeXpage[0] = '[' THEN          (* TeX page given *)
         finalDVIpage := 0;
      ELSE                                      (* DVI page given *)
         finalDVIpage := StringToCard(finalTeXpage);
         IF NOT Done() OR (finalDVIpage = 0) THEN
            WriteString('/PAGES error! Bad final page: ');
            WriteString(finalTeXpage); WriteLn;
            Halt(2);
         END;
      END;
   END;
   subrange := TRUE;    (* main module will check page range *)
ELSE
   subrange := FALSE;   (* if /PAGES not present *)
END;
END GetPages;

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

(* SYSDEP: CLD file must supply some qualifiers with default values. *)

BEGIN
GetDVIFile;                                  (* initialize DVIname *)
GetString('OUTPUT',PSname);                  (* initialize PSname *)
IF LEN(PSname) = 0 THEN                      (* /OUTPUT not specified *)
   PSname := 'OUT.PS';
   (* It would be nicer to use DVIname with .PS instead of .DVI but
      things get messy if DVIname is a logical name or includes a directory.
      Note that PSPRINT.COM specifies an explicit /OUTPUT file.
   *)
END;
GetCardinal('MAGNIFICATION',mag);            (* 0 if no /MAG override *)
GetCardinal('RESOLUTION',resolution);        (* get resolution BEFORE dimens *)
GetPosDimension('XSIZE',paperwd);
GetPosDimension('YSIZE',paperht);
GetDimension('HOFFSET',hoffset);             (* 0 if not given *)
GetDimension('VOFFSET',voffset);             (* ditto *)
GetString('HEADER',header);                  (* empty string if no /HEADER *)
GetString('PSPREFIX',psprefix);
GetString('TFM_DIRECTORY',tfmdir);
GetString('FONT_DIRECTORY',fontdir);
GetString('DUMMY_FONT',value);
dummyfont := fontdir;                        (* prefix dummyfont with fontdir *)
Append(dummyfont,value);
GetUnits;                                    (* initialize units *)
GetPages;                                    (* initialize subrange etc. *)
GetCardinal('INCREMENT',increment);          (* 0 if /INC not used *)
IF increment = 0 THEN increment := 1 END;    (* do normal page selection *)
stats := ODD(CLI$PRESENT('STATS'));
reverse := ODD(CLI$PRESENT('REVERSE'));
conserveVM := ODD(CLI$PRESENT('CONSERVE_VM'));
END Options.