Commit e13f9334 authored by Benoit Barbot's avatar Benoit Barbot
Browse files

progress

parent e0094a45
Pipeline #1734 failed with stage
in 6 seconds
......@@ -15,18 +15,6 @@ module Cosmosweb_app =
let global_data_path = None
end)
let canvas_elt =
canvas ~a:[a_width width; a_height height]
[txt "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;
]
[%%client
module GenGraph = GraphDrawing.GraphEditor(SimpleGraph.S(MarkovChain))
......@@ -34,36 +22,47 @@ let attribute_div =
]
let canvas_elt =
canvas ~a:[a_width width; a_height height]
[txt "your browser doesn't support canvas"]
let create_form =
div []
let page content =
let attribute_list_div =
div [ul ~a:[a_id "attributelist"] []]
html
(head (title (txt "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") ()])
(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 "#")]
[txt "TikZ Editor"]];
content;
let attribute_div =
div ~a:[ a_class ["attributelistdiv"] ] [
attribute_list_div;
]
let create_form =
div []
let page content =
html
(head (title (txt "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") ()])
(body [
nav ~a:[a_class ["navbar";"navbar-expand-md";"navbar-dark";"fixed-top";"bg-dark"]]
[Raw.a ~a:[a_class ["navbar-brand"]; a_href (Raw.uri_of_string "#")]
[txt "TikZ Editor"]];
content;
script ~a:[a_src (Xml.uri_of_string "https://ajax.googleapis.com/ajax/libs/jquery/1.12.4/jquery.min.js")] (txt "");
script ~a:[a_src (Xml.uri_of_string "js/bootstrap.min.js")] (txt "");
script ~a:[a_src (Xml.uri_of_string "js/download.min.js")] (txt "");
script ~a:[a_src (Xml.uri_of_string "js/upload.js")] (txt "");
])
])
let slider = input ~a:[a_id "zoomslider";
a_input_type `Range;
a_value "40"] ()
let slider = input ~a:[a_id "zoomslider";
a_input_type `Range;
a_value "40"] ()
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 zoom = int_of_string @@ Js.to_string slide##.value in () ]
and zoom_slider = Raw.input ~a:[a_id "speedid";
......@@ -71,16 +70,17 @@ let graph_editor () =
a_onchange zoomchange;
a_value "100"] () in *)
div ~a:[a_class ["row"; "jumbotron"]] [
div ~a:[a_class ["col-8"]] [
create_form;
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;"] [txt "zoom: "; slider]
]];
div ~a:[a_class ["col-4"]] [ attribute_div ]
]
let graph_editor () =
div ~a:[a_class ["row"; "jumbotron"]] [
div ~a:[a_class ["col-8"]] [
create_form;
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;"] [txt "zoom: "; slider]
]];
div ~a:[a_class ["col-4"]] [ attribute_div ]
]
let main_service =
......@@ -89,12 +89,22 @@ let main_service =
~meth:(Eliom_service.Get Eliom_parameter.unit)
()
[%%client
let tikz_init canvas_el attribute_list_el create_form_el slider_el =
let open Html.To_dom in
let canvas = of_canvas canvas_el in
let attribute_list = of_div attribute_list_el in
let create_form_dom = of_div create_form_el in
let slider_dom = of_input slider_el in
let editor_state = TikzGraph.init canvas attribute_list create_form_dom slider_dom in
TikzGraph.init_client editor_state
]
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
Lwt.return (page (graph_editor ())))
((tikz_init ~%canvas_elt ~%attribute_list_div ~%create_form ~%slider):unit)
] in
Lwt.return (page (graph_editor ())))
......@@ -10,4 +10,4 @@ Library "GraphEditor"
BuildTools: ocamlbuild
Modules: Data, DrawingGeom, GenericSerializer, GraphDrawing, Layout,
SimpleGraph, UtilsWeb
BuildDepends: eliom.client,lwt_ppx,js_of_ocaml,js_of_ocaml-ppx,js_of_ocaml-ppx_deriving_json,js_of_ocaml-lwt,xml-light
BuildDepends: lwt_ppx,js_of_ocaml,js_of_ocaml-ppx,js_of_ocaml-lwt,xml-light
......@@ -39,7 +39,6 @@ end
module GraphEditor (G: GRAPH ) = struct
open DrawingGeom
open Eliom_content.Html.D
open UtilsWeb
let width = 4096
......@@ -72,7 +71,6 @@ module GraphEditor (G: GRAPH ) = struct
|> List.map (fun node -> (center_of_node s node),node)
|> Rectangle.contains rect
let download content name mimetype =
let c = Js.string content
and n = Js.string name
......@@ -295,7 +293,8 @@ module GraphEditor (G: GRAPH ) = struct
download string_value fn "data:application/xml"))
G.print_graph) in
div [p [txt "Load file: ";
input ~a:[a_id "filein"; a_input_type `File; a_onchange (change_file loadfile)] ();
(*input ~a:[a_id "filein"; a_input_type `File; a_onchange (change_file loadfile)] ();*)
text_input ~_type:"file" ~on_change:(change_file loadfile) "";
choice_input ~init_value:(Some "Download")
~on_change: (fun x -> (List.assoc x dl) ()) (List.map (fst) dl);
(*button ~a:[a_onclick (fun _ ->
......@@ -305,15 +304,16 @@ module GraphEditor (G: GRAPH ) = struct
let string_value = get_exchange_string s.graph in
download string_value "graph.gex" "data:application/xml") ]
[pcdata "Get GEX"];*)
button ~a:[a_onclick (fun _ -> layout_graph s; draw s (0.0,0.0))] [txt "Layout Graph"];
button ~on_click: (fun _ -> layout_graph s; draw s (0.0,0.0)) [txt "Layout Graph"];
update_link "Direct Link" (fun n -> (n^"?q="^(get_exchange_string s.graph)))
]]
let init canvas_elt attr_list_div saveload_elt slider_elt =
let init canvas attribute_list saveload slider =
(*let init canvas_elt attr_list_div saveload_elt slider_elt =
let canvas = Eliom_content.Html.To_dom.of_canvas canvas_elt in
let attribute_list = Eliom_content.Html.To_dom.of_div attr_list_div in
let saveload = Eliom_content.Html.To_dom.of_div saveload_elt in
let slider = Eliom_content.Html.To_dom.of_input slider_elt in
let slider = Eliom_content.Html.To_dom.of_input slider_elt in*)
let ctx = canvas##(getContext (Dom_html._2d_)) in
ctx##.lineCap := Js.string "round";
ctx##.font := Js.string "15px Arial";
......@@ -336,7 +336,7 @@ module GraphEditor (G: GRAPH ) = struct
s.zoom <- 0.2 +. (float_of_string @@ Js.to_string slider##.value) /. 50.0;
draw s (0.0,0.0);
Js._true);
Dom.appendChild saveload (Eliom_content.Html.To_dom.of_div (save_load_html s));
Dom.appendChild saveload ((*Eliom_content.Html.To_dom.of_div*) (save_load_html s));
s
let draw_choice s (x,y) =
......@@ -417,7 +417,7 @@ let rec html_of_attr s attr nattr cb =
List.map (function
(id,n,v) ->
let delbutton =
(button ~a:[ a_onclick (callback_supr id)] [
(button ~on_click:(callback_supr id) [
(*span ~a:[a_class ["glyphicon";"glyphicon-remove"]] [];*) txt "X"]) in
match v with
| `ControlPoint (x,y) ->
......@@ -463,7 +463,7 @@ let rec html_of_attr s attr nattr cb =
let divat = div [txt name] in
Dom.appendChild
s.attribute_list (Eliom_content.Html.To_dom.of_div (divat));
s.attribute_list (divat);
let nattr = match s.selected_obj with
Node node -> G.get_new_node_attribute s.graph node
......@@ -482,10 +482,10 @@ let rec html_of_attr s attr nattr cb =
Dom.appendChild
s.attribute_list
(Eliom_content.Html.To_dom.of_table slHTML);
slHTML;
Dom.appendChild
s.attribute_list
(Eliom_content.Html.To_dom.of_br (br ()));
(br ());
if (match s.selected_obj with Empty -> false | _ -> true ) then
let suprcb _ =
......@@ -499,7 +499,7 @@ let rec html_of_attr s attr nattr cb =
set_selected s Empty (0.0,0.0) in
Dom.appendChild
s.attribute_list
(Eliom_content.Html.To_dom.of_button (button ~a:[a_style "float:right"; a_onclick suprcb] [txt "Delete"]))
(button ~on_click: suprcb [txt "Delete"])
......@@ -507,7 +507,7 @@ let rec html_of_attr s attr nattr cb =
s.ctx##.lineCap := Js.string "round";
draw s (0.0,0.0);
let open Eliom_lib in
let open Lwt in
let open Js_of_ocaml_lwt.Lwt_js_events in
let osobj = ref Empty in
Lwt.async (fun () ->
......
open Js_of_ocaml
type t = Dom.node Js.t
let text_input ?(class_ = "") ?(on_change = fun _ -> true) value =
let txt value =
let text = Dom_html.document##createTextNode(Js.string value) in
(text :> t)
let append_node parent node =
let _: Dom.node Js.t = parent##appendChild(node) in
()
let br () =
let br = Dom_html.(createBr document) in
(br :> t)
let tr items =
let tr = Dom_html.(createTr document) in
List.iter (append_node tr) items;
(tr :> t)
let td items =
let td = Dom_html.(createTd document) in
List.iter (append_node td) items;
(td :> t)
let table items =
let table = Dom_html.(createTable document) in
List.iter (append_node table) items;
(table :> t)
let div ?(class_ = "") ?(title="") ?id items =
let div = Dom_html.(createDiv document) in
List.iter (append_node div) items;
(match id with None -> () | Some ids -> div##.id := Js.string ids);
div##.title := Js.string title;
div##.className := Js.string class_;
(div :> t)
let p ?(class_ = "") items =
let p = Dom_html.(createP document) in
List.iter (append_node p) items;
p##.className := Js.string class_;
(p:> t)
let button ?(class_ = "") ?(on_click = fun () -> ()) items =
let button = Dom_html.(createButton document) in
let append_node node =
let _: Dom.node Js.t = button##appendChild(node) in
()
in
List.iter append_node items;
button##.className := Js.string class_;
let on_click _ = on_click (); Js._true in
button##.onclick := Dom.handler on_click;
(button :> t)
let option ?(def=false) value =
let opt = Dom_html.(createOption document) in
(*opt##.value := Js.string value;*)
append_node opt (txt value);
if def then opt##.defaultSelected := Js._true;
(opt :> t)
let choice_input ?(class_ = "") ?(init_value=None) ?(on_change = fun _ -> ()) sl =
let sel = Dom_html.(createSelect document) in
List.iter (fun s -> append_node sel (option ~def:(match init_value with None -> false | Some x -> x=s) s)) sl;
let on_input _ = on_change (Js.to_string sel##.value); Js._true in
sel##.oninput := Dom.handler on_input;
sel##.className := Js.string class_;
(sel :> t)
let text_input ?(class_ = "") ?(on_change = fun _ -> true) ?(_type="text") value =
(*let input2 = input ~a:[a_input_type `Text] () in
let input = Eliom_content.Html.To_dom.of_input input2 in*)
let input = Dom_html.(createInput ~_type: (Js.string "text") document) in
let input = Dom_html.(createInput ~_type: (Js.string _type) document) in
input##.value := Js.string value;
let on_input _ =
let res = on_change (Js.to_string input##.value) in
......@@ -13,51 +84,23 @@ let text_input ?(class_ = "") ?(on_change = fun _ -> true) value =
Js._true in
input##.oninput := Dom.handler on_input;
input##.className := Js.string class_;
Eliom_content.Html.Of_dom.of_input input
open Eliom_content.Html.D
let change_file (cb: string->unit) _ =
let id2 = Js.string "filein" in
let f s = cb (Js.to_string s) in
Js.Unsafe.fun_call (Js.Unsafe.js_expr "upload") [|Js.Unsafe.inject f; Js.Unsafe.inject id2|]
let a_over ?(class_ = "") ?(on_mouse_over = fun _ -> ()) value =
let input2 = Raw.a ~a:[a_href ""] [txt value] in
let input = Eliom_content.Html.To_dom.of_a input2 in
let on_input _ = on_mouse_over input; Js._true in
input##.onclick := Dom.handler on_input;
input##.className := Js.string class_;
input2
(input :> t)
let update_link n f =
let link = Raw.a ~a:[a_href "#"] [txt n] in
let domlink = Eliom_content.Html.To_dom.of_a link in
let link = Dom_html.(createA document) in
append_node link (txt n);
let currref = Js.to_string Dom_html.window##.location##.href in
domlink##.onmouseover:= Dom.handler (fun _ ->
link##.onmouseover:= Dom.handler (fun _ ->
let string_value = f currref in
domlink##.href := Js.string string_value;
link##.href := Js.string string_value;
Js._true);
link
let choice_input ?(class_ = "") ?(on_change = fun _ -> ()) ?(init_value=None) option_list =
let choice_list = List.map (fun x -> option (txt (">"^x))) option_list in
let input2 = select (match init_value with
| None -> choice_list
| Some iv -> (option (txt iv))::choice_list) in
let input = Eliom_content.Html.To_dom.of_select input2 in
let on_input _ =
let v = Js.to_string input##.value in
on_change (String.sub v 1 (String.length v -1)); Js._true in
input##.oninput := Dom.handler on_input;
input##.className := Js.string class_;
input2
(link:>t)
let color_input ?(class_ = "") ?(on_change = fun _ -> true) value =
let input2 = input ~a:[a_input_type `Color] () in
let input = Eliom_content.Html.To_dom.of_input input2 in
let color_input ?(class_ = "") ?(on_change = fun _ -> true) value =
let input = Dom_html.(createInput ~_type: (Js.string "color") document) in
(*let input2 = input ~a:[a_input_type `Color] () in
let input = Eliom_content.Html.To_dom.of_input input2 in*)
input##.value := Js.string (DrawingGeom.Color.to_string (DrawingGeom.Color.parse value));
let on_input _ =
let res = on_change (Js.to_string input##.value) in
......@@ -66,7 +109,12 @@ let color_input ?(class_ = "") ?(on_change = fun _ -> true) value =
Js._true in
input##.oninput := Dom.handler on_input;
input##.className := Js.string class_;
input2
(input:>t)
let change_file (cb: string->unit) _ =
let id2 = Js.string "filein" in
let f s = cb (Js.to_string s) in
Js.Unsafe.fun_call (Js.Unsafe.js_expr "upload") [|Js.Unsafe.inject f; Js.Unsafe.inject id2|]
let rec split_attr s i =
match String.index_from_opt s i '=' with
......
Markdown is supported
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