MODULE VPrint;

IMPORT Text, R2, Unparse, PS;

(* A module for printing lines of text to a virtual 
   terminal. *)

(* \section{Setting Module State} *)

PRIVATE VAR currPt := NIL;

/* The current point at which the next text should be 
   printed. */

PRIVATE VAR leftMargin := NIL;

/* The x-coordinate of the left margin along which text 
   will be justified. */

PRIVATE VAR lineSep := NIL;

/* The current line separation in points. It is a 
   function of the current font. A value of 0 means the 
   line separation must be computed from the current 
   font. */

PRIVATE VAR scrollDir := NIL;

/* Either +1 or -1. "scrollDir" specifies whether 
   subsequent lines are printed above (+1) or below (-1) 
   the current one. */

PRIVATE VAR scrollPending := NIL;

/* Indicates if a scroll is pending. A non-NIL value 
   indicates that a scroll is pending, meaning that a 
   newline character has just been printed, but that 
   "currPt" has not been adjusted vertically. This will 
   only be the case when "scrollDir" is -1, since only 
   when scrolling down is the vertical scroll amount 
   dependent on the *next* line of text to be printed. 
   This variable is necessary to correctly handle font 
   changes between lines. */

CONST 
  DefaultFontFace = "Courier", DefaultFontSize = PS.Small;

(* This module maintains its own font face and font size, 
   independent of that maintained by the "PS" module. *)

PRIVATE VAR 
  fontFace := DefaultFontFace, fontSize := DefaultFontSize;

PROC SetFontFace(nm) IS 
  fontFace := nm; lineSep := NIL 
END;

UI SetTool(SetFontFace);

UI Param(SetFontFace, DefaultFontFace);

UI Param(SetFontFace, "Times-Roman");

UI Param(SetFontFace, "Times-Bold");

UI Param(SetFontFace, "Times-Italic");

UI Param(SetFontFace, "Times-BoldItalic");

UI Param(SetFontFace, "Helvetica");

UI Param(SetFontFace, "Helvetica-Bold");

UI Param(SetFontFace, "Helvetica-Oblique");

UI Param(SetFontFace, "Helvetica-BoldOblique");

UI Param(SetFontFace, "Courier");

UI Param(SetFontFace, "Courier-Bold");

UI Param(SetFontFace, "Courier-Oblique");

UI Param(SetFontFace, "Courier-BoldOblique");

UI Param(SetFontFace, "Symbol");

(* Change the current font face to the one named "nm". 
   The behavior is undefined if this procedure is called 
   in the middle of an output line. *)

PROC SetFontSize(sz) IS 
  fontSize := sz; lineSep := NIL 
END;

UI SetTool(SetFontSize);

UI Param(SetFontSize, DefaultFontSize);

UI Param(SetFontSize, PS.Tiny);

UI Param(SetFontSize, PS.Small);

UI Param(SetFontSize, PS.Medium);

UI Param(SetFontSize, PS.Big);

UI Param(SetFontSize, PS.Large);

UI Param(SetFontSize, PS.Huge);

(* Change the current font size to "sz". The behavior is 
   undefined if this procedure is called in the middle of 
   an output line. *)

CONST DefaultLineSpacing = 1;

(* This module maintains a current line spacing, which is 
   a multiple of the spacing between consecutive lines 
   that is designed into each font. A line spacing value less 
   than 1 makes the lines closer together, while a value
   greater than 1 makes them further apart. For example, 
   to achieve double spacing, use a line spacing of 2. *)

PRIVATE VAR spacing := DefaultLineSpacing;

/* The current line spacing. */

PROC SetLineSpacing(spc) IS spacing := spc END;

UI SetTool(SetLineSpacing);

UI Param(SetLineSpacing, DefaultLineSpacing);

UI Param(SetLineSpacing, 0.5);

UI Param(SetLineSpacing, 0.75);

UI Param(SetLineSpacing, 1);

UI Param(SetLineSpacing, 1.5);

UI Param(SetLineSpacing, 2);

(* Set the current line spacing to "spc". The behavior is 
   undefined if this procedure is called in the middle of 
   an output line. *)

(* \section{Initialization} *)

PROC StartNW(p) IS 
  currPt := p; 
  leftMargin := CAR(p); 
  scrollDir := -1; 
  scrollPending := 1 
END;

UI PointTool(StartNW);

(* Start a new virtual terminal whose northwest point is 
   "p". Subsequent lines are printed downward. *)

PROC StartSW(p) IS 
  currPt := p; 
  leftMargin := CAR(p); 
  scrollDir := 1; 
  scrollPending := NIL 
END;

UI PointTool(StartSW);

(* Start a new virtual terminal whose southwest point is 
   "p". Subsequent lines are printed upward. *)

(* \section{Printing} *)

(* This module maintains a current print position. Each of
   the following procedures prints text at the current print
   position and advances the print position to the end of
   the text just printed. When a newline character is printed,
   the print position is moved so as to simulate a carriage
   return according to the current font, the current line
   spacing, and the vertical advancement direction. *)

PRIVATE PROC SetLineSep() IS 
  IF 
    lineSep = NIL -> lineSep := PS.GetFontPtSize() | SKIP 
  FI 
END;

/* Set "lineSep" from the current font if necessary. */

PRIVATE PROC Scroll() IS 
  SetLineSep(); 
  currPt := 
    R2.PlusY(currPt, scrollDir * lineSep * spacing) 
END;

PRIVATE PROC ScrollIfPending() IS 
  IF scrollPending # NIL -> Scroll() | SKIP FI 
END;

/* If a scroll is pending, adjust "currPt" vertically. */

PRIVATE PROC NonNLString(txt) IS 
  ScrollIfPending(); 
  PS.Type(currPt, txt); 
  currPt := R2.PlusX(currPt, PS.StringWidth(txt)) 
END;

/* Print "txt" at the current point. "txt" is assumed not 
   to contain any newline characters. */

PRIVATE PROC NewLine() IS 
  currPt := (leftMargin, CDR(currPt)); 
  IF 
    scrollDir < 0 -> scrollPending := 1 
  | scrollDir > 0 -> Scroll() 
  FI 
END;

/* Handle a newline character. */

PRIVATE CONST NL = Text.GetChar("\n", 0);

PRIVATE PROC String2(txt) IS 
  DO 
    txt # "" -> 
      VAR nextNL, len IN 
        nextNL := Text.FindChar(txt, NL); 
        IF 
          nextNL < 0 -> len := Text.Length(txt) 
        | len := nextNL 
        FI; 
        IF 
          len > 0 -> NonNLString(Text.Sub(txt, 0, len)) 
        | SKIP 
        FI; 
        IF 
          nextNL >= 0 -> NewLine(); len := len + 1 | SKIP 
        FI; 
        txt := Text.Sub(txt, len, 1e6) 
      END 
  OD 
END;

/* Same as "String" below, but this procedure assumes the 
   font has already been set correctly according to 
   "fontFace" and "fontSize". */

PROC String(txt) IS 
  VAR nm, sz IN 
    nm, sz := PS.GetFont(); 
    PS.SetFont(fontFace, fontSize); 
    String2(txt); 
    PS.SetFont(nm, sz) 
  END 
END;

PROC StringNL(txt) IS String(txt & "\n") END;

(* "String" prints "txt" at the current print position as described
   above. "StringNL" is like "String", but it appends a newline character. *)

PROC Point(p) IS String(Unparse.Point(p)) END;

PROC PointNL(p) IS String(Unparse.Point(p) & "\n") END;

UI PointTool(Point);
UI PointTool(PointNL);

(* "Point" prints the point "p" as a pair of reals at the current
   print position. The precision to which the real numbers are printed
   is controlled by the "Unparse" module. "PrintNL" is like "Point",
   but it appends a newline character. *) 

PROC Value(val) IS String(Unparse.Value(val)) END;

PROC ValueNL(val) IS Value(val); String("\n") END;

(* "Value" prints the unparsed representation of "val" at the current
   print position. It uses the "Unparse.Value" procedure, which
   controls the precision to which any numbers in "val" are printed; 
   that procedure may also do some automatic list breaking. "ValueNL"
   is like "Value", but it appends a newline character. *)