
(* A small library to draw automata. *)

open Mlpost
open Path
open Point
open Num
open Command
open Box
(*parse <<togglescript>> *)
(* Nodes are boxes (type Box.t), created using functions such as "state" and
   "final" below. These boxes are given names using the labeled argument 
   ~name, for further reference in transition drawing. Nodes placement is
   left to the user, and is typically performed using alignment functions
   such as Box.hbox, Box.vbox or Box.tabularl (see examples below). 
 
   Given a set of placed nodes, that is a box containing nodes as sub-boxes,
   function "transition" draws a transition from one node to another, given
   their names. A label and its position are also given. Optional arguments
   outd and ind can be used to control the shape of the arrow (when it must
   not be a straight arrow). Function "loop" is used to draw a self-transition,
   drawn below a node (it could be easily generalized to draw a loop to the
   right of the node, etc.). Finally, function "initial" draws an incoming
   arrow to the left of a node (again, it could be generalized).
*)

let state = Box.tex ~dx:(bp 4.) ~style:Circle ~stroke:(Some Color.black)

let final = Box.box ~style:Circle 

let transition states tex anchor ?outd ?ind x_name y_name = 
  let x = Box.get x_name states and y = Box.get y_name states in
  let outd = match outd with None -> None | Some a -> Some (vec (dir a)) in
  let ind = match ind with None -> None | Some a -> Some (vec (dir a)) in
  Arrow.draw ~tex ~anchor (cpath ?outd ?ind x y) 

let loop states tex name =
  let box = Box.get name states in
  let a = Point.shift (Box.south box) (Point.pt (cm 0., cm (-0.4))) in
  let c = Box.ctr box in
  let p = Path.pathk [
    knotp ~r: (vec (dir 225.)) c;
    knotp a;
    knotp ~l: (vec (dir 135.)) c;
  ] in
  let bp = Box.bpath box in
  Arrow.draw ~tex ~anchor:`Bot (cut_after bp (cut_before bp p))

let initial states name =
  let b = Box.get name states in
  let p = Box.west b in
  Arrow.draw (Path.pathp [ Point.shift p (Point.pt (cm (-0.3), zero)); p ])

(*** Examples ***************************************************************)

(*parse <<automata1 *)

let automata1 =
  let states = Box.hbox ~padding: (cm 1.4)
    [ state ~name:"0" "0"; final ~name:"1" (state "1") ]
  in
  seq [ Box.draw states;
        transition states "0..9" `Top "0" "1";
        (*loop states "0..9" "1";
        initial states "0" *)]

(*parse >> *)

(*parse <<automata2 *)

let automata2 =
  let states = Box.hbox ~padding: (cm 2.)
    [ state ~name:"0" "0"; state ~name:"1" "1"; 
      state ~name:"2" "2"; state ~name:"3" "3"; 
      final ~name:"4" (state "4") ]
  in
  seq [ Box.draw states; initial states "0";
        transition states "\\texttt{(}" `Top "0" "1"; 
        transition states "\\texttt{*}" `Top "1" "2";
        transition states "\\texttt{*}" `Top ~outd: 25. ~ind: 335. "2" "3";
        transition states "$a$" `Bot ~outd: 205. ~ind: 155. "3" "2";
        transition states "\\texttt{)}" `Top "3" "4";
        loop states "$b$" "2";
        loop states "*" "3";
     ]

(*parse >> *)

(****

let state name s = rect ~name  ~stroke:None (rect (tex ("$" ^ s ^ "$")))

let automata3 =
  let states = tabularl ~hpadding:(cm 1.) ~vpadding:(cm 1.)
    [[state "11" "S\\rightarrow E\\bullet";
      state "0" "S\\rightarrow\\bullet E"; 
      state "5" "E\\rightarrow\\texttt{int}\\bullet";
      ];
     [state "1" "E\\rightarrow\\bullet E\\texttt{+}E";
      state "3" "E\\rightarrow\\bullet\\texttt{(}E\\texttt{)}";
      state "2" "E\\rightarrow\\bullet\\texttt{int}";
     ];
     [state "4" "E\\rightarrow E\\bullet\\texttt{+}E";
      state "7" "E\\rightarrow E\\texttt{+}\\bullet E";
      state "6" "E\\rightarrow\\texttt{(}\\bullet E\\texttt{)}";
     ];
     [state "9" "E\\rightarrow E\\texttt{+}E\\bullet";
      state "10" "E\\rightarrow\\texttt{(}E\\texttt{)}\\bullet";
      state "8" "E\\rightarrow\\texttt{(}E \\bullet\\texttt{)}";
     ]
    ]
  in
  let eps = "$\\epsilon$" in
  let tt s = "\\texttt{" ^ s ^ "}" in
  [draw states;
   transition states "$E$" `Top "0" "11";
   transition states eps `Upleft "0" "1";
   transition states eps `Upright "0" "2";
   transition states eps `Left "0" "3";

   loop states eps "1";
   transition states "$E$" `Left "1" "4";
   transition states eps `Top "1" "3";
   transition states eps `Upright ~outd:20. "1" "2";

   transition states (tt "+") `Top "4" "7";

   transition states eps `Lowleft "7" "1";
   transition states eps `Right "7" "2";
   transition states eps `Right "7" "3";
   transition states "$E$" `Upleft "7" "9";

   transition states (tt "int") `Left "2" "5";

   transition states (tt "(") ~outd:(-0.) `Top "3" "6";
   transition states "$E$" `Left "6" "8";
   transition states (tt ")") `Top "8" "10";

   transition states eps ~outd:170. `Lowleft  "6" "1";
   transition states eps `Right  "6" "2";
   transition states eps ~outd:160. `Top  "6" "3";
  ]

****)

(*parse <<automata4 *)

let state name l = 
  rect ~name ~stroke:None 
    (rect (tex ("$\\begin{array}{l}" ^ 
		String.concat "\\\\" l ^ 
		"\\end{array}$")))

let automata4 =
  let states = tabularl ~hpadding:(cm 1.) ~vpadding:(cm 1.)
    [[state "1" ["S\\rightarrow\\bullet E\\#";
		 "E\\rightarrow\\bullet E\\texttt{+}E";
		 "E\\rightarrow\\bullet\\texttt{(}E\\texttt{)}";
		 "E\\rightarrow\\bullet\\texttt{int}"];
      state "2" ["E\\rightarrow\\texttt{int}\\bullet"];
      state "3" ["S\\rightarrow E\\bullet\\#";
		 "E\\rightarrow E\\bullet\\texttt{+}E";]
     ];
     [state "4" ["E\\rightarrow\\texttt{(}\\bullet E\\texttt{)}";
		 "E\\rightarrow\\bullet E\\texttt{+}E";
		 "E\\rightarrow\\bullet\\texttt{(}E\\texttt{)}";
		 "E\\rightarrow\\bullet\\texttt{int}";
		];
      state "5" ["E\\rightarrow\\texttt{(}E \\bullet\\texttt{)}";
		 "E\\rightarrow E\\bullet\\texttt{+}E"];
      state "6" ["E\\rightarrow E\\texttt{+}\\bullet E";
		 "E\\rightarrow\\bullet E\\texttt{+}E";
		 "E\\rightarrow\\bullet\\texttt{(}E\\texttt{)}";
		 "E\\rightarrow\\bullet\\texttt{int}";
		]
     ];
     [empty ();
      state "7" ["E\\rightarrow\\texttt{(}E\\texttt{)}\\bullet"];
      state "8" ["E\\rightarrow E\\texttt{+}E\\bullet";
		 "E\\rightarrow E\\bullet\\texttt{+}E"]
     ]
    ]
  in
  let tt s = "\\texttt{" ^ s ^ "}" in
  seq [draw states;
       initial states "1";
       transition states "$E$" `Top ~outd:30. "1" "3";
       transition states (tt "(") `Left "1" "4";
       transition states (tt "(") `Top ~outd:150. "6" "4";
       transition states (tt "int") `Bot "1" "2";
       transition states (tt "int") `Lowright "4" "2";
       transition states (tt "int") `Lowleft "6" "2";
       transition states (tt "+") `Right "3" "6";
       transition states (tt "+") `Top "5" "6";
       transition states "$E$" `Left ~outd:(-110.) "6" "8";
       transition states (tt "+") `Right ~outd:70. "8" "6";
       transition states "$E$" `Top  "4" "5";
       transition states (tt ")") `Left "5" "7";
       loop states (tt "(") "4";
      ]

(*parse >> *)

let () = Metapost.emit "automata1" (Picture.scale (Num.bp 3.) automata1)
let () = Metapost.emit "automata2" (Picture.scale (Num.bp 3.) automata2)
let () = Metapost.emit "automata4" (Picture.scale (Num.bp 2.) automata4)
