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 @@
image: registry.git.lacl.fr/barbot/grapheditor
before_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
#- 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
build:
stage: build
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
- oasis setup
- make
......@@ -26,3 +29,13 @@ build:
paths:
- 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
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
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 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_def () = ["x";"y"]
let init_arc _ _ = Some ("a","true",[])
let init_state () =
incr state_id;
(string_of_int !state_id, "true", !state_id = 1, false)
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 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) =
`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 =
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
[
( "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
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 ->
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
| 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)
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_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)
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 get_new_arc_attr _ _ = []
let string_of_attribute = function
let string_of_attribute = function
| `Prob arc -> string_of_float arc
| `StringExpr s -> s
| `Choice (t::_) -> t
| `Choice (t :: _) -> t
| `Choice [] -> ""
| `Check b -> string_of_bool b
| `ControlPoint _ -> ""
let print_to_prism f def stateit arcit =
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;
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 ";\n");
Format.fprintf f "endmodule\n"
let print =
["dot" , (fun f _ stateit arcit ->
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,_,_,_),_)) ->
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"
Format.fprintf f "}"),
"markovChain.dot" );
("prism", print_to_prism, "pta.prism");
]
let parse_file _ add_node add_arc = ()
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 GraphEditor
open UtilsWeb
module TAGraphEd = GraphDrawing.GraphEditor(SimpleGraph.S(TAGraph))
module TAGraphEd = GraphDrawing.Make (SimpleGraph.S (TAGraph))
let _ =
let create_form = div [] in
let canvas = let ca = Dom_html.(createCanvas document) 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
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
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
div ~class_:"container"
[
(let dr =
div ~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
(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
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"?>
<!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">
<head profile="http://www.w3.org/2005/10/profile">
<title>TA Editor</title>
<meta charset="utf-8"/>
<meta charset="utf-8" />
<meta http-equiv="X-UA-Compatible" content="IE=edge" />
<meta name="viewport" content="width=device-width, initial-scale=1"/>
<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"/>
<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>
</head>
<body>
<nav class="navbar navbar-expand-md navbar-dark fixed-top bg-dark">
<a class="navbar-brand" href="#">TA Editor</a>
</nav>
</body>
</body>
</html>
\ No newline at end of file
.graph_editor_canvas {
overflow: auto;
height:768px;
background-color: beige;
}
.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 @@
%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 {
......
<!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
open Js_of_ocaml
open GraphEditor
open UtilsWeb
module TAGraphEd = GraphDrawing.Make (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"