dot.ml 2.58 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125
open Printf

(* ------------------------------------------------------------------------- *)

(* Type definitions. *)

type size =
    float * float (* in inches *)

type orientation =
  | Portrait
  | Landscape

type rankdir =
  | LeftToRight
  | TopToBottom

type ratio =
  | Compress
  | Fill
  | Auto

type style =

    (* Both nodes and edges. *)

  | Solid
  | Dashed
  | Dotted
  | Bold
  | Invisible

    (* Nodes only. *)

  | Filled
  | Diagonals
  | Rounded

(* ------------------------------------------------------------------------- *)

(* Basic printers. *)

let print_style = function
  | None ->
      ""
  | Some style ->
      let style =
	match style with
	| Solid ->
	    "solid"
	| Dashed ->
	    "dashed"
	| Dotted ->
	    "dotted"
	| Bold ->
	    "bold"
	| Invisible ->
	    "invis"
	| Filled ->
	    "filled"
	| Diagonals ->
	    "diagonals"
	| Rounded ->
	    "rounded"
      in
      sprintf ", style = %s" style

(* ------------------------------------------------------------------------- *)

(* The graph printer. *)

module Print (G : sig

  type vertex

  val name: vertex -> string

  val successors: (?style:style -> label:string -> vertex -> unit) -> vertex -> unit

  val iter: (?style:style -> label:string -> vertex -> unit) -> unit

end) = struct

  let print
      ?(directed = true)
      ?size
      ?(orientation = Landscape)
      ?(rankdir = LeftToRight)
      ?(ratio = Compress)
      (f : out_channel)
      =

    fprintf f "%s G {\n" (if directed then "digraph" else "graph");
    Option.iter (fun (hsize, vsize) ->
      fprintf f "size=\"%f, %f\";\n" hsize vsize
    ) size;
    begin match orientation with
      | Portrait ->
	  fprintf f "orientation = portrait;\n"
      | Landscape ->
	  fprintf f "orientation = landscape;\n"
    end;
    begin match rankdir with
      | LeftToRight ->
	  fprintf f "rankdir = LR;\n"
      | TopToBottom ->
	  fprintf f "rankdir = TB;\n"
    end;
    begin match ratio with
      | Compress ->
	  fprintf f "ratio = compress;\n"
      | Fill ->
	  fprintf f "ratio = fill;\n"
      | Auto ->
	  fprintf f "ratio = auto;\n"
    end;

    G.iter (fun ?style ~label vertex ->
      fprintf f "%s [ label=\"%s\"%s ] ;\n"
	(G.name vertex)
	label
	(print_style style)
    );

    G.iter (fun ?style ~label source ->
126 127
      ignore style; (* avoid unused variable warnings *)
      ignore label;
128 129 130 131 132 133 134 135 136 137 138 139 140 141
      G.successors (fun ?style ~label destination ->
	fprintf f "%s %s %s [ label=\"%s\"%s ] ;\n"
	  (G.name source)
	  (if directed then "->" else "--")
	  (G.name destination)
	  label
	  (print_style style)
      ) source
    );

    fprintf f "\n}\n"

end