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
#----------------------------------------------------------------------
......@@ -9,12 +8,12 @@ PROJECT_NAME := cosmosweb
SERVER_FILES := $(wildcard *.eliomi *.eliom)
# 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
SERVER_PACKAGES := lwt.ppx js_of_ocaml-ppx.deriving xml-light
# 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
LOCAL_STATIC = static
......
../editor/SimpleGraph.ml
\ No newline at end of file
......@@ -32,12 +32,12 @@ let replace_list id v l =
(i+1, match v with Some v -> v::l | None -> l)
else (i+1, at::l)) (0,[]) l in
List.rev listat
let draw_state (s,at) p =
let draw = ref false
and shape = ref (`Rectangle (p,0.75,7.0,0.0))
let draw_state (s,at) p =
let draw = ref false
and shape = ref (`Rectangle (p,0.75,7.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
"draw" -> draw := true
| "circle" -> shape := `Circle (p,10.0)
......@@ -51,11 +51,11 @@ let draw_state (s,at) p =
[ `Colors (!color,!fill);
!shape;
(*`Circle (p,10.0);*)
`Text(p,s);
`Colors ((0,0,0),(255,255,255));
]
let get_state_attr (s, at) =
"Node", ((A,"content",`String s) ::
(List.mapi (fun i sv ->
......@@ -65,7 +65,7 @@ let get_state_attr (s, at) =
| Some x -> C i, "Fill", `Color x
| None ->
(B i),"Attribute", (`String sv )))) at))
let update_state_attr (s,at) attr_id = function
| None -> begin match attr_id with
A -> Some ("",at)
......@@ -73,20 +73,20 @@ let update_state_attr (s,at) attr_id = function
| _-> None
end
| Some (`String newv) -> begin
match attr_id with
match attr_id with
A -> Some (newv,at)
| B id -> Some (s,replace_list id (Some newv) at)
| _-> None
end
| Some (`Color newv) -> begin
match attr_id with
match attr_id with
A -> Some (newv,at)
| B id -> Some (s,replace_list id (Some ("color="^newv)) at)
| C id -> Some (s,replace_list id (Some ("fill="^newv)) at)
| _ -> None
end
| _ -> None
let get_new_state_attr (s,at) _ = [
"Attribute", (fun (s,at) -> (s, at@[""]), 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) =
|> List.map (function Some x -> `Colors (DrawingGeom.Color.parse x,(255,255,255))
| None -> `Colors ((0,0,0),(255,255,255))) in
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
let p1 = pos1 +.. (40.0 , -.25.0)
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
lcol @ 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")] )
(point_list@[pos2]) in
......@@ -124,7 +124,7 @@ let draw_arc (at,cn) (source_sh,target_sh) =
let get_arc_attr (atlist,controllist) =
"Arc", (
(List.mapi (fun i sv ->
(List.mapi (fun i sv ->
(match is_prefix sv "color=" with
Some x -> D i,"Color",`Color x
| None -> (B i),"Attribute", (`String sv ))) atlist)
......@@ -137,7 +137,7 @@ let get_arc_attr (atlist,controllist) =
(`ControlPoint p)
)) controllist)
)
let update_arc_attr (at,cn) attr_id = function
| Some (`String newv) -> (
match attr_id with
......@@ -146,15 +146,15 @@ let update_arc_attr (at,cn) attr_id = function
if i=id then
(i+1, newv::l) else (i+1, at::l)) (0,[]) at in
Some (List.rev listat,cn)
| C id ->
| C id ->
let _,listcn = List.fold_left (fun (i,l) at ->
if i=id then (i+1, (`Text (0.5,newv))::l)
else (i+1, at::l))
(0,[]) cn in
Some (at,(List.rev listcn))
| _ -> None
| _ -> None
)
| Some (`ControlPoint pt) ->
let _,listcn = List.fold_left (fun (i,l) at ->
begin match attr_id,at with
......@@ -198,7 +198,7 @@ let print_single_attr f a=
| Some x -> Format.fprintf f "color={%s}" (to_tikz_string @@ parse x)
| None -> Format.fprintf f "%s" a
)
let rec print_string_attr a = function
[] -> ()
| t::[] -> Format.fprintf a "%a" print_single_attr t
......@@ -207,7 +207,7 @@ let rec print_string_attr a = function
let to_tikz (x,y) =
(x/.50.),(100.0 -. y/.50.)
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 =
......@@ -215,11 +215,11 @@ let format_quad p0 p1 a p2 =
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
Format.fprintf a " .. controls (%f,%f) and (%f,%f) .. " x1 y1 x2 y2
let rec print_path link prev last a = function
[] -> if link then Format.fprintf a " -- "
| (`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 "")
x y (print_path true pos last) q
| (`ControlPoint p1)::q when not link ->
......@@ -247,8 +247,8 @@ let rec print_path link prev last a = function
print_path link prev last a ((`ControlPoint p)::`Text t::q)
| `Text (_,s)::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 =
(* Format.fprintf f "\\documentclass[]{article}\n\\usepackage{tikz}\n\\begin{document}";*)
Format.fprintf f "\\begin{tikzpicture}\n";
......@@ -266,10 +266,12 @@ let print_position outx lexbuf =
let pos = lexbuf.lex_curr_p in
Printf.fprintf outx "%s:%d:%d" pos.pos_fname
pos.pos_lnum (pos.pos_cnum - pos.pos_bol + 1)
let parse_file file add_node add_arc =
let lexbuf = Lexing.from_string file in
try
try
()
(*
let nodelist,arclist = TikzParser.main TikzLexer.token lexbuf in
let nl = Hashtbl.create 10 in
List.iter (fun (pos,at,name,content) ->
......@@ -283,11 +285,9 @@ let parse_file file add_node add_arc =
| `ControlPoint pos -> `ControlPoint (from_tikz pos)
| `Text t -> `Text t) pl in
add_arc (al,pl2) s2 fin2) arclist
*)
with
| Parsing.Parse_error ->
Printf.fprintf stderr "%a: Parsing error: unexpected token:'%s'\n"
print_position lexbuf (Lexing.lexeme lexbuf);
failwith "Fail to parse Tikz file format"
......@@ -4,24 +4,24 @@ open Eliom_content
open Html.D
]
let width = 4096
let height = 2048
module Cosmosweb_app =
Eliom_registration.App (
struct
let application_name = "cosmosweb"
let global_data_path = None
end)
let canvas_elt =
canvas ~a:[a_width width; a_height height]
[pcdata "your browser doesn't support canvas"]
let attribute_list_div =
div [ul ~a:[a_id "attributelist"] []]
let attribute_div =
div ~a:[ a_class ["attributelistdiv"] ] [
attribute_list_div;
......@@ -29,73 +29,71 @@ let attribute_div =
[%%client
module GenGraph = GraphDrawing.GraphEditor(SimpleGraph.S(MarkovChain))
module TikzGraph = GraphDrawing.GraphEditor(SimpleGraph.S(TikzGraph))
module TAGraphEd = GraphDrawing.GraphEditor(SimpleGraph.S(TAGraph))
]
let create_form =
div []
let page content =
html
(head (title (pcdata "TikZ Editor"))
[ meta ~a:[a_charset "utf-8"] ();
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"] ();
link ~rel:[`Stylesheet] ~href:(Raw.uri_of_string "css/bootstrap.min.css") ()])
[ meta ~a:[a_charset "utf-8"] ();
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"] ();
link ~rel:[`Stylesheet] ~href:(Raw.uri_of_string "css/bootstrap.min.css") ()])
(body [
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 "#")]
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 "#")]
[pcdata "TikZ Editor"]];
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 "js/bootstrap.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/download.min.js")] (pcdata "");
script ~a:[a_src (Xml.uri_of_string "js/upload.js")] (pcdata "");
])
])
let slider = input ~a:[a_id "zoomslider";
a_input_type `Range;
a_value "40"] ()
a_input_type `Range;
a_value "40"] ()
let graph_editor () =
(*let zoomchange = [%client fun ev ->
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";
a_input_type `Range;
a_input_type `Range;
a_onchange zoomchange;
a_value "100"] () in *)
a_value "100"] () in *)
div ~a:[a_class ["row"; "jumbotron"]] [
div ~a:[a_class ["col-8"]] [
div ~a:[a_class ["col-8"]] [
create_form;
div ~a:[a_class ["container"]] [
div ~a:[a_style "overflow: auto; height:768px;";
div ~a:[a_class ["container"]] [
div ~a:[a_style "overflow: auto; height:768px;";
a_oncontextmenu [%client fun ev -> () ]] [canvas_elt];
div ~a:[a_style "float: right;"] [pcdata "zoom: "; slider]
]];
div ~a:[a_class ["col-4"]] [ attribute_div ]
]
let main_service =
Eliom_service.create
~path:(Eliom_service.Path [])
~meth:(Eliom_service.Get Eliom_parameter.unit)
()
let () =
let () =
Cosmosweb_app.register
~service:main_service
(fun () () ->
let _ = [%client
(let editor_state = TikzGraph.init ~%canvas_elt ~%attribute_list_div ~%create_form ~%slider in
TikzGraph.init_client editor_state :unit) ] in
(let editor_state = TAGraphEd.init ~%canvas_elt ~%attribute_list_div ~%create_form ~%slider in
TAGraphEd.init_client editor_state :unit) ] in
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
#----------------------------------------------------------------------
......@@ -9,12 +8,12 @@ PROJECT_NAME := cosmosweb
SERVER_FILES := $(wildcard *.eliomi *.eliom)
# 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
SERVER_PACKAGES := lwt.ppx js_of_ocaml-ppx.deriving xml-light
# 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
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