Commit fd728230 authored by Benoît Barbot's avatar Benoît Barbot
Browse files

Merge branch 'master' of gitlacl:barbot/GraphEditor

parents f33e1ed4 1060499e
Pipeline #2799 passed with stage
in 57 seconds
...@@ -5,14 +5,17 @@ ...@@ -5,14 +5,17 @@
image: registry.git.lacl.fr/barbot/grapheditor image: registry.git.lacl.fr/barbot/grapheditor
before_script: before_script:
- eval `opam config env` #- eval `opam config env`
- opam update #- opam update
- opam install eliom js_of_ocaml js_of_ocaml-lwt lwt_ppx js_of_ocaml-ppx js_of_ocaml-ppx_deriving_json xml-light #- opam install eliom js_of_ocaml js_of_ocaml-lwt lwt_ppx js_of_ocaml-ppx js_of_ocaml-ppx_deriving_json xml-light
build: build:
stage: build stage: build
script: script:
- eval `opam config env`
- opam update
- opam install eliom js_of_ocaml js_of_ocaml-lwt lwt_ppx js_of_ocaml-ppx js_of_ocaml-ppx_deriving_json xml-light
- cd editor - cd editor
- oasis setup - oasis setup
- make - make
...@@ -26,3 +29,13 @@ build: ...@@ -26,3 +29,13 @@ build:
paths: paths:
- TAEditor/ - TAEditor/
builddune:
image: registry.git.lacl.fr/barbot/wordgen:latest
stage: build
script:
- dune build
artifacts:
paths:
- _build/default/TAEditor/
- _build/default/TikzEditor/
from ocaml/opam:debian-ocaml-4.05
RUN sudo apt-get update -y; sudo apt-get install -y pkg-config libgdbm-dev libgmp-dev libpcre3-dev libssl-dev zlib1g-dev; sudo apt-get clean
RUN eval $(opam env); opam update;
RUN eval $(opam env); opam install eliom js_of_ocaml js_of_ocaml-lwt lwt_ppx js_of_ocaml-ppx js_of_ocaml-ppx_deriving_json xml-light ocamlbuild
ADD editor editor
RUN cd editor; eval $(opam env);make; make install
ADD TikzEditor TikzEditor
RUN cd TikzEditor; eval $(opam env); make
type def = string list open GraphEditor
type invariant = string type def = string list
type guard = string type invariant = string
type state = string * invariant * bool * bool type guard = string
type arc = string * guard * string list type state = string * invariant * bool * bool
type attribute_id = int type arc = string * guard * string list
type attribute = [ `Choice of string list type attribute_id = int
| `Check of bool
| `ControlPoint of DrawingGeom.point type attribute =
| `String of string [ `Choice of string list
| `Color of string ] | `Check of bool
| `ControlPoint of DrawingGeom.point
let string_of_reset r = | `String of string
Printf.sprintf "{%s}" (List.fold_left (fun x s -> if x="" then s else x^","^s) "" r) | `Color of string ]
let init_def () = ["x";"y"] let string_of_reset r =
let init_arc _ _ = Some ("a","true",[]) Printf.sprintf "{%s}"
(List.fold_left (fun x s -> if x = "" then s else x ^ "," ^ s) "" r)
let state_id = ref 0
let init_state () = incr state_id; let init_def () = [ "x"; "y" ]
((string_of_int !state_id), "true", !state_id=1 , false) let init_arc _ _ = Some ("a", "true", [])
let draw_state (s,inv,init,final) p = let state_id = ref 0
let l =
[ let init_state () =
`Circle (p,10.0); incr state_id;
`Text(p,s^ (if inv<> "true" then ","^inv else "")); (string_of_int !state_id, "true", !state_id = 1, false)
] in
let (x,y) = p in let draw_state (s, inv, init, final) p =
let l2 = if init then (`Line (p,(x -. 25.0,y))) :: (`Arrow ((x-.10.0,y),(x -. 25.0,y))) :: l let l =
else l in [
if final then (`Circle (p,13.0))::l2 `Circle (p, 10.0); `Text (p, s ^ if inv <> "true" then "," ^ inv else "");
else l2 ]
in
let draw_arc (label,inv,reset) (source_sh,target_sh) = let x, y = p in
let open DrawingGeom in let l2 =
let pos1 = center_shape source_sh in if init then
let pos2 = center_shape target_sh in `Line (p, (x -. 25.0, y)) :: `Arrow ((x -. 10.0, y), (x -. 25.0, y)) :: l
let text = Printf.sprintf "[%s],%s,%s" label inv (string_of_reset reset) in else l
in
if source_sh<>target_sh then begin if final then `Circle (p, 13.0) :: l2 else l2
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 draw_arc (label, inv, reset) (source_sh, target_sh) =
let p1 = pos1 +.. (40.0 , -.25.0) let open DrawingGeom in
and p2 = pos2 +.. (40.0 , 25.0) in let pos1 = center_shape source_sh 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 pos2 = center_shape target_sh in
end let text = Printf.sprintf "[%s],%s,%s" label inv (string_of_reset reset) in
let get_def_attr def = if source_sh <> target_sh then
"Clocks", (List.mapi (fun i c -> i,"clock "^(string_of_int i),`String c) def) shapes_of_path source_sh
let get_new_def_attr def = [ `Text (0.5, 8.0, text) ]
let n = List.length def in ~arrow2:(Some (fun x y -> `Arrow (x, y)))
["clock "^(string_of_int n), target_sh
(fun d2 -> d2 @ [ ("clock_"^(string_of_int n))],n) ] else
let update_def_attr def attr_id = function let p1 = pos1 +.. (40.0, -25.0) and p2 = pos2 +.. (40.0, 25.0) in
| Some (`String st) -> shapes_of_path source_sh
let _,listat = List.fold_left (fun (i,l) at -> [ `ControlPoint p1; `Text (0.5, 8.0, text); `ControlPoint p2 ]
if i=attr_id then ~arrow2:(Some (fun x y -> `Arrow (x, y)))
(i+1, st::l) else (i+1, at::l)) (0,[]) def in target_sh
Some (List.rev listat)
| None -> let get_def_attr def =
let _,listat = List.fold_left (fun (i,l) nat -> ( "Clocks",
match attr_id with List.mapi (fun i c -> (i, "clock " ^ string_of_int i, `String c)) def )
j when i=j -> i+1,l
| _ -> (i+1, nat::l)) (0,[]) def in let get_new_def_attr def =
Some (List.rev listat) let n = List.length def in
| Some _ -> None [
( "clock " ^ string_of_int n,
fun d2 -> (d2 @ [ "clock_" ^ string_of_int n ], n) );
]
let get_state_attr (s,inv,init,final) =
"State", [(0,"content",`String s) ; let update_def_attr def attr_id = function
(1,"invariant", `String inv) ; | Some (`String st) ->
(2, "initial", `Check init) ; let _, listat =
(3, "final", `Check final) List.fold_left
] (fun (i, l) at ->
if i = attr_id then (i + 1, st :: l) else (i + 1, at :: l))
let update_state_attr (s,inv,init,final) attr_id = function (0, []) def
| None -> (match attr_id with in
0 -> Some ("",inv,init,final) Some (List.rev listat)
| 1 -> Some (s,"true",init,final) | None ->
| _ -> Some (s,inv,init,final) let _, listat =
) List.fold_left
| Some (`String newv) when attr_id = 0 -> (fun (i, l) nat ->
Some (newv,inv,init,final) match attr_id with
| Some (`String newinv) when attr_id = 1 -> | j when i = j -> (i + 1, l)
Some (s,newinv,init,final) | _ -> (i + 1, nat :: l))
| Some (`Check b) when attr_id =2 -> (0, []) def
Some (s,inv,b,final) in
| Some (`Check b) when attr_id =3 -> Some (List.rev listat)
Some (s,inv,init,b) | Some _ -> None
| _ -> None
let get_state_attr (s, inv, init, final) =
let get_new_state_attr (s,inv,init,final) _ = [] ( "State",
[
let get_arc_attr (label,guard,reset) = (0, "content", `String s);
"Arc", [(0,"label",`String label); (1, "invariant", `String inv);
(1,"guard",`String guard); (2, "initial", `Check init);
(2,"reset",`String (string_of_reset reset)); (3, "final", `Check final);
] ] )
let update_arc_attr (label,guard,reset) attr_id = function let update_state_attr (s, inv, init, final) attr_id = function
| Some (`String v) when attr_id = 0 -> | None -> (
Some (v,guard,reset) match attr_id with
| Some (`String v) when attr_id = 1 -> | 0 -> Some ("", inv, init, final)
Some (label,v,reset) | 1 -> Some (s, "true", init, final)
| Some (`String v) when attr_id = 2 -> | _ -> Some (s, inv, init, final))
(try | Some (`String newv) when attr_id = 0 -> Some (newv, inv, init, final)
let ins = String.sub v 1 (String.length v-2) in | Some (`String newinv) when attr_id = 1 -> Some (s, newinv, init, final)
Some (label,guard, (String.split_on_char 'c' ins) ) with | Some (`Check b) when attr_id = 2 -> Some (s, inv, b, final)
_ -> None) | Some (`Check b) when attr_id = 3 -> Some (s, inv, init, b)
| _ -> None | _ -> None
let get_new_arc_attr atlist _ = [] let get_new_state_attr _ _ = []
let string_of_attribute = function let get_arc_attr (label, guard, reset) =
| `Prob arc -> string_of_float arc ( "Arc",
| `StringExpr s -> s [
| `Choice (t::_) -> t (0, "label", `String label);
| `Choice [] -> "" (1, "guard", `String guard);
| `Check b -> string_of_bool b (2, "reset", `String (string_of_reset reset));
| `ControlPoint _ -> "" ] )
let print_to_prism f def stateit arcit = let update_arc_attr (label, guard, reset) attr_id = function
let n = ref (-1) in | Some (`String v) when attr_id = 0 -> Some (v, guard, reset)
stateit (fun _ _ _ -> incr n); | Some (`String v) when attr_id = 1 -> Some (label, v, reset)
Format.fprintf f "pta\nmodule m\n\tstate:[0..%i] init %i;\n" !n 0; | Some (`String v) when attr_id = 2 -> (
List.iter (fun s -> Format.fprintf f "\t%s:clock;\n" s) def; try
let ins = String.sub v 1 (String.length v - 2) in
arcit (fun _ (label,guard,reset) ((source,(_,invarient,_,_),_),(target,_,_))-> Some (label, guard, String.split_on_char 'c' ins)
let g2 = if guard = "true" then "" else "&"^guard in with _ -> None)
let g3 = if invarient = "true" then "" else "&"^invarient in | _ -> None
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; let get_new_arc_attr _ _ = []
Format.fprintf f ";\n";
); let string_of_attribute = function
Format.fprintf f "endmodule\n" | `Prob arc -> string_of_float arc
| `StringExpr s -> s
let print = | `Choice (t :: _) -> t
["dot" , (fun f _ stateit arcit -> | `Choice [] -> ""
Format.fprintf f "digraph {\n"; | `Check b -> string_of_bool b
stateit (fun _ (s,_,_,_) (x,y) -> Format.fprintf f "%s [pos=\"%f,%f\"];\n" s (x) (y)); | `ControlPoint _ -> ""
arcit (fun _ _ ((_,(source,_,_,_),_),(_,(target,_,_,_),_)) ->
Format.fprintf f "%s -> %s;\n" source target); let print_to_prism f def stateit arcit =
Format.fprintf f "}") , "markovChain.dot"; let n = ref (-1) in
"prism", print_to_prism, "pta.prism" 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;
let parse_file _ add_node add_arc = () 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 _ _ _ = ()
(executable
(name ta_editor)
(modes js byte)
(modules TAGraph Ta_editor)
(libraries js_of_ocaml js_of_ocaml-lwt GraphEditor)
(preprocess
(pps js_of_ocaml-ppx)))
<!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
open Js_of_ocaml open Js_of_ocaml
open GraphEditor
open UtilsWeb open UtilsWeb
module TAGraphEd = GraphDrawing.Make (SimpleGraph.S (TAGraph))
module TAGraphEd = GraphDrawing.GraphEditor(SimpleGraph.S(TAGraph)) let _ =
let _ =
let create_form = div [] in let create_form = div [] in
let canvas = let ca = Dom_html.(createCanvas document) in let canvas =
ca##.width := 2048; let ca = Dom_html.(createCanvas document) in
ca##.height := 1024; ca##.width := 2048;
ca in ca##.height := 1024;
let slider = let sl = Dom_html.(createInput ~_type: (Js.string "range") document) in ca
sl##.value := Js.string "40"; in
sl##.id := Js.string "zoomslider"; let slider =
sl in 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 attribute_list_div =
let div = Dom_html.(createDiv document) in let div = Dom_html.(createDiv document) in
append_node div (ul ~id:"attributelist" []); append_node div (ul ~id:"attributelist" []);
div in div
in
let attribute_div = 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 = let graph_editor =
div ~class_:"row jumbotron" [ div ~class_:"row jumbotron"
div ~class_:"col-8" [ [
div ~class_:"col-8"
[
create_form; create_form;
div ~class_:"container" [ div ~class_:"container"
(let dr = div_raw ~class_:"graph_editor_canvas" [ (canvas :> Dom.node Js.t) ] in [
(*dr##.oncontextmenu := (fun _ -> ());*) (let dr =
(dr :> Dom.node Js.t)) ; div ~class_:"graph_editor_canvas" [(canvas :> Dom.node Js.t)]
div ~class_:"zoom_slider" [txt "zoom: "; (slider :> Dom.node Js.t)] in
]]; (*dr##.oncontextmenu := (fun _ -> ());*)
div ~class_:"col-4" [ attribute_div ] (dr :> Dom.node Js.t));
] in div ~class_:"zoom_slider"
run @@ fun () -> [ txt "zoom: "; (slider :> Dom.node Js.t) ];
let ed = TAGraphEd.init ~saveload:create_form ~slider canvas attribute_list_div in ];
TAGraphEd.init_client ed; ];
graph_editor 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
<?xml version="1.0" encoding="utf-8"?> <?xml version="1.0" encoding="utf-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" lang="en"> <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"/> <head profile="http://www.w3.org/2005/10/profile">
<link rel="stylesheet" type="text/css" href="style.css"/> <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> <link rel="stylesheet" type="text/css" href="bootstrap.min.css" />
<script type="text/javascript" src="jquery.min.js"></script> <link rel="stylesheet" type="text/css" href="style.css" />
<script type="text/javascript" src="bootstrap.min.js"></script>
<script type="text/javascript" src="download.min.js"></script> <script type="text/javascript" src="ta_editor.js"></script>
</head> <script type="text/javascript" src="jquery.min.js"></script>
<body> <script type="text/javascript" src="bootstrap.min.js"></script>
<nav class="navbar navbar-expand-md navbar-dark fixed-top bg-dark"> <script type="text/javascript" src="download.min.js"></script>
<a class="navbar-brand" href="#">TA Editor</a> </head>
</nav>
</body> <body>
</html> <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
.graph_editor_canvas { .graph_editor_canvas {
overflow: auto; overflow: auto;
height:768px; height:768px;
background-color: beige;
} }
.zoom_slider { .zoom_slider {
......
This diff is collapsed.
(executable
(name tikz_editor)
(modes js byte)
(modules Tikz_editor TikzGraph TikzParser TikzLexer)
(libraries js_of_ocaml js_of_ocaml-lwt GraphEditor)
(preprocess
(pps js_of_ocaml-ppx)))
(ocamllex tikzLexer)
(ocamlyacc tikzParser)
...@@ -18,7 +18,7 @@ ...@@ -18,7 +18,7 @@
%token PATHDELIM CONTROLDELIM %token PATHDELIM CONTROLDELIM
%start main %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: main:
...@@ -29,13 +29,13 @@ main: ...@@ -29,13 +29,13 @@ main:
body: body:
BACKSLASH NODE node 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; Printf.printf "\\node[] (%f,%f) %s %s;\n" x y name content;
let n,a = $4 in let n,a = $4 in
$3 :: n , a $3 :: n , a
} }
| BACKSLASH DRAW draw body { | BACKSLASH DRAW draw body {
let (al,start,fin,pl) = $3 in let (_,start,fin,_) = $3 in
Printf.printf "\\draw %s -> %s;\n" start fin; Printf.printf "\\draw %s -> %s;\n" start fin;
let n,a = $4 in n,$3::a }