MODULE Plot;

(* A module for drawing 2D graphs of plotted values. *)

IMPORT Text, Color, R2, PS, Arrow, Circle, Type;

PRIVATE FUNC t = Map1(v, scrn, grph) IS 
  (E s1, s2, g1, g2, k :: 
    scrn = (s1, s2) AND 
    grph = (g1, g2) AND 
    k * (g2 - g1) = (v - g1) AND 
    t = s1 + k * (s2 - s1)) 
END;

PRIVATE FUNC q = Map(g, p) IS 
  (E px, py, qx, qy, xScrn, yScrn, xGrph, yGrph :: 
    g = [xScrn, yScrn, xGrph, yGrph] AND 
    p = (px, py) AND 
    qx = Map1(px, xScrn, xGrph) AND 
    qy = Map1(py, yScrn, yGrph) AND 
    q = (qx, qy)) 
END;

/* "q" is the point in Juno coordinates of the point "p" 
   in graph "g"-coordinates. */

PRIVATE PROC xInt, yInt := RectInts(c1, c2) IS 
  IF 
    VAR c1x, c1y, c2x, c2y IN 
      c1 = (c1x, c1y) AND c2 = (c2x, c2y) -> 
        xInt := (MIN(c1x, c2x), MAX(c1x, c2x)); 
        yInt := (MIN(c1y, c2y), MAX(c1y, c2y)) 
    END 
  FI 
END;

/* Set "xInt" and "yInt" to the intervals in the x- and 
   y-axes, respectively, of the rectangle oriented 
   squarely with the page having "c1" and "c2" as 
   opposite corners. */

PROC g := New(c1, c2, xGrph, yGrph) IS 
  VAR xScrn, yScrn IN 
    xScrn, yScrn := RectInts(c1, c2); 
    g := [xScrn, yScrn, xGrph, yGrph] 
  END 
END;

(* Return a new graph structure to be drawn in the 
   bounding box determined by the two corner points "c1" 
   and "c2". The values "xGrph" and "yGrph" must be 
   pairs of real numbers; they represent the range of x- 
   and y-coordinates, respectively, covered by the 
   resulting graph. *)

PRIVATE PROC DrawAxes(g) IS 
  PS.SetEndStyle(PS.SquareEnds); 
  IF 
    VAR 
      xScrn, yScrn, xGrph, yGrph, minX, maxX, minY, maxY 
    IN 
      g = [xScrn, yScrn, xGrph, yGrph] AND 
      xGrph = (minX, maxX) AND 
      yGrph = (minY, maxY) -> 
        PS.MoveTo(Map(g, (minX, minY))); 
        PS.LineTo(Map(g, (minX, maxY))); 
        PS.MoveTo(Map(g, (minX, minY))); 
        PS.LineTo(Map(g, (maxX, minY))); 
        PS.Stroke() 
    END 
  FI 
END;

/* Draw the axes of "g" in the current line width. This 
   procedure does not preserve the PS state. */

PRIVATE PROC DrawTitle(g, txtTitle) IS 
  IF 
    VAR xLo, xHi, yLo, yHi, tail IN 
      g = ((xLo, xHi), ((yLo, yHi), tail)) -> 
        Type.C(((xLo + xHi) / 2, yHi + 20), txtTitle) 
    END 
  FI 
END;

/* Draw "txtTitle" centered above "g" in the current 
   font. */

PROC Draw(g, txtTitle) IS 
  SAVE PS IN DrawAxes(g); DrawTitle(g, txtTitle) END 
END;

(* Draw the graph "g" with title "txtTitle". The axes 
   are drawn in the current line width, and the title is 
   drawn in the current font. *)

PRIVATE CONST TickSz = 5;

PRIVATE PROC TickMark(g, p, tickLoc, scale) IS 
  VAR q, asc, dec, txt IN 
    q := Map(g, p); 
    asc, dec := PS.FontHeight(); 
    PS.MoveTo(q);
    PS.LineTo(R2.Minus(q, tickLoc)); 
    PS.Stroke(); 
    IF 
      CAR(tickLoc) = 0 -> 
        q := R2.Minus(q, R2.Times(2, tickLoc)); 
        txt := Text.FromNum(CAR(p) * scale, 3); 
        Type.C(R2.Minus(q, (0, asc)), txt) 
    | q := R2.Minus(q, R2.Times(3, tickLoc)); 
      txt := Text.FromNum(CDR(p) * scale, 3); 
      Type.R(R2.Minus(q, (0, asc / 2)), txt) 
    FI 
  END 
END;

PROC DrawTickMarks(g, cnt) IS 
  DrawScaledTickMarks(g, cnt, (1, 1)) 
END;

(* Draw labeled tick marks on the graph "g". The 
   argument "cnt" should be a pair of reals. The range 
   of the visible x- and y-axes are divided into 
   "CAR(cnt)" and "CDR(cnt)" sections, respectively. The 
   tick marks are drawn in the current line width and 
   end style, and the labels are drawn in the current 
   font. *)

PROC DrawScaledTickMarks(g, cnt, scale) IS 
  IF 
    VAR 
      xScrn, yScrn, xLo, xHi, yLo, yHi, xCnt, yCnt, 
      xScale, yScale 
    IN 
      g = [xScrn, yScrn, (xLo, xHi), (yLo, yHi)] AND 
      cnt = (xCnt, yCnt) AND 
      scale = (xScale, yScale) -> 
        VAR delta, x IN 
          delta := (xHi - xLo) / xCnt; 
          x := xLo; 
          DO 
            x < xHi -> 
              TickMark(g, (x, yLo), (0, TickSz), xScale); 
              x := x + delta 
          OD; 
          TickMark(g, (xHi, yLo), (0, TickSz), xScale) 
        END; 
        VAR delta, y IN 
          delta := (yHi - yLo) / yCnt; 
          y := yLo; 
          DO 
            y < yHi -> 
              TickMark(g, (xLo, y), (TickSz, 0), yScale); 
              y := y + delta 
          OD; 
          TickMark(g, (xLo, yHi), (TickSz, 0), yScale) 
        END 
    END 
  FI 
END;

(* Draw labeled tick marks on the graph "g". The 
   arguments "cnt" and "scale" should both be pairs of 
   reals. The range of the visible x- and y-axes are 
   divided into "CAR(cnt)" and "CDR(cnt)" sections, 
   respectively. The tick marks are drawn in the current 
   line width and end style, and the labels are drawn in 
   the current font. The labels along the x- and y-axes 
   are scaled by the factors "CAR(scale)" and 
   "CDR(scale)", respectively. *)

PROC Line(g, pts) IS 
  IF 
    VAR head, tail IN 
      pts = (head, tail) -> 
        PS.MoveTo(Map(g, head)); 
        pts := tail; 
        DO 
          VAR head, tail IN 
            pts = (head, tail) -> 
              PS.LineTo(Map(g, head)); pts := tail 
          END 
        OD 
    END 
  FI 
END;

(* Plot the list of points "pts" on the graph "g". "pts" 
   should be a list of points "[p_0, p_1, ..., p_n]". 
   The points are ``plotted'' by constructing a path of 
   line segments that connect successive pairs of 
   points. *)

PROC Pts(g, pts, ptCl) IS 
  DO 
    VAR head, tail, p IN 
      pts = (head, tail) -> 
        p := Map(g, head); APPLY(ptCl, p); pts := tail 
    END 
  OD 
END;

(* Plot the list of points "pts" on "g" using the 
   closure "ptCl" to draw each of the points. The "ptCl" 
   closure will be applied with a single argument, which 
   is the location of the point to draw. The "DrawDotCl" 
   procedure can be used for "ptCl". *)

PROC PtsWithErrors(g, pts, ptCl, errorCl) IS 
  DO 
    VAR tail, p, dyLo, dyHi IN 
      pts = ((p, (dyLo, dyHi)), tail) -> 
        APPLY(errorCl, Map(g, R2.PlusY(p, dyLo)), 
              Map(g, R2.PlusY(p, dyHi))); 
        APPLY(ptCl, Map(g, p)); 
        pts := tail 
    END 
  OD 
END;

(* Plot the list of points "pts" with vertical error 
   bars on the graph "g", using "ptCl" to render the 
   points, and "errorCl" to render the error bars. The 
   argument "pts" should be a list of pairs of the form 
   "(p, (dyLo, dyHi))". Each pair describes a point to 
   plot "p" and the error values in the y-coordinate. 

   More formally, let "Map" denote the mapping from data 
   coordinates to screen coordinates. For each pair in 
   the list "pts", this procedure invokes "ptCl(Map(p))" 
   to draw the point, and 
   "errorCl(Map(R2.PlusY(p,dyLo)), 
   Map(R2.PlusY(p,dyHi)))" to draw the error bars. The 
   bars are drawn before the points in case "ptCl" draws 
   points that are hollow. *)

PRIVATE PROC DrawDot(rad, p) IS 
  Circle.Draw(p, R2.PlusX(p, rad)); PS.Fill() 
END;

PROC cl := DrawDotCl(rad) IS 
  cl := CLOSE(DrawDot, rad) 
END;

(* Returns a closure that plots points as round dots 
   with radius "rad". *)

PRIVATE PROC DrawDiamondPath(p, w) IS 
  PS.MoveTo(R2.PlusX(p, w)); 
  PS.LineTo(R2.MinusY(p, w)); 
  PS.LineTo(R2.MinusX(p, w)); 
  PS.LineTo(R2.PlusY(p, w)); 
  PS.Close() 
END;

PRIVATE PROC DrawDiamond(w, p) IS 
  DrawDiamondPath(p, w); PS.Fill() 
END;

PROC cl := DrawDiamondCl(w) IS 
  cl := CLOSE(DrawDiamond, w / 2) 
END;

(* Returns a closure that plots points as filled 
   diamonds of width "w". *)

PRIVATE PROC DrawHollowDiamond(w, p) IS 
  DrawDiamondPath(p, w); 
  SAVE PS IN PS.SetColor(Color.White); PS.Fill() END; 
  PS.Stroke() 
END;

PROC cl := DrawHollowDiamondCl(w) IS 
  cl := CLOSE(DrawHollowDiamond, w / 2) 
END;

(* Returns a closure that plots points as filled 
   diamonds of width "w". *)

PRIVATE PROC HLine(p, w) IS 
  PS.MoveTo(R2.MinusX(p, w)); PS.LineTo(R2.PlusX(p, w)) 
END;

PRIVATE PROC DrawErrorBar(w, lo, hi) IS 
  SAVE PS IN 
    PS.SetEndStyle(PS.ButtEnds); 
    HLine(lo, w); 
    HLine(hi, w); 
    PS.MoveTo(lo); 
    PS.LineTo(hi); 
    PS.Stroke() 
  END 
END;

PROC cl := ErrorBarCl(xWidth) IS 
  cl := CLOSE(DrawErrorBar, xWidth / 2) 
END;

(* Returns a closure that draws vertical error bars in 
   the current line width with horizontal endmarks of 
   length "xWidth". *)