MODULE DiGraph;

IMPORT PS, Circle, Color, R2, Geometry, Arrow, 
       TypeLinesC, Ellipse;

(* A module for drawing directed, labeled, graphs. The 
   nodes are drawn as ellipses whose axes are oriented 
   squarly with the page. *)

CONST 
  DefaultNodeWE = (35, 1), 
  DefaultNodeWH = (CAR(DefaultNodeWE), 
                   CAR(DefaultNodeWE));

(* This module maintains a current node size, which is 
   initially set so as to draw a circle with radius 35. 
*)

PRIVATE VAR 
  width := CAR(DefaultNodeWE), 
  eccentricity := CDR(DefaultNodeWE);

PROC SetNodeWE(we) IS 
  IF 
    VAR w, e IN 
      we = (w, e) -> width := w; eccentricity := e 
    END 
  FI 
END;

PROC SetNodeWH(wh) IS 
  IF 
    VAR w, h IN 
      wh = (w, h) -> width := w; eccentricity := h / w 
    END 
  FI 
END;

UI SetTool(SetNodeWE);

UI SetTool(SetNodeWH);

(* These procedures set the node size. The argument to 
   each procedure is a pair of real numbers of the form 
   "(w, x)". In both procedures, "w" is the horizontal 
   width of the nodes in points. In "SetNodeWE", the 
   second value "x" is the eccentricity of the nodes, 
   namely, the ratio of their vertical height to their 
   horizontal width. In "SetNodeWH", the second value 
   "x" is the absolute vertical height of the nodes in 
   points. *)

UI Param(SetNodeWE, DefaultNodeWE);

UI Param(SetNodeWH, DefaultNodeWH);

PROC we := GetNodeWE() IS 
  we := (width, eccentricity) 
END;

PROC wh := GetNodeWH() IS 
  wh := (width, width * eccentricity) 
END;

(* Return the current node size. *)

PRIVATE PROC maj := FromCenter(a) IS 
  maj := (CAR(a) + width, CDR(a)) 
END;

PRIVATE PROC NodePath(a) IS 
  VAR maj IN 
    maj := FromCenter(a); 
    IF 
      eccentricity = 1 -> Circle.Draw(a, maj) 
    | Ellipse.DrawEcc(a, maj, eccentricity) 
    FI 
  END 
END;

PROC Node(a) IS NodePath(a); PS.Stroke() END;

UI PointTool(Node);

(* Draw an ellipse centered at "a" with the current node 
   width and height. *)

PROC Label(p, label) IS TypeLinesC.Center(p, label) END;

UI TextTool(Label);

(* Print the label "txt" inside the node "p". *)

PROC p := Intercept(a, b) IS 
  IF 
    eccentricity = 1 -> 
      VAR c ~ b IN 
        Geometry.Colinear(a, c, b) AND 
        width = Geometry.Dist(a, c) -> p := c 
      END 
  | VAR maj IN 
      maj := FromCenter(a); 
      IF 
        VAR c ~ b IN 
          Geometry.Colinear(a, c, b) AND 
          Ellipse.OnEcc(c, a, maj, eccentricity) -> 
            p := c 
        END 
      FI 
    END 
  FI 
END;

(* Sets "p" to the point along segment "ab" and on the 
   ellipse centered at "a" drawn in the current node 
   size. *)

PROC Straight0(a, b) IS 
  VAR ab, ba IN 
    ab := Intercept(a, b); 
    ba := Intercept(b, a); 
    PS.MoveTo(ab); 
    PS.LineTo(ba); 
    PS.Stroke() 
  END 
END;

PROC Straight1(a, b) IS 
  VAR ab, ba IN 
    ab := Intercept(a, b); 
    ba := Intercept(b, a); 
    Arrow.Straight(ab, ba) 
  END 
END;

PROC Straight2(a, b) IS 
  VAR ab, ba IN 
    ab := Intercept(a, b); 
    ba := Intercept(b, a); 
    Arrow.DblStraight(ab, ba) 
  END 
END;

UI PointTool(Straight0);

UI PointTool(Straight1);

UI PointTool(Straight2);

(* Draw an undirected, singly-directed or 
   doubly-directed straight edge, respectively, from the 
   node "a" to the node "b". *)

PROC Curved0(a, b, c, d) IS 
  VAR ab, dc IN 
    ab := Intercept(a, b); 
    dc := Intercept(d, c); 
    PS.MoveTo(ab); 
    PS.CurveTo(b, c, dc); 
    PS.Stroke() 
  END 
END;

PROC Curved1(a, b, c, d) IS 
  VAR ab, dc IN 
    ab := Intercept(a, b); 
    dc := Intercept(d, c); 
    Arrow.Curved(ab, b, c, dc) 
  END 
END;

PROC Curved2(a, b, c, d) IS 
  VAR ab, dc IN 
    ab := Intercept(a, b); 
    dc := Intercept(d, c); 
    Arrow.DblCurved(ab, b, c, dc) 
  END 
END;

UI PointTool(Curved0);

UI PointTool(Curved1);

UI PointTool(Curved2);

(* Draw an undirected, singly-directed or 
   doubly-directed curved edge, respectively, from the 
   node "a" to the node "d" with Bezier control points 
   "b" and "c". *)

CONST DefaultFillColor = Color.White;

(* This module maintains a current fill color, used by 
   the "FilledNode" procedure. *)

PRIVATE VAR fillColor := DefaultFillColor;

PROC SetFillColor(c) IS fillColor := c END;

UI SetTool(SetFillColor);

UI Param(SetFillColor, DefaultFillColor);

(* Set the current fill color to "c". *)

PROC FilledNode(a) IS 
  NodePath(a); 
  SAVE PS IN PS.SetColor(fillColor); PS.Fill() END; 
  PS.Stroke() 
END;

UI PointTool(FilledNode);

(* Like "Node" above, but the inside of the node is 
   filled with the current fill color. *)

PRIVATE VAR history := NIL;

PROC Save() IS 
  history := ([width, eccentricity, fillColor], history) 
END;

PROC Restore() IS 
  VAR top IN 
    top := CAR(history); 
    width := CAR(top); 
    eccentricity := CAR(CDR(top)); 
    fillColor := CAR(CDR(CDR(top))); 
    history := CDR(history) 
  END 
END;

UI PointTool(Save);

UI PointTool(Restore);

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