add dune

TAEditor/TAGraph.ml

-    type def = string list
-
-    type invariant = string
-    type guard = string
-    type state = string * invariant * bool * bool
-    type arc = string * guard * string list
-    type attribute_id = int
-    type attribute = [ `Choice of string list
-                     | `Check of bool
-                     | `ControlPoint of DrawingGeom.point
-                     | `String of string
-                     | `Color of string ]
-
-    let string_of_reset r =
-      Printf.sprintf "{%s}" (List.fold_left (fun x s -> if x="" then s else x^","^s) "" r)
-                   
-    let init_def () = ["x";"y"]
-    let init_arc _ _ = Some ("a","true",[])
-
-    let state_id = ref 0
-    let init_state () = incr state_id;
-                        ((string_of_int !state_id), "true", !state_id=1 , false)
-    let draw_state (s,inv,init,final) p = 
-      let l = 
-      [
-        `Circle (p,10.0);
-        `Text(p,s^ (if inv<> "true" then ","^inv else ""));
-      ] in
-      let (x,y) = p in
-      let l2 = if init then (`Line (p,(x -. 25.0,y))) :: (`Arrow ((x-.10.0,y),(x -. 25.0,y))) :: l
-               else l in
-      if final then (`Circle (p,13.0))::l2
-      else l2
-
-    let draw_arc (label,inv,reset) (source_sh,target_sh) =
-      let open DrawingGeom in
-      let pos1 = center_shape source_sh in
-      let pos2 = center_shape target_sh in
-      let text = Printf.sprintf "[%s],%s,%s" label inv (string_of_reset reset) in
-
-      if source_sh<>target_sh then begin
-      shapes_of_path source_sh [`Text (0.5,8.0,text)] ~arrow2:(Some (fun x y -> `Arrow (x,y))) target_sh
-        end else begin
-          let p1 = pos1 +.. (40.0 , -.25.0)
-          and p2 = pos2 +.. (40.0 , 25.0) in
-          shapes_of_path source_sh [`ControlPoint p1; `Text (0.5,8.0,text);`ControlPoint p2] ~arrow2:(Some (fun x y -> `Arrow (x,y))) target_sh
-        end
-
-    let get_def_attr def =
-      "Clocks", (List.mapi (fun i c ->  i,"clock "^(string_of_int i),`String c) def)
-    let get_new_def_attr def = 
-      let n = List.length def in
-      ["clock "^(string_of_int n), 
-       (fun d2 -> d2 @ [ ("clock_"^(string_of_int n))],n) ] 
-    let update_def_attr def attr_id = function
-        | Some (`String st) ->  
-           let _,listat = List.fold_left (fun (i,l) at ->
-                              if i=attr_id then
-                                (i+1, st::l) else (i+1, at::l)) (0,[]) def in
-           Some (List.rev listat)
-        | None ->
-           let _,listat = List.fold_left (fun (i,l) nat ->
-                              match attr_id with
-                                j when i=j -> i+1,l
-                              | _ -> (i+1, nat::l)) (0,[]) def in
-           Some (List.rev listat)
-        | Some _ -> None
-    
-
-
-    let get_state_attr (s,inv,init,final) =
-      "State", [(0,"content",`String s) ;
-                (1,"invariant", `String inv) ;
-                (2, "initial", `Check init) ;
-                (3, "final", `Check final) 
-              ]
-
-    let update_state_attr (s,inv,init,final) attr_id = function
-      | None -> (match attr_id with
-                   0 -> Some ("",inv,init,final)
-                 | 1 -> Some (s,"true",init,final)
-                 | _ -> Some (s,inv,init,final)        
-                )
-      | Some (`String newv) when attr_id = 0 ->
-         Some (newv,inv,init,final)
-      | Some (`String newinv) when attr_id = 1 ->
-         Some (s,newinv,init,final)
-      | Some (`Check b) when attr_id =2 ->
-         Some (s,inv,b,final)
-      | Some (`Check b) when attr_id =3 ->
-         Some (s,inv,init,b)       
-      | _ -> None
-
-    let get_new_state_attr (s,inv,init,final) _ = []
-
-    let get_arc_attr (label,guard,reset) =
-      "Arc", [(0,"label",`String label);
-              (1,"guard",`String guard);
-              (2,"reset",`String (string_of_reset reset));
-             ]
-
-    let update_arc_attr (label,guard,reset) attr_id = function
-      | Some (`String v) when attr_id = 0 ->
-         Some (v,guard,reset)
-      | Some (`String v) when attr_id = 1 ->
-         Some (label,v,reset)
-       | Some (`String v) when attr_id = 2 ->
-         (try 
-            let ins = String.sub v 1 (String.length v-2) in 
-            Some (label,guard, (String.split_on_char 'c' ins) ) with
-           _ -> None)
-      | _ -> None
-
-    let get_new_arc_attr atlist _ = []
-
-    let string_of_attribute = function
-      | `Prob arc -> string_of_float arc
-      | `StringExpr s -> s
-      | `Choice (t::_) -> t
-      | `Choice [] -> ""
-      | `Check b -> string_of_bool b
-      | `ControlPoint _ -> ""
-
-    let print_to_prism f def stateit arcit = 
-      let n = ref (-1) in
-      stateit (fun _ _ _ -> incr n);
-      Format.fprintf f "pta\nmodule m\n\tstate:[0..%i] init %i;\n" !n 0;
-      List.iter (fun s -> Format.fprintf f "\t%s:clock;\n" s) def;
-      
-      arcit (fun _ (label,guard,reset) ((source,(_,invarient,_,_),_),(target,_,_))->
-          let g2 = if guard = "true" then "" else "&"^guard in
-          let g3 = if invarient = "true" then "" else "&"^invarient in 
-          Format.fprintf f "\t[%s] (state=%i)%s%s -> (state'=%i)" label source g2 g3 target;
-          List.iter (fun r -> Format.fprintf f "&(%s'=0)" r) reset;
-          Format.fprintf f ";\n";
-        );
-      Format.fprintf f "endmodule\n"
-
-    let print = 
-      ["dot" , (fun f _ stateit arcit ->
-      Format.fprintf f "digraph {\n";
-      stateit (fun _ (s,_,_,_) (x,y) -> Format.fprintf f "%s [pos=\"%f,%f\"];\n" s (x) (y));
-      arcit (fun _ _ ((_,(source,_,_,_),_),(_,(target,_,_,_),_)) ->
-          Format.fprintf f "%s -> %s;\n" source target);
-      Format.fprintf f "}") , "markovChain.dot";
-       "prism", print_to_prism, "pta.prism" 
-                ]
-
-    let parse_file _ add_node add_arc = ()
+open GraphEditor
+
+type def = string list
+type invariant = string
+type guard = string
+type state = string * invariant * bool * bool
+type arc = string * guard * string list
+type attribute_id = int
+
+type attribute =
+  [ `Choice of string list
+  | `Check of bool
+  | `ControlPoint of DrawingGeom.point
+  | `String of string
+  | `Color of string ]
+
+let string_of_reset r =
+  Printf.sprintf "{%s}"
+    (List.fold_left (fun x s -> if x = "" then s else x ^ "," ^ s) "" r)
+
+let init_def () = [ "x"; "y" ]
+let init_arc _ _ = Some ("a", "true", [])
+let state_id = ref 0
+
+let init_state () =
+  incr state_id;
+  (string_of_int !state_id, "true", !state_id = 1, false)
+
+let draw_state (s, inv, init, final) p =
+  let l =
+    [
+      `Circle (p, 10.0); `Text (p, s ^ if inv <> "true" then "," ^ inv else "");
+    ]
+  in
+  let x, y = p in
+  let l2 =
+    if init then
+      `Line (p, (x -. 25.0, y)) :: `Arrow ((x -. 10.0, y), (x -. 25.0, y)) :: l
+    else l
+  in
+  if final then `Circle (p, 13.0) :: l2 else l2
+
+let draw_arc (label, inv, reset) (source_sh, target_sh) =
+  let open DrawingGeom in
+  let pos1 = center_shape source_sh in
+  let pos2 = center_shape target_sh in
+  let text = Printf.sprintf "[%s],%s,%s" label inv (string_of_reset reset) in
+
+  if source_sh <> target_sh then
+    shapes_of_path source_sh
+      [ `Text (0.5, 8.0, text) ]
+      ~arrow2:(Some (fun x y -> `Arrow (x, y)))
+      target_sh
+  else
+    let p1 = pos1 +.. (40.0, -25.0) and p2 = pos2 +.. (40.0, 25.0) in
+    shapes_of_path source_sh
+      [ `ControlPoint p1; `Text (0.5, 8.0, text); `ControlPoint p2 ]
+      ~arrow2:(Some (fun x y -> `Arrow (x, y)))
+      target_sh
+
+let get_def_attr def =
+  ( "Clocks",
+    List.mapi (fun i c -> (i, "clock " ^ string_of_int i, `String c)) def )
+
+let get_new_def_attr def =
+  let n = List.length def in
+  [
+    ( "clock " ^ string_of_int n,
+      fun d2 -> (d2 @ [ "clock_" ^ string_of_int n ], n) );
+  ]
+
+let update_def_attr def attr_id = function
+  | Some (`String st) ->
+      let _, listat =
+        List.fold_left
+          (fun (i, l) at ->
+            if i = attr_id then (i + 1, st :: l) else (i + 1, at :: l))
+          (0, []) def
+      in
+      Some (List.rev listat)
+  | None ->
+      let _, listat =
+        List.fold_left
+          (fun (i, l) nat ->
+            match attr_id with
+            | j when i = j -> (i + 1, l)
+            | _ -> (i + 1, nat :: l))
+          (0, []) def
+      in
+      Some (List.rev listat)
+  | Some _ -> None
+
+let get_state_attr (s, inv, init, final) =
+  ( "State",
+    [
+      (0, "content", `String s);
+      (1, "invariant", `String inv);
+      (2, "initial", `Check init);
+      (3, "final", `Check final);
+    ] )
+
+let update_state_attr (s, inv, init, final) attr_id = function
+  | None -> (
+      match attr_id with
+      | 0 -> Some ("", inv, init, final)
+      | 1 -> Some (s, "true", init, final)
+      | _ -> Some (s, inv, init, final))
+  | Some (`String newv) when attr_id = 0 -> Some (newv, inv, init, final)
+  | Some (`String newinv) when attr_id = 1 -> Some (s, newinv, init, final)
+  | Some (`Check b) when attr_id = 2 -> Some (s, inv, b, final)
+  | Some (`Check b) when attr_id = 3 -> Some (s, inv, init, b)
+  | _ -> None
+
+let get_new_state_attr _ _ = []
+
+let get_arc_attr (label, guard, reset) =
+  ( "Arc",
+    [
+      (0, "label", `String label);
+      (1, "guard", `String guard);
+      (2, "reset", `String (string_of_reset reset));
+    ] )
+
+let update_arc_attr (label, guard, reset) attr_id = function
+  | Some (`String v) when attr_id = 0 -> Some (v, guard, reset)
+  | Some (`String v) when attr_id = 1 -> Some (label, v, reset)
+  | Some (`String v) when attr_id = 2 -> (
+      try
+        let ins = String.sub v 1 (String.length v - 2) in
+        Some (label, guard, String.split_on_char 'c' ins)
+      with _ -> None)
+  | _ -> None
+
+let get_new_arc_attr _ _ = []
+
+let string_of_attribute = function
+  | `Prob arc -> string_of_float arc
+  | `StringExpr s -> s
+  | `Choice (t :: _) -> t
+  | `Choice [] -> ""
+  | `Check b -> string_of_bool b
+  | `ControlPoint _ -> ""
+
+let print_to_prism f def stateit arcit =
+  let n = ref (-1) in
+  stateit (fun _ _ _ -> incr n);
+  Format.fprintf f "pta\nmodule m\n\tstate:[0..%i] init %i;\n" !n 0;
+  List.iter (fun s -> Format.fprintf f "\t%s:clock;\n" s) def;
+  arcit
+    (fun
+      _
+      (label, guard, reset)
+      ((source, (_, invarient, _, _), _), (target, _, _))
+    ->
+      let g2 = if guard = "true" then "" else "&" ^ guard in
+      let g3 = if invarient = "true" then "" else "&" ^ invarient in
+      Format.fprintf f "\t[%s] (state=%i)%s%s -> (state'=%i)" label source g2 g3
+        target;
+      List.iter (fun r -> Format.fprintf f "&(%s'=0)" r) reset;
+      Format.fprintf f ";\n");
+  Format.fprintf f "endmodule\n"
+
+let print =
+  [
+    ( "dot",
+      (fun f _ stateit arcit ->
+        Format.fprintf f "digraph {\n";
+        stateit (fun _ (s, _, _, _) (x, y) ->
+            Format.fprintf f "%s [pos=\"%f,%f\"];\n" s x y);
+        arcit (fun _ _ ((_, (source, _, _, _), _), (_, (target, _, _, _), _)) ->
+            Format.fprintf f "%s -> %s;\n" source target);
+        Format.fprintf f "}"),
+      "markovChain.dot" );
+    ("prism", print_to_prism, "pta.prism");
+  ]
+
+let parse_file _ _ _ = ()

TAEditor/dune

+(executable
+ (name ta_editor)
+ (modes js byte)
+ (libraries js_of_ocaml js_of_ocaml-lwt GraphEditor)
+ (preprocess
+  (pps js_of_ocaml-ppx)))

TAEditor/ta_editor.html

+<!DOCTYPE html>
+<html lang="en">
+
+<head>
+  <meta charset="utf-8">
+
+  <link rel="stylesheet" type="text/css" href="website/bootstrap.min.css" />
+  <link rel="stylesheet" type="text/css" href="website/style.css" />
+
+  <script type='text/javascript' src="https://ajax.googleapis.com/ajax/libs/jquery/1.12.4/jquery.min.js"></script>
+  <script type='text/javascript' src="website/bootstrap.min.js"></script>
+  <script type='text/javascript' src="website/download.min.js"></script>
+  <!-- <script type='text/javascript' src="website/upload.js"></script>-->
+
+
+  <script type='text/javascript' src="ta_editor.bc.js"></script>
+
+</head>
+
+<body>
+</body>
+
+</html>
\ No newline at end of file

TAEditor/ta_editor.ml

 open Js_of_ocaml
+open GraphEditor
 open UtilsWeb
+module TAGraphEd = GraphDrawing.GraphEditor (SimpleGraph.S (TAGraph))
 
-module TAGraphEd = GraphDrawing.GraphEditor(SimpleGraph.S(TAGraph))
-
-
-
-let _ = 
+let _ =
   let create_form = div [] in
-  let canvas = let ca = Dom_html.(createCanvas document) in
-                ca##.width := 2048;
-                ca##.height := 1024;
-                ca in
-  let slider = let sl = Dom_html.(createInput ~_type: (Js.string "range") document) in
-                sl##.value := Js.string "40";
-                sl##.id := Js.string "zoomslider";
-                sl in
+  let canvas =
+    let ca = Dom_html.(createCanvas document) in
+    ca##.width := 2048;
+    ca##.height := 1024;
+    ca
+  in
+  let slider =
+    let sl = Dom_html.(createInput ~_type:(Js.string "range") document) in
+    sl##.value := Js.string "40";
+    sl##.id := Js.string "zoomslider";
+    sl
+  in
   let attribute_list_div =
     let div = Dom_html.(createDiv document) in
     append_node div (ul ~id:"attributelist" []);
-    div in
+    div
+  in
 
   let attribute_div =
-    div ~class_:"attributelistdiv" [ (attribute_list_div :> Dom.node Js.t) ] in
+    div ~class_:"attributelistdiv" [ (attribute_list_div :> Dom.node Js.t) ]
+  in
 
   let graph_editor =
-    div ~class_:"row jumbotron" [
-        div ~class_:"col-8" [
+    div ~class_:"row jumbotron"
+      [
+        div ~class_:"col-8"
+          [
             create_form;
-            div ~class_:"container" [
-                (let dr = div_raw ~class_:"graph_editor_canvas" [ (canvas :> Dom.node Js.t) ] in
-                (*dr##.oncontextmenu := (fun _ -> ());*)
-                (dr :> Dom.node Js.t)) ;
-                div ~class_:"zoom_slider" [txt "zoom: "; (slider :> Dom.node Js.t)]
-          ]];
-        div ~class_:"col-4" [ attribute_div ]
-      ] in
-      run @@ fun () ->
-             let ed = TAGraphEd.init ~saveload:create_form ~slider canvas attribute_list_div in
-             TAGraphEd.init_client ed;
-             graph_editor
-               
+            div ~class_:"container"
+              [
+                (let dr =
+                   div_raw ~class_:"graph_editor_canvas"
+                     [ (canvas :> Dom.node Js.t) ]
+                 in
+                 (*dr##.oncontextmenu := (fun _ -> ());*)
+                 (dr :> Dom.node Js.t));
+                div ~class_:"zoom_slider"
+                  [ txt "zoom: "; (slider :> Dom.node Js.t) ];
+              ];
+          ];
+        div ~class_:"col-4" [ attribute_div ];
+      ]
+  in
+  run @@ fun () ->
+  let ed =
+    TAGraphEd.init ~saveload:create_form ~slider canvas attribute_list_div
+  in
+  TAGraphEd.init_client ed;
+  graph_editor

TAEditor/website/index.html

 <?xml version="1.0" encoding="utf-8"?>
-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
-          "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
 <html xmlns="http://www.w3.org/1999/xhtml" lang="en">
-  <head profile="http://www.w3.org/2005/10/profile">
-    <title>TA Editor</title>
-    <meta charset="utf-8"/>
-    <meta http-equiv="X-UA-Compatible" content="IE=edge" />
-    <meta name="viewport" content="width=device-width, initial-scale=1"/>
 
-    <link rel="stylesheet" type="text/css" href="bootstrap.min.css"/>
-    <link rel="stylesheet" type="text/css" href="style.css"/>
+<head profile="http://www.w3.org/2005/10/profile">
+  <title>TA Editor</title>
+  <meta charset="utf-8" />
+  <meta http-equiv="X-UA-Compatible" content="IE=edge" />
+  <meta name="viewport" content="width=device-width, initial-scale=1" />
 
-    <script type="text/javascript" src="ta_editor.js"></script>
-    <script type="text/javascript" src="jquery.min.js"></script>
-    <script type="text/javascript" src="bootstrap.min.js"></script>
-    <script type="text/javascript" src="download.min.js"></script>
-  </head>
-  <body>
-    <nav class="navbar navbar-expand-md navbar-dark fixed-top bg-dark">
-      <a class="navbar-brand" href="#">TA Editor</a>
-    </nav>
-  </body>
-</html>
+  <link rel="stylesheet" type="text/css" href="bootstrap.min.css" />
+  <link rel="stylesheet" type="text/css" href="style.css" />
+
+  <script type="text/javascript" src="ta_editor.js"></script>
+  <script type="text/javascript" src="jquery.min.js"></script>
+  <script type="text/javascript" src="bootstrap.min.js"></script>
+  <script type="text/javascript" src="download.min.js"></script>
+</head>
+
+<body>
+  <nav class="navbar navbar-expand-md navbar-dark fixed-top bg-dark">
+    <a class="navbar-brand" href="#">TA Editor</a>
+  </nav>
+</body>
+
+</html>
\ No newline at end of file

TikzEditor/dune

+(executable
+ (name tikz_editor)
+ (modes js byte)
+ (libraries js_of_ocaml js_of_ocaml-lwt GraphEditor)
+ (preprocess
+  (pps js_of_ocaml-ppx)))
+
+(ocamllex tikzLexer)
+
+(ocamlyacc tikzParser)

TikzEditor/tikzParser.mly

@@ -18,7 +18,7 @@
 %token PATHDELIM CONTROLDELIM
 
 %start main
-%type <(((float*float)*(string list)*string*string) list)*((string list*string*string*(DrawingGeom.path_elem) list ) list)> main
+%type <(((float*float)*(string list)*string*string) list)*((string list*string*string*(GraphEditor.DrawingGeom.path_elem) list ) list)> main
 %%
 
 main:
@@ -29,13 +29,13 @@ main:
       
 body:
  BACKSLASH NODE node body {
-  let ((x,y),at,name,content) = $3 in
+  let ((x,y),_,name,content) = $3 in
   Printf.printf "\\node[] (%f,%f) %s %s;\n" x y name content;
   let n,a = $4 in
   $3 :: n , a
    }
     | BACKSLASH DRAW draw body {
-let (al,start,fin,pl) = $3 in
+let (_,start,fin,_) = $3 in
 Printf.printf "\\draw %s -> %s;\n" start fin;
 let n,a = $4 in n,$3::a }
     | BACKSLASH PATH draw body {

TikzEditor/tikz_editor.html

+<!DOCTYPE html>
+<html lang="en">
+
+<head>
+  <meta charset="utf-8">
+
+  <link rel="stylesheet" type="text/css" href="static/css/bootstrap.min.css" />
+  <link rel="stylesheet" type="text/css" href="static/css/style.css" />
+
+  <script type='text/javascript' src="https://ajax.googleapis.com/ajax/libs/jquery/1.12.4/jquery.min.js"></script>
+  <script type='text/javascript' src="static/js/bootstrap.min.js"></script>
+  <script type='text/javascript' src="static/js/download.min.js"></script>
+  <!-- <script type='text/javascript' src="website/upload.js"></script>-->
+
+
+  <script type='text/javascript' src="tikz_editor.bc.js"></script>
+
+</head>
+
+<body>
+</body>
+
+</html>
\ No newline at end of file

TikzEditor/tikz_editor.ml

+open Js_of_ocaml
+open GraphEditor
+open UtilsWeb
+module TAGraphEd = GraphDrawing.GraphEditor (SimpleGraph.S (TikzGraph))
+
+let _ =
+  let create_form = div [] in
+  let canvas =
+    let ca = Dom_html.(createCanvas document) in
+    ca##.width := 1024;
+    ca##.height := 1024;
+    ca
+  in
+  let slider =
+    let sl = Dom_html.(createInput ~_type:(Js.string "range") document) in
+    sl##.value := Js.string "40";
+    sl##.id := Js.string "zoomslider";
+    sl
+  in
+  let attribute_list_div =
+    let div = Dom_html.(createDiv document) in
+    append_node div (ul ~id:"attributelist" []);
+    div
+  in
+
+  let attribute_div =
+    div ~class_:"attributelistdiv" [ (attribute_list_div :> Dom.node Js.t) ]
+  in
+
+  let graph_editor =
+    div ~class_:"row jumbotron"
+      [
+        div ~class_:"col-8"
+          [
+            create_form;
+            div ~class_:"container"
+              [
+                (let dr =