MODULE Demo;

IMPORT PS, R2, Geometry, Shape, 
       Arrow;

PRIVATE CONST NodeSize = 30;

PRED NearMid(mid, p, q) IS 
  mid = (0.45, 0) REL (p, q) 
END;

(* The point "mid" is 9/20 of 
   the way along the segment 
   from "p" to "q". *)

PROC Node(p) IS 
  Shape.Circle(p, 
               (CAR(p) + NodeSize, 
                CDR(p))); 
  PS.Stroke() 
END;

(* Stroke a circular node 
   centered at "p". *)

PROC Edge(a, b, c, d) IS 
  IF 
    VAR 
      ab ~ (0.5, 0) REL (a, b), 
      cd ~ (0.5, 0) REL (c, d) 
    IN 
      Geometry.Colinear(a, ab, b) AND 
      Geometry.Colinear(c, cd, d) AND 
      (a, ab) CONG 
        ((0, 0), (0, NodeSize)) AND 
      (d, cd) CONG (a, ab) -> 
        Arrow.Curved(ab, b, c, cd) 
    END 
  FI 
END;

(* Stroke a directed edge along 
   a Bezier curve "a", "b", "c", 
   d", where "a" and "d" are 
   node centers. *)

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 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 
  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.LineTo(p0); 
                      PS.Fill(); 
                      PS.MoveTo(p0); 
                      PS.LineTo(p1); 
                      PS.LineTo(p2); 
                      PS.LineTo(p0); 
                      PS.Stroke() 
                  | SKIP 
                  FI | SKIP 
              END 
            FI | SKIP 
        FI | SKIP 
    END 
  FI 
END;

PROC 
  PenStroke(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(aL); 
        PS.LineTo(aR); 
        PS.CurveTo(bR, cR, dR); 
        PS.LineTo(dL); 
        PS.CurveTo(cL, bL, aL); 
        PS.Fill(); 
        PS.MoveTo(aL); 
        PS.LineTo(aR); 
        PS.CurveTo(bR, cR, dR); 
        PS.LineTo(dL); 
        PS.CurveTo(cL, bL, aL); 
        PS.Stroke() 
    END 
  FI 
END;

(* Stroke a calligrapher's pen 
   determined by the segment 
   from "p" to "q" over the 
   Bezier cubic "a", "b", "c", 
   "d". *)

PROC PenS(a, g, n, o) IS 
  IF 
    VAR 
      b 
    ~ (-0.06404, -0.3797) REL 
      (a, g), 
      c 
    ~ (0.196, -0.8375) REL (a, g), 
      d 
    ~ (0.5841, -0.8467) REL 
      (a, g), 
      e 
    ~ (0.9191, -0.8546) REL 
      (a, g), 
      f 
    ~ (1.132, -0.4622) REL (a, g), 
      h 
    ~ (0.8381, 0.565) REL (a, g), 
      i 
    ~ (1.099, 1.044) REL (a, g), 
      j 
    ~ (1.508, 1.035) REL (a, g), 
      k 
    ~ (1.983, 1.024) REL (a, g), 
      l 
    ~ (2.3, 0.4641) REL (a, g), 
      m ~ (2.222, 0) REL (a, g) 
    IN 
      Demo.PenStroke(a, b, c, 
                       d, n, o); 
      Demo.PenStroke(d, e, f, g, 
                     n, o); 
      Demo.PenStroke(g, h, i, j, 
                     n, o); 
      Demo.PenStroke(j, k, l, m, 
                     n, o); 
      PS.MoveTo(n); 
      PS.LineTo(o) 
    END 
  FI 
END;