MODULE Arrow;

(* Procedures for drawing directed edges. *)

IMPORT Geometry, PS;

PRIVATE CONST 
  WidthBase = 8, 
  WidthFactor = 3, 
  StubSz = 0.15;

/* If the current line width is "w", then 
   when the arrowhead size = -1, the size 
   used is: 

|  size := WidthBase + (w * WidthFactor)
    */

CONST DefaultSize = -1;

(* This module maintains a current arrowhead 
   size, which is the distance from its tip 
   to its cusp. If the arrowhead size is 
   negative, then the size is determined as a 
   function of the current line width. *)

PRIVATE VAR size := DefaultSize;

PROC SetSize(sz) IS size := sz END;

UI SetTool(SetSize);

(* Set the current arrowhead size to "sz". *)

UI Param(SetSize, DefaultSize);

UI Param(SetSize, 12);

UI Param(SetSize, 16);

UI Param(SetSize, 20);

UI Param(SetSize, 24);

UI Param(SetSize, 28);

UI Param(SetSize, 48);

PROC sz := GetSize() IS sz := size END;

(* Return the current arrow head size. A 
   negative result means the arrow head size 
   is determined from the current line width. 
*)

PROC sz := HeadSize() IS 
  IF 
    size < 0 -> 
      VAR w IN 
        w := PS.GetWidth(); 
        IF w = 0 -> w := 1 | SKIP FI; 
        sz := WidthBase + (WidthFactor * w) 
      END | sz := size 
  FI 
END;

(* Set "sz" to the size to use to draw 
   arrowheads. This is usually the same as 
   the value of the "GetSize" procedure, 
   unless that is negative, in which case it 
   is a function of the current line width. *)

PRIVATE PROC DrawHead(a, b) IS 
  IF 
    VAR 
      c = (-0.16, 0.36) REL (a, b), 
      d = (-0.16, -0.36) REL (a, b) 
    IN 
      SAVE PS IN 
        PS.SetJointStyle(PS.MiterJoints); 
        PS.MoveTo(a); 
        PS.LineTo(c); 
        PS.LineTo(b); 
        PS.LineTo(d); 
        PS.Close(); 
        PS.Fill() 
      END 
    END 
  FI 
END;

/* Draw the head of an arrow with its cusp at 
   "a" and its tip at "b". The arrowhead is 
   filled with paint of the current color. */

PRIVATE PROC DrawHeadWithTail(a, b) IS 
  IF 
    VAR c = (StubSz, 0) REL (a, b) IN 
      SAVE PS IN 
        PS.SetEndStyle(PS.ButtEnds); 
        PS.MoveTo(a); 
        PS.LineTo(c); 
        PS.Stroke() 
      END; 
      DrawHead(c, b) 
    END 
  FI 
END;

/* Draw an arrow head with a small tail. The 
   tail starts at "a", and the tip of the 
   head is at "b". */

FUNC p = StraightEnd(a, b, dist) IS 
  (E p0 ~ Geometry.Mid(a, b) :: 
    Geometry.Colinear(a, p0, b) AND 
    dist = Geometry.Dist(p0, b) AND 
    p = p0) 
END;

(* "p" is the point on the line "ab" closest 
   to "a" and a distance "dist" from "b". *)

PROC Head(a, b) IS 
  IF 
    VAR p = StraightEnd(a, b, HeadSize()) IN 
      IF 
        VAR c = (StubSz, 0) REL (p, b) IN 
          DrawHead(c, b) 
        END 
      FI 
    END 
  FI 
END;

UI PointTool(Head);

(* Draw an arrow head with no tail as if the 
   tail started at "a" and ended at "b". *)

PROC Straight(a, b) IS 
  IF 
    VAR p = StraightEnd(a, b, HeadSize()) IN 
      PS.MoveTo(a); 
      PS.LineTo(p); 
      PS.Stroke(); 
      DrawHeadWithTail(p, b) 
    END 
  FI 
END;

PROC DblStraight(a, b) IS 
  IF 
    VAR 
      sz = HeadSize(), 
      p = StraightEnd(b, a, sz), 
      q = StraightEnd(a, b, sz) 
    IN 
      DrawHeadWithTail(p, a); 
      PS.MoveTo(p); 
      PS.LineTo(q); 
      PS.Stroke(); 
      DrawHeadWithTail(q, b) 
    END 
  FI 
END;

UI PointTool(Straight);

UI PointTool(DblStraight);

(* Draw a directed or doubly-directed edge, 
   respectively, from "a" to "b". Requires 
   that "a # b". *)

PROC Curved(a, b, c, d) IS 
  IF 
    VAR p = StraightEnd(c, d, HeadSize()) IN 
      PS.MoveTo(a); 
      PS.CurveTo(b, c, p); 
      PS.Stroke(); 
      DrawHeadWithTail(p, d) 
    END 
  FI 
END;

PROC DblCurved(a, b, c, d) IS 
  IF 
    VAR 
      sz = HeadSize(), 
      p = StraightEnd(b, a, sz), 
      q = StraightEnd(c, d, sz) 
    IN 
      DrawHeadWithTail(p, a); 
      PS.MoveTo(p); 
      PS.CurveTo(b, c, q); 
      PS.Stroke(); 
      DrawHeadWithTail(q, d) 
    END 
  FI 
END;

UI PointTool(Curved);

UI PointTool(DblCurved);

(* Draw a directed or doubly-directed curved 
   edge, respectively, from "a" to "d" with 
   Bezier control points "b" and "c". 
   Requires that "c # d". *)

PRIVATE VAR history := NIL;

PROC Save() IS history := (size, history) END;

PROC Restore() IS 
  size := CAR(history); 
  history := CDR(history) 
END;

UI PointTool(Save);

UI PointTool(Restore);

(* Save/restore the current arrow size. *)