Commit 0f78d719 authored by Benoit Barbot's avatar Benoit Barbot
Browse files

refactor

parent 1e60a2c5
Pipeline #953 failed with stage
in 12 seconds
../editor/Data.ml
\ No newline at end of file
../editor/Data.mli
\ No newline at end of file
../editor/DrawingGeom.ml
\ No newline at end of file
#---------------------------------------------------------------------- #----------------------------------------------------------------------
# SETTINGS FOR THE ELIOM PROJECT cosmosweb # SETTINGS FOR THE ELIOM PROJECT cosmosweb
#---------------------------------------------------------------------- #----------------------------------------------------------------------
...@@ -9,12 +8,12 @@ PROJECT_NAME := cosmosweb ...@@ -9,12 +8,12 @@ PROJECT_NAME := cosmosweb
SERVER_FILES := $(wildcard *.eliomi *.eliom) SERVER_FILES := $(wildcard *.eliomi *.eliom)
# Source files for the client # Source files for the client
CLIENT_FILES := $(wildcard *.eliomi *.eliom) graphDrawing.ml utilsWeb.ml SimpleGraph.ml Data.ml TikzGraph.ml MarkovChain.ml layout.ml genericSerializer.ml tikzLexer.ml tikzParser.ml DrawingGeom.ml CLIENT_FILES := $(wildcard *.eliomi *.eliom) TAGraph.ml
# OCamlfind packages for the server # OCamlfind packages for the server
SERVER_PACKAGES := lwt.ppx js_of_ocaml-ppx.deriving xml-light SERVER_PACKAGES := lwt.ppx js_of_ocaml-ppx.deriving xml-light
# OCamlfind packages for the client # OCamlfind packages for the client
CLIENT_PACKAGES := lwt.ppx js_of_ocaml-ppx js_of_ocaml-ppx.deriving xml-light CLIENT_PACKAGES := lwt.ppx js_of_ocaml-ppx js_of_ocaml-ppx.deriving xml-light GraphEditor
# Directory with files to be statically served # Directory with files to be statically served
LOCAL_STATIC = static LOCAL_STATIC = static
......
../editor/SimpleGraph.ml
\ No newline at end of file
...@@ -32,12 +32,12 @@ let replace_list id v l = ...@@ -32,12 +32,12 @@ let replace_list id v l =
(i+1, match v with Some v -> v::l | None -> l) (i+1, match v with Some v -> v::l | None -> l)
else (i+1, at::l)) (0,[]) l in else (i+1, at::l)) (0,[]) l in
List.rev listat List.rev listat
let draw_state (s,at) p = let draw_state (s,at) p =
let draw = ref false let draw = ref false
and shape = ref (`Rectangle (p,0.75,7.0,0.0)) and shape = ref (`Rectangle (p,0.75,7.0,0.0))
and color = ref (0,0,0) and color = ref (0,0,0)
and fill = ref (255,255,255) in and fill = ref (255,255,255) in
List.iter (function List.iter (function
"draw" -> draw := true "draw" -> draw := true
| "circle" -> shape := `Circle (p,10.0) | "circle" -> shape := `Circle (p,10.0)
...@@ -51,11 +51,11 @@ let draw_state (s,at) p = ...@@ -51,11 +51,11 @@ let draw_state (s,at) p =
[ `Colors (!color,!fill); [ `Colors (!color,!fill);
!shape; !shape;
(*`Circle (p,10.0);*) (*`Circle (p,10.0);*)
`Text(p,s); `Text(p,s);
`Colors ((0,0,0),(255,255,255)); `Colors ((0,0,0),(255,255,255));
] ]
let get_state_attr (s, at) = let get_state_attr (s, at) =
"Node", ((A,"content",`String s) :: "Node", ((A,"content",`String s) ::
(List.mapi (fun i sv -> (List.mapi (fun i sv ->
...@@ -65,7 +65,7 @@ let get_state_attr (s, at) = ...@@ -65,7 +65,7 @@ let get_state_attr (s, at) =
| Some x -> C i, "Fill", `Color x | Some x -> C i, "Fill", `Color x
| None -> | None ->
(B i),"Attribute", (`String sv )))) at)) (B i),"Attribute", (`String sv )))) at))
let update_state_attr (s,at) attr_id = function let update_state_attr (s,at) attr_id = function
| None -> begin match attr_id with | None -> begin match attr_id with
A -> Some ("",at) A -> Some ("",at)
...@@ -73,20 +73,20 @@ let update_state_attr (s,at) attr_id = function ...@@ -73,20 +73,20 @@ let update_state_attr (s,at) attr_id = function
| _-> None | _-> None
end end
| Some (`String newv) -> begin | Some (`String newv) -> begin
match attr_id with match attr_id with
A -> Some (newv,at) A -> Some (newv,at)
| B id -> Some (s,replace_list id (Some newv) at) | B id -> Some (s,replace_list id (Some newv) at)
| _-> None | _-> None
end end
| Some (`Color newv) -> begin | Some (`Color newv) -> begin
match attr_id with match attr_id with
A -> Some (newv,at) A -> Some (newv,at)
| B id -> Some (s,replace_list id (Some ("color="^newv)) at) | B id -> Some (s,replace_list id (Some ("color="^newv)) at)
| C id -> Some (s,replace_list id (Some ("fill="^newv)) at) | C id -> Some (s,replace_list id (Some ("fill="^newv)) at)
| _ -> None | _ -> None
end end
| _ -> None | _ -> None
let get_new_state_attr (s,at) _ = [ let get_new_state_attr (s,at) _ = [
"Attribute", (fun (s,at) -> (s, at@[""]), B (List.length at)) ; "Attribute", (fun (s,at) -> (s, at@[""]), B (List.length at)) ;
"Color", (fun (s,at) -> (s, at@["color=black"]), B (List.length at)) ; "Color", (fun (s,at) -> (s, at@["color=black"]), B (List.length at)) ;
...@@ -108,15 +108,15 @@ let draw_arc (at,cn) (source_sh,target_sh) = ...@@ -108,15 +108,15 @@ let draw_arc (at,cn) (source_sh,target_sh) =
|> List.map (function Some x -> `Colors (DrawingGeom.Color.parse x,(255,255,255)) |> List.map (function Some x -> `Colors (DrawingGeom.Color.parse x,(255,255,255))
| None -> `Colors ((0,0,0),(255,255,255))) in | None -> `Colors ((0,0,0),(255,255,255))) in
let l = if source_sh<>target_sh || cn<>[] then begin let l = if source_sh<>target_sh || cn<>[] then begin
shapes_of_path source_sh cn ~arrow2:(Some (fun x y -> `SimpleArrow (x,y))) target_sh shapes_of_path source_sh cn ~arrow2:(Some (fun x y -> `SimpleArrow (x,y))) target_sh
end else begin end else begin
let p1 = pos1 +.. (40.0 , -.25.0) let p1 = pos1 +.. (40.0 , -.25.0)
and p2 = pos2 +.. (40.0 , 25.0) in and p2 = pos2 +.. (40.0 , 25.0) in
shapes_of_path source_sh [`ControlPoint p1; `ControlPoint p2] ~arrow2:(Some (fun x y -> `Arrow (x,y))) target_sh shapes_of_path source_sh [`ControlPoint p1; `ControlPoint p2] ~arrow2:(Some (fun x y -> `Arrow (x,y))) target_sh
end in end in
lcol @ l lcol @ l
(* let _,bline = List.fold_left (fun (pi,l) pip -> (pip, `Bezier2 (pi,(0.0,0.0),pip) :: l)) (* let _,bline = List.fold_left (fun (pi,l) pip -> (pip, `Bezier2 (pi,(0.0,0.0),pip) :: l))
(pos1,[`Arrow (pos2,List.hd (List.rev point_list)) ;`Colors ("black","black") ; `Text(textvect, text); `Colors ("black","white")] ) (pos1,[`Arrow (pos2,List.hd (List.rev point_list)) ;`Colors ("black","black") ; `Text(textvect, text); `Colors ("black","white")] )
(point_list@[pos2]) in (point_list@[pos2]) in
...@@ -124,7 +124,7 @@ let draw_arc (at,cn) (source_sh,target_sh) = ...@@ -124,7 +124,7 @@ let draw_arc (at,cn) (source_sh,target_sh) =
let get_arc_attr (atlist,controllist) = let get_arc_attr (atlist,controllist) =
"Arc", ( "Arc", (
(List.mapi (fun i sv -> (List.mapi (fun i sv ->
(match is_prefix sv "color=" with (match is_prefix sv "color=" with
Some x -> D i,"Color",`Color x Some x -> D i,"Color",`Color x
| None -> (B i),"Attribute", (`String sv ))) atlist) | None -> (B i),"Attribute", (`String sv ))) atlist)
...@@ -137,7 +137,7 @@ let get_arc_attr (atlist,controllist) = ...@@ -137,7 +137,7 @@ let get_arc_attr (atlist,controllist) =
(`ControlPoint p) (`ControlPoint p)
)) controllist) )) controllist)
) )
let update_arc_attr (at,cn) attr_id = function let update_arc_attr (at,cn) attr_id = function
| Some (`String newv) -> ( | Some (`String newv) -> (
match attr_id with match attr_id with
...@@ -146,15 +146,15 @@ let update_arc_attr (at,cn) attr_id = function ...@@ -146,15 +146,15 @@ let update_arc_attr (at,cn) attr_id = function
if i=id then if i=id then
(i+1, newv::l) else (i+1, at::l)) (0,[]) at in (i+1, newv::l) else (i+1, at::l)) (0,[]) at in
Some (List.rev listat,cn) Some (List.rev listat,cn)
| C id -> | C id ->
let _,listcn = List.fold_left (fun (i,l) at -> let _,listcn = List.fold_left (fun (i,l) at ->
if i=id then (i+1, (`Text (0.5,newv))::l) if i=id then (i+1, (`Text (0.5,newv))::l)
else (i+1, at::l)) else (i+1, at::l))
(0,[]) cn in (0,[]) cn in
Some (at,(List.rev listcn)) Some (at,(List.rev listcn))
| _ -> None | _ -> None
) )
| Some (`ControlPoint pt) -> | Some (`ControlPoint pt) ->
let _,listcn = List.fold_left (fun (i,l) at -> let _,listcn = List.fold_left (fun (i,l) at ->
begin match attr_id,at with begin match attr_id,at with
...@@ -198,7 +198,7 @@ let print_single_attr f a= ...@@ -198,7 +198,7 @@ let print_single_attr f a=
| Some x -> Format.fprintf f "color={%s}" (to_tikz_string @@ parse x) | Some x -> Format.fprintf f "color={%s}" (to_tikz_string @@ parse x)
| None -> Format.fprintf f "%s" a | None -> Format.fprintf f "%s" a
) )
let rec print_string_attr a = function let rec print_string_attr a = function
[] -> () [] -> ()
| t::[] -> Format.fprintf a "%a" print_single_attr t | t::[] -> Format.fprintf a "%a" print_single_attr t
...@@ -207,7 +207,7 @@ let rec print_string_attr a = function ...@@ -207,7 +207,7 @@ let rec print_string_attr a = function
let to_tikz (x,y) = let to_tikz (x,y) =
(x/.50.),(100.0 -. y/.50.) (x/.50.),(100.0 -. y/.50.)
let from_tikz (x,y) = let from_tikz (x,y) =
(x*.50.),((100.0 -.y)*.50.0) (x*.50.),((100.0 -.y)*.50.0)
let format_quad p0 p1 a p2 = let format_quad p0 p1 a p2 =
...@@ -215,11 +215,11 @@ let format_quad p0 p1 a p2 = ...@@ -215,11 +215,11 @@ let format_quad p0 p1 a p2 =
let x1,y1 = to_tikz ((mult 0.3333 p0) +.. (mult 0.6666 p1)) let x1,y1 = to_tikz ((mult 0.3333 p0) +.. (mult 0.6666 p1))
and x2,y2 = to_tikz ((mult 0.6666 p1) +.. (mult 0.3333 p2)) in and x2,y2 = to_tikz ((mult 0.6666 p1) +.. (mult 0.3333 p2)) in
Format.fprintf a " .. controls (%f,%f) and (%f,%f) .. " x1 y1 x2 y2 Format.fprintf a " .. controls (%f,%f) and (%f,%f) .. " x1 y1 x2 y2
let rec print_path link prev last a = function let rec print_path link prev last a = function
[] -> if link then Format.fprintf a " -- " [] -> if link then Format.fprintf a " -- "
| (`Point pos)::q -> | (`Point pos)::q ->
let x,y = to_tikz pos in let x,y = to_tikz pos in
Format.fprintf a " %s (%f,%f) %a" (if link then "--" else "") Format.fprintf a " %s (%f,%f) %a" (if link then "--" else "")
x y (print_path true pos last) q x y (print_path true pos last) q
| (`ControlPoint p1)::q when not link -> | (`ControlPoint p1)::q when not link ->
...@@ -247,8 +247,8 @@ let rec print_path link prev last a = function ...@@ -247,8 +247,8 @@ let rec print_path link prev last a = function
print_path link prev last a ((`ControlPoint p)::`Text t::q) print_path link prev last a ((`ControlPoint p)::`Text t::q)
| `Text (_,s)::q -> | `Text (_,s)::q ->
Format.fprintf a " %s node {%s}%a" (if link then "--" else "") s (print_path false prev last) q Format.fprintf a " %s node {%s}%a" (if link then "--" else "") s (print_path false prev last) q
let download_file_name = "figure.tikz" let download_file_name = "figure.tikz"
let print f stateit arcit = let print f stateit arcit =
(* Format.fprintf f "\\documentclass[]{article}\n\\usepackage{tikz}\n\\begin{document}";*) (* Format.fprintf f "\\documentclass[]{article}\n\\usepackage{tikz}\n\\begin{document}";*)
Format.fprintf f "\\begin{tikzpicture}\n"; Format.fprintf f "\\begin{tikzpicture}\n";
...@@ -266,10 +266,12 @@ let print_position outx lexbuf = ...@@ -266,10 +266,12 @@ let print_position outx lexbuf =
let pos = lexbuf.lex_curr_p in let pos = lexbuf.lex_curr_p in
Printf.fprintf outx "%s:%d:%d" pos.pos_fname Printf.fprintf outx "%s:%d:%d" pos.pos_fname
pos.pos_lnum (pos.pos_cnum - pos.pos_bol + 1) pos.pos_lnum (pos.pos_cnum - pos.pos_bol + 1)
let parse_file file add_node add_arc = let parse_file file add_node add_arc =
let lexbuf = Lexing.from_string file in let lexbuf = Lexing.from_string file in
try try
()
(*
let nodelist,arclist = TikzParser.main TikzLexer.token lexbuf in let nodelist,arclist = TikzParser.main TikzLexer.token lexbuf in
let nl = Hashtbl.create 10 in let nl = Hashtbl.create 10 in
List.iter (fun (pos,at,name,content) -> List.iter (fun (pos,at,name,content) ->
...@@ -283,11 +285,9 @@ let parse_file file add_node add_arc = ...@@ -283,11 +285,9 @@ let parse_file file add_node add_arc =
| `ControlPoint pos -> `ControlPoint (from_tikz pos) | `ControlPoint pos -> `ControlPoint (from_tikz pos)
| `Text t -> `Text t) pl in | `Text t -> `Text t) pl in
add_arc (al,pl2) s2 fin2) arclist add_arc (al,pl2) s2 fin2) arclist
*)
with with
| Parsing.Parse_error -> | Parsing.Parse_error ->
Printf.fprintf stderr "%a: Parsing error: unexpected token:'%s'\n" Printf.fprintf stderr "%a: Parsing error: unexpected token:'%s'\n"
print_position lexbuf (Lexing.lexeme lexbuf); print_position lexbuf (Lexing.lexeme lexbuf);
failwith "Fail to parse Tikz file format" failwith "Fail to parse Tikz file format"
...@@ -4,24 +4,24 @@ open Eliom_content ...@@ -4,24 +4,24 @@ open Eliom_content
open Html.D open Html.D
] ]
let width = 4096 let width = 4096
let height = 2048 let height = 2048
module Cosmosweb_app = module Cosmosweb_app =
Eliom_registration.App ( Eliom_registration.App (
struct struct
let application_name = "cosmosweb" let application_name = "cosmosweb"
let global_data_path = None let global_data_path = None
end) end)
let canvas_elt = let canvas_elt =
canvas ~a:[a_width width; a_height height] canvas ~a:[a_width width; a_height height]
[pcdata "your browser doesn't support canvas"] [pcdata "your browser doesn't support canvas"]
let attribute_list_div = let attribute_list_div =
div [ul ~a:[a_id "attributelist"] []] div [ul ~a:[a_id "attributelist"] []]
let attribute_div = let attribute_div =
div ~a:[ a_class ["attributelistdiv"] ] [ div ~a:[ a_class ["attributelistdiv"] ] [
attribute_list_div; attribute_list_div;
...@@ -29,73 +29,71 @@ let attribute_div = ...@@ -29,73 +29,71 @@ let attribute_div =
[%%client [%%client
module GenGraph = GraphDrawing.GraphEditor(SimpleGraph.S(MarkovChain)) module TAGraphEd = GraphDrawing.GraphEditor(SimpleGraph.S(TAGraph))
module TikzGraph = GraphDrawing.GraphEditor(SimpleGraph.S(TikzGraph))
] ]
let create_form = let create_form =
div [] div []
let page content = let page content =
html html
(head (title (pcdata "TikZ Editor")) (head (title (pcdata "TikZ Editor"))
[ meta ~a:[a_charset "utf-8"] (); [ meta ~a:[a_charset "utf-8"] ();
meta ~a:[a_http_equiv "X-UA-Compatible"; a_content "IE=edge"] (); meta ~a:[a_http_equiv "X-UA-Compatible"; a_content "IE=edge"] ();
meta ~a:[a_name "viewport"; a_content "width=device-width, initial-scale=1"] (); meta ~a:[a_name "viewport"; a_content "width=device-width, initial-scale=1"] ();
link ~rel:[`Stylesheet] ~href:(Raw.uri_of_string "css/bootstrap.min.css") ()]) link ~rel:[`Stylesheet] ~href:(Raw.uri_of_string "css/bootstrap.min.css") ()])
(body [ (body [
nav ~a:[a_class ["navba";"navbar-expand-md";"navbar-dark";"fixed-top";"bg-dark"]] nav ~a:[a_class ["navba";"navbar-expand-md";"navbar-dark";"fixed-top";"bg-dark"]]
[Raw.a ~a:[a_class ["navbar-brand"]; a_href (Raw.uri_of_string "#")] [Raw.a ~a:[a_class ["navbar-brand"]; a_href (Raw.uri_of_string "#")]
[pcdata "TikZ Editor"]]; [pcdata "TikZ Editor"]];
content; content;
script ~a:[a_src (Xml.uri_of_string "https://ajax.googleapis.com/ajax/libs/jquery/1.12.4/jquery.min.js")] (pcdata ""); script ~a:[a_src (Xml.uri_of_string "https://ajax.googleapis.com/ajax/libs/jquery/1.12.4/jquery.min.js")] (pcdata "");
script ~a:[a_src (Xml.uri_of_string "js/bootstrap.min.js")] (pcdata ""); script ~a:[a_src (Xml.uri_of_string "js/bootstrap.min.js")] (pcdata "");
script ~a:[a_src (Xml.uri_of_string "js/download.min.js")] (pcdata ""); script ~a:[a_src (Xml.uri_of_string "js/download.min.js")] (pcdata "");
script ~a:[a_src (Xml.uri_of_string "js/upload.js")] (pcdata ""); script ~a:[a_src (Xml.uri_of_string "js/upload.js")] (pcdata "");
]) ])
let slider = input ~a:[a_id "zoomslider"; let slider = input ~a:[a_id "zoomslider";
a_input_type `Range; a_input_type `Range;
a_value "40"] () a_value "40"] ()
let graph_editor () = let graph_editor () =
(*let zoomchange = [%client fun ev -> (*let zoomchange = [%client fun ev ->
let slide = Eliom_content.Html.To_dom.of_input zoom_slider in let slide = Eliom_content.Html.To_dom.of_input zoom_slider in
let zoom = int_of_string @@ Js.to_string slide##.value in () ] let zoom = int_of_string @@ Js.to_string slide##.value in () ]
and zoom_slider = Raw.input ~a:[a_id "speedid"; and zoom_slider = Raw.input ~a:[a_id "speedid";
a_input_type `Range; a_input_type `Range;
a_onchange zoomchange; a_onchange zoomchange;
a_value "100"] () in *) a_value "100"] () in *)
div ~a:[a_class ["row"; "jumbotron"]] [ div ~a:[a_class ["row"; "jumbotron"]] [
div ~a:[a_class ["col-8"]] [ div ~a:[a_class ["col-8"]] [
create_form; create_form;
div ~a:[a_class ["container"]] [ div ~a:[a_class ["container"]] [
div ~a:[a_style "overflow: auto; height:768px;"; div ~a:[a_style "overflow: auto; height:768px;";
a_oncontextmenu [%client fun ev -> () ]] [canvas_elt]; a_oncontextmenu [%client fun ev -> () ]] [canvas_elt];
div ~a:[a_style "float: right;"] [pcdata "zoom: "; slider] div ~a:[a_style "float: right;"] [pcdata "zoom: "; slider]
]]; ]];
div ~a:[a_class ["col-4"]] [ attribute_div ] div ~a:[a_class ["col-4"]] [ attribute_div ]
] ]
let main_service = let main_service =
Eliom_service.create Eliom_service.create
~path:(Eliom_service.Path []) ~path:(Eliom_service.Path [])
~meth:(Eliom_service.Get Eliom_parameter.unit) ~meth:(Eliom_service.Get Eliom_parameter.unit)
() ()
let () = let () =
Cosmosweb_app.register Cosmosweb_app.register
~service:main_service ~service:main_service
(fun () () -> (fun () () ->
let _ = [%client let _ = [%client
(let editor_state = TikzGraph.init ~%canvas_elt ~%attribute_list_div ~%create_form ~%slider in (let editor_state = TAGraphEd.init ~%canvas_elt ~%attribute_list_div ~%create_form ~%slider in
TikzGraph.init_client editor_state :unit) ] in TAGraphEd.init_client editor_state :unit) ] in
Lwt.return (page (graph_editor ()))) Lwt.return (page (graph_editor ())))
../editor/genericSerializer.ml
\ No newline at end of file
../editor/graphDrawing.ml
\ No newline at end of file
../editor/layout.ml
\ No newline at end of file
../editor/utilsWeb.ml
\ No newline at end of file
../editor/vect2d.ml
\ No newline at end of file
../editor/Data.ml
\ No newline at end of file
../editor/Data.mli
\ No newline at end of file
../editor/DrawingGeom.ml
\ No newline at end of file
#---------------------------------------------------------------------- #----------------------------------------------------------------------
# SETTINGS FOR THE ELIOM PROJECT cosmosweb # SETTINGS FOR THE ELIOM PROJECT cosmosweb
#---------------------------------------------------------------------- #----------------------------------------------------------------------
...@@ -9,12 +8,12 @@ PROJECT_NAME := cosmosweb ...@@ -9,12 +8,12 @@ PROJECT_NAME := cosmosweb
SERVER_FILES := $(wildcard *.eliomi *.eliom) SERVER_FILES := $(wildcard *.eliomi *.eliom)
# Source files for the client # Source files for the client
CLIENT_FILES := $(wildcard *.eliomi *.eliom) graphDrawing.ml utilsWeb.ml SimpleGraph.ml Data.ml TikzGraph.ml MarkovChain.ml layout.ml genericSerializer.ml tikzLexer.ml tikzParser.ml DrawingGeom.ml CLIENT_FILES := $(wildcard *.eliomi *.eliom) TikzGraph.ml MarkovChain.ml tikzLexer.ml tikzParser.ml
# OCamlfind packages for the server # OCamlfind packages for the server
SERVER_PACKAGES := lwt.ppx js_of_ocaml-ppx.deriving xml-light SERVER_PACKAGES := lwt.ppx js_of_ocaml-ppx.deriving xml-light
# OCamlfind packages for the client # OCamlfind packages for the client
CLIENT_PACKAGES := lwt.ppx js_of_ocaml-ppx js_of_ocaml-ppx.deriving xml-light CLIENT_PACKAGES := lwt.ppx js_of_ocaml-ppx js_of_ocaml-ppx.deriving xml-light GraphEditor
# Directory with files to be statically served # Directory with files to be statically served
LOCAL_STATIC = static LOCAL_STATIC = static
......
../editor/SimpleGraph.ml
\ No newline at end of file
../editor/genericSerializer.ml
\ No newline at end of file
../editor/graphDrawing.ml
\ No newline at end of file
../editor/layout.ml
\ No newline at end of file
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment