MODULE Pen;

IMPORT R2, PS;

(* A module for simulating strokes of a 
   calligraphic pen. *)

PRIVATE FUNC d = MidVector(p, q) IS 
  (E px, py, qx, qy, dx, dy :: 
    p = (px, py) AND 
    q = (qx, qy) AND 
    d = (dx, dy) AND 
    dx = (qx - px) / 2 AND 
    dy = (qy - py) / 2) 
END;

/* "d" is the vector from "p" to the 
   midpoint of the segment (p,q). */

PRIVATE PROC Line(a, b, p, q) IS 
  IF 
    VAR del, aL, aR, bL, bR, cL, cR, dL, dR IN 
      del = MidVector(p, q) AND 
      aL = R2.Minus(a, del) AND 
      aR = R2.Plus(a, del) AND 
      bL = R2.Minus(b, del) AND 
      bR = R2.Plus(b, del) -> 
        PS.MoveTo(aL); 
        PS.LineTo(bL); 
        PS.LineTo(bR); 
        PS.LineTo(aR); 
        PS.Close(); 
        PS.Fill() 
    END 
  FI 
END;

/* Stroke the segment "ab" with a 
   calligrapher's pen determined by the 
   segment "pq". */

PRIVATE FUNC p = B3Point(t, a, b, c, d) IS 
  (E ab, bc, cd, abc, bcd :: 
    ab = (t, 0) REL (a, b) AND 
    bc = (t, 0) REL (b, c) AND 
    cd = (t, 0) REL (c, d) AND 
    abc = (t, 0) REL (ab, bc) AND 
    bcd = (t, 0) REL (bc, cd) AND 
    p = (t, 0) REL (abc, bcd)) 
END;

/* "p" is a point on the curve (a,b,c,d) 
   such that p = (x(t), y(t)), where x() and 
   y() are the parametric coordinate 
   functions of the curve. */

PRIVATE PRED 
  OnSplineTan(t, a, b, c, d, p, pL, pR) IS 
  (E ab, bc, cd :: 
    ab = (t, 0) REL (a, b) AND 
    bc = (t, 0) REL (b, c) AND 
    cd = (t, 0) REL (c, d) AND 
    pL = (t, 0) REL (ab, bc) AND 
    pR = (t, 0) REL (bc, cd) AND 
    p = (t, 0) REL (pL, pR)) 
END;

/* "p" is the point on the spline (a,b,c,d) 
   whose tangent is parallel to the segment 
   (pL,pR), where "pL" and "pR" are the 
   points surrounding "p" in the segment 
   construction of a point on a spline. */

PRIVATE PROC 
  Notch(aL, bL, cL, dL, aR, bR, cR, dR, p, q) IS 
  IF 
    VAR t ~ 0.5, p1, p1L, p1R, p2 IN 
      OnSplineTan(t, aL, bL, cL, dL, p1, 
                  p1L, p1R) AND 
      (p1L, p1R) PARA (p, q) AND 
      p2 = R2.Plus(p1, R2.Minus(q, p)) -> 
        IF 
          0 <= t AND t <= 1 -> 
            IF 
              VAR 
                tL ~ (1 + t) / 2, 
                tR ~ t / 2, 
                p0 ~ (0.5, 0) REL (p1, p2) 
              IN 
                p0 = 
                  B3Point(tL, aL, bL, cL, dL) AND 
                p0 = 
                  B3Point(tR, aR, bR, cR, dR) -> 
                  IF 
                    0 <= tL AND 
                    tL <= 1 AND 
                    0 <= tR AND 
                    tR <= 1 -> 
                      PS.MoveTo(p0); 
                      PS.LineTo(p1); 
                      PS.LineTo(p2); 
                      PS.Close(); 
                      PS.Fill() | SKIP 
                  FI | SKIP 
              END 
            FI | SKIP 
        FI | SKIP 
    END 
  FI 
END;

PRIVATE PROC Curve(a, b, c, d, p, q) IS 
  IF 
    VAR del, aL, aR, bL, bR, cL, cR, dL, dR IN 
      del = MidVector(p, q) AND 
      aL = R2.Minus(a, del) AND 
      aR = R2.Plus(a, del) AND 
      bL = R2.Minus(b, del) AND 
      bR = R2.Plus(b, del) AND 
      cL = R2.Minus(c, del) AND 
      cR = R2.Plus(c, del) AND 
      dL = R2.Minus(d, del) AND 
      dR = R2.Plus(d, del) -> 
        Notch(aL, bL, cL, dL, aR, bR, cR, 
              dR, p, q); 
        PS.MoveTo(aR); 
        PS.CurveTo(bR, cR, dR); 
        PS.LineTo(dL); 
        PS.CurveTo(cL, bL, aL); 
        PS.Close(); 
        PS.Fill() 
    END 
  FI 
END;

/* Stroke the Bezier cubic "a", "b", "c", 
   "d" with a calligrapher's pen determined 
   by the segment "pq". */

PROC Stroke(p, q) IS 
  VAR path, currPt, startPt IN 
    path := PS.CurrentPath(); 
    PS.NewPath(); 
    currPt, startPt := NIL, NIL; 
    DO 
      path # NIL -> 
        IF 
          VAR op, args IN 
            CAR(path) = (op, args) -> 
              IF 
                op = "MoveTo" -> 
                  startPt := CAR(args); 
                  currPt := startPt 
              | op = "LineTo" -> 
                  Line(currPt, CAR(args), p, 
                       q); 
                  currPt := CAR(args) 
              | op = "CurveTo" -> 
                  VAR b, c, d IN 
                    args = [b, c, d] -> 
                      Curve(currPt, b, c, d, 
                            p, q); 
                      currPt := d 
                  END 
              | op = "Close" -> 
                  Line(currPt, startPt, p, q); 
                  currPt, startPt := NIL, NIL 
              FI 
          END 
        FI; 
        path := CDR(path) 
    OD 
  END 
END;

UI PointTool(Stroke);

(* Stroke the current path with a 
   calligrapher's pen determined by the 
   segment "pq". *)