MODULE Path;

(* Procedures related to PostScript paths *)

IMPORT BST, List, Color, R2, Geometry, PS, Bezier, 
       Circle;

PRIVATE PROC res := TransformPts(pts, xform) IS 
  IF 
    pts = NIL -> res := NIL 
  | IF 
      VAR pt, tail IN 
        pts = (pt, tail) -> 
          res := 
            (APPLY(xform, pt), 
             TransformPts(tail, xform)) 
      END 
    FI 
  FI 
END;

PROC newPath := Transform(path, xform) IS 
  IF 
    path = NIL -> newPath := NIL 
  | IF 
      VAR op, args, tail IN 
        path = ((op, args), tail) -> 
          newPath := 
            ((op, TransformPts(args, xform)), 
             Transform(tail, xform)) 
      END 
    FI 
  FI 
END;

(* Set "newPath" to a representation of the path 
   "path" whose points have been transformed 
   according to the closure "xform". The argument 
   "path" and the result "newPath" are paths as 
   represented by the result of the 
   "PS.CurrentPath" procedure. The transformation 
   function "xform" should be a closure that takes 
   a single point as an IN parameter, and returns 
   a single point as an OUT parameter. *)

PRIVATE PROC AnnotatePoint(pt) IS 
  SAVE PS IN 
    PS.NewPath(); 
    Circle.DrawR(pt, 3); 
    PS.SetColor(Color.Blue); 
    PS.Fill() 
  END 
END;

PRIVATE PROC AnnotateVector(from, to) IS 
  SAVE PS IN 
    PS.NewPath(); 
    Circle.DrawR(to, 3); 
    PS.SetColor(Color.Red); 
    PS.Fill(); 
    PS.MoveTo(from); 
    PS.LineTo(to); 
    PS.SetColor(Color.Grey50); 
    PS.Stroke() 
  END 
END;

PROC Annotate() IS 
  VAR p, lastP IN 
    p, lastP := PS.CurrentPath(), NIL; 
    DO 
      p # NIL -> 
        VAR op, args IN 
          (op, args) = CAR(p) -> 
            IF 
              op = "MoveTo" OR op = "LineTo" -> 
                lastP := CAR(args); 
                AnnotatePoint(lastP) 
            | op = "Close" -> lastP := NIL 
            | op = "CurveTo" -> 
                VAR p1, p2, p3 IN 
                  args = [p1, p2, p3] -> 
                    AnnotateVector(lastP, p1); 
                    AnnotatePoint(p3); 
                    AnnotateVector(p3, p2); 
                    lastP := p3 
                END 
            FI 
        END; 
        p := CDR(p) 
    OD 
  END 
END;

UI PointTool(Annotate);

(* Annotates the current path. The points on the 
   path are shown as small blue dots, and the 
   control points of any Bezier curves are shown 
   as small red dots. Light grey lines are shown 
   between Bezier control points and end points. *)

PROC AppendToCurrent(path) IS 
  DO 
    path # NIL -> 
      VAR op, args IN 
        (op, args) = CAR(path) -> 
          IF 
            op = "MoveTo" -> PS.MoveTo(CAR(args)) 
          | op = "LineTo" -> PS.LineTo(CAR(args)) 
          | op = "Close" -> PS.Close() 
          | op = "CurveTo" -> 
              VAR p1, p2, p3 IN 
                args = [p1, p2, p3] -> 
                  PS.CurveTo(p1, p2, p3) 
              END 
          FI 
      END; 
      path := CDR(path) 
  OD 
END;

(* Append the path "path" to the current path; 
   "path" should be a path description as returned 
   by the "PS.CurrentPath()" procedure. *)

PROC segs := ToSegments(p) IS 
  VAR firstP, currP, offset, end, len IN 
    segs, offset := NIL, 0; 
    firstP, currP := NIL, NIL; 
    DO 
      p # NIL -> 
        VAR op, args IN 
          (op, args) = CAR(p) -> 
            IF 
              op = "MoveTo" -> 
                firstP := CAR(args); 
                currP := firstP 
            | op = "LineTo" -> 
                len := 
                  Geometry.Dist(currP, CAR(args)); 
                end := offset + len; 
                segs, offset, currP := 
                  (([offset, end, len], 
                    ["Straight", currP, CAR(args)]), 
                   segs), end, CAR(args) 
            | op = "CurveTo" -> 
                VAR p1, p2, p3 IN 
                  args = [p1, p2, p3] -> 
                    len := 
                      Bezier.Length(currP, p1, p2, 
                                    p3); 
                    end := offset + len; 
                    segs, offset, currP := 
                      (([offset, end, len], 
                        ["Curve", currP, p1, p2, p3]), 
                       segs), end, p3 
                END 
            | op = "Close" -> 
                len := Geometry.Dist(currP, firstP); 
                end := offset + len; 
                segs, offset, firstP, currP := 
                  (([offset, end, len], 
                    ["Straight", currP, firstP]), 
                   segs), end, NIL, firstP 
            FI 
        END; 
        p := CDR(p) 
    OD 
  END; 
  segs := BST.FromList(List.Reverse(segs)) 
END;

(* Set "segs" to a list of segments that 
   represents the straight and curved segments of 
   the path "p", which should be a path as 
   returned by the "PS.CurrentPath()" procedure. 
   The "segs" result can be passed to the 
   "Length", "AtT", and "TangentAtT" procedures 
   below. See the private view for a description 
   of how "segs" is represented. *)

/* The "segs" result is a binary search tree of 
   the form: 

|    segs     ::= tree
|    tree     ::= ( seg, ( tree, tree ) ) | NIL
|    seg      ::= ( interval, value )
|    interval ::= [ start, end, len ]
|    value    ::= [ type, pt, ... ]
|    type     ::= "Straight" | "Curved"
|    pt       ::= ( x, y )

   In each interval, "start + len = end", and 
   "len" is the length of that segment. The 
   segments are arranged in a binary search tree: 
   for all nodes "n", the interval for "n" is at 
   least the interval of its left child, and at 
   most the interval of its right child. The 
   proceudure "BST.FromList" is used to construct 
   "segs", and the procedure "BST.FindInterval" is 
   used to search for the segment containing a 
   given time "t". 

   If the segment's "type" is "Straight", then 
   "pts" is a list of two points, namely, the 
   segment's start and end points. If "type" is 
   "Curved", then "pts" is a list of the four 
   points defining the Bezier curve for that 
   segment. */

PROC len := Length(segs) IS 
  IF 
    segs = NIL -> len := 0 
  | IF 
      VAR start, end, len1, val, l, r IN 
        segs = (([start, end, len1], val), (l, r)) -> 
          len := len1 + Length(l) + Length(r) 
      END 
    FI 
  FI 
END;

(* Set "len" to the total length of the segments 
   "segs". *)

PROC pt := AtT(segs, t) IS 
  VAR seg IN 
    seg := BST.FindInterval(t, segs); 
    IF 
      VAR start, end, len, value IN 
        seg = ([start, end, len], value) -> 
          IF 
            VAR from, to IN 
              value = ["Straight", from, to] -> 
                pt := 
                  ((t - start) / len, 0) REL 
                  (from, to) 
            END 
          | VAR p0, p1, p2, p3 IN 
              value = ["Curve", p0, p1, p2, p3] -> 
                pt := 
                  Bezier.AtT(p0, p1, p2, p3, 
                             (t - start) / len) 
            END 
          FI 
      END 
    FI 
  END 
END;

(* Set "pt" to the point on the path "segs" at 
   time "t". Requires "0 <= t <= Length(segs)". *)

PROC tangent := TangentAtT(segs, t) IS 
  VAR seg IN 
    seg := BST.FindInterval(t, segs); 
    IF 
      VAR from, to IN 
        CDR(seg) = ["Straight", from, to] -> 
          tangent := R2.Minus(to, from) 
      END 
    | VAR start, end, len, p0, p1, p2, p3 IN 
        seg = 
          ([start, end, len], 
           ["Curve", p0, p1, p2, p3]) -> 
          tangent := 
            Bezier.PrimeAtT(p0, p1, p2, p3, 
                            (t - start) / len) 
      END 
    FI 
  END 
END;

(* Set "pt" to the tangent vector to the point on 
   the path "segs" at time "t". Requires "0 <= t 
   <= Length(segs)". *)