Commit 1e8f667a authored by Benoit Barbot's avatar Benoit Barbot
Browse files

prog

parent bb53bf70
......@@ -15,6 +15,7 @@ let mult s (x1,y1) = (s*.x1,s*.y1)
let vect_prod (x1,y1) (x2,y2) = (x1*.x2, y1*.y2)
let vect_div (x1,y1) (x2,y2) = (x1 /. x2, y1/. y2)
let vect_sqrt (x,y) = sqrt x, sqrt y
let norm (x,y) = x*.x +. y*.y
let dist p = sqrt (norm p)
......@@ -255,16 +256,17 @@ module Circle =
let p0 = tos spos
and p1 = tos control
and p2 = tos epos in
let aA = p2 -.. (mult 2.0 p1) +.. p0 in
let bB = (mult 2.0 p1) -.. (mult 2.0 p0) in
let cC = p0 -..mouse_pos in
let delta = (vect_prod bB bB) -.. (mult 4.0 (vect_prod aA cC)) in
if fst delta >= 0.0 && snd delta >= 0.0 then
let eps x y = x>= 0.0 && x<= 1.0 && abs_float (x-.y) <= thick/.100. in
let ds1,ds2 = (fun (x,y) -> (sqrt x,sqrt y),(-.sqrt x,-.sqrt y) ) delta in
let (t1,t2) = vect_div (ds1 -.. bB) (mult 2.0 aA)
and (t3,t4) = vect_div (ds2 -.. bB) (mult 2.0 aA) in
eps t1 t2 || eps t1 t4 || eps t3 t2 || eps t3 t4
let xA,yA = p2 -.. (mult 2.0 p1) +.. p0 in
let xB,yB = (mult 2.0 p1) -.. (mult 2.0 p0) in
let xC,yC = p0 -..mouse_pos in
let dx = xB *. xB -. (4.0 *. xA *. xC) in
if dx >= 0.0 then
let t1 = ((sqrt dx) -. xB) /. (2.0 *. xA)
and t2 = (-.(sqrt dx) -. xB) /. (2.0 *. xA) in
let y1 = yA *. t1 *.t1 +. yB *. t1 +. yC
and y2 = yA *. t2 *.t2 +. yB *. t2 +. yC in
let eps t x = t>=0.0 && t<=1.0 && abs_float x <= 1.5 *. thick in
eps t1 y1 || eps t2 y2
else false
end
......@@ -289,18 +291,29 @@ module Circle =
and p1 = tos control1
and p2 = tos control2
and p3 = tos epos in
let aA = p3 -.. (mult 3.0 p2) +.. (mult 3.0 p1) -..p0
and bB = (mult 3.0 p2) -.. (mult 6.0 p1) +.. (mult 3.0 p0)
and cC = (mult 3.0 p1) -.. (mult 3.0 p0)
and dD = p0 -.. mouse_pos in
let delta = (vect_prod bB bB) -.. (mult 4.0 (vect_prod aA cC)) in
if fst delta >= 0.0 && snd delta >= 0.0 then
let eps x y = x>= 0.0 && x<= 1.0 && abs_float (x-.y) <= thick/.100. in
let ds1,ds2 = (fun (x,y) -> (sqrt x,sqrt y),(-.sqrt x,-.sqrt y) ) delta in
let (t1,t2) = vect_div (ds1 -.. bB) (mult 2.0 aA)
and (t3,t4) = vect_div (ds2 -.. bB) (mult 2.0 aA) in
eps t1 t2 || eps t1 t4 || eps t3 t2 || eps t3 t4
else false
let xA,yA = p3 -.. (mult 3.0 p2) +.. (mult 3.0 p1) -.. p0
and xB,yB = (mult 3.0 p2) -.. (mult 6.0 p1) +.. (mult 3.0 p0)
and xC,yC = (mult 3.0 p1) -.. (mult 3.0 p0)
and xD,yD = p0 -.. mouse_pos in
(*let dx = 18.0*.xA*.xB*.xC*.xD -. 4.0*.xB*.xB*.xB*.xD +. xB*.xB*.xC*.xC
-. 4.0*.xA*.xC*.xC*.xC -. 27.0*.xA*.xA*.xD*.xD in*)
let p = (3.0*.xA*.xC -. xB*.xB) /. (3.0 *. xA *.xA)
and q = (2.0*.xB*.xB*.xB -. 9.0*.xA*.xB*.xC +. 27.0*.xA*.xA*.xD)
/. (27.0 *.xA*.xA*.xA) in
if p <= 0.0 then
let sqp = sqrt (-.p/.3.0) in
let tk k = 2.0 *. sqp *.
cos ((1.0 /.3.0)*.(acos ( 3.0*.q /. (2.0 *.p*.sqp))) -. 2.0*.pi*.k/.3.0)
in
let t0 = tk 0.0
and t1 = tk 1.0
and t2 = tk 2.0 in
let y0 = yA*.t0*.t0*.t0 +. yB*.t0*.t0 +. yC*.t0 +. yD
and y1 = yA*.t1*.t1*.t1 +. yB*.t1*.t1 +. yC*.t1 +. yD
and y2 = yA*.t2*.t2*.t2 +. yB*.t2*.t2 +. yC*.t2 +. yD in
let eps t x = t>=0.0 && t<=1.0 && abs_float x <= 1.5 *. thick in
eps t0 y0 || eps t1 y1 || eps t2 y2
else (print_endline "out"; false)
end
......@@ -412,7 +425,8 @@ module Circle =
| `Rectangle r -> Rectangle.is_over tos mouse_pos r
| `RoundedRectangle rr -> RoundedRectangle.is_over tos mouse_pos rr
| `Line l -> Line.is_over ~thick:3.0 tos mouse_pos l
| `Bezier2 b -> Bezier2.is_over ~thick:3.0 tos mouse_pos b
| `Bezier2 b -> Bezier2.is_over ~thick:3.0 tos mouse_pos b
| `Bezier3 b -> Bezier3.is_over ~thick:3.0 tos mouse_pos b
| _ -> false
let is_over_shapes tos mouse_pos ls =
......
......@@ -41,11 +41,6 @@ module GraphEditor (G: GRAPH ) = struct
let height = 2048
let increment = 5
let stick_coord ~exact (x,y) =
let i = if exact then 1.0 else float increment in
let f z = i *. (floor (z /. i +. 0.5)) in
(f x, f y)
type selectable_type = Node of G.node | Arc of G.arc | Area of G.node list
type editor_state =
......@@ -94,6 +89,12 @@ module GraphEditor (G: GRAPH ) = struct
let from_screen s (x,y) =
let (xo,yo) = s.origin in
(x /. s.zoom +. xo , y /. s.zoom +. yo)
let stick_coord s ~exact pos =
let (x,y) = from_screen s pos in
let i = if exact then 1.0 else float increment in
let f z = i *. (floor (z /. i +. 0.5)) in
to_screen s (f x, f y)
let clean s =
let ctx = s.ctx in
......@@ -258,7 +259,7 @@ module GraphEditor (G: GRAPH ) = struct
let get_coord ?exact:(exact=false) s ev =
let x0,y0 = Dom_html.elementClientPosition s.canvas in
stick_coord ~exact (float (ev##.clientX - x0), float (ev##.clientY - y0))
stick_coord s ~exact (float (ev##.clientX - x0), float (ev##.clientY - y0))
let is_over_object s mouse_pos =
let obj = ref (Area []) in
......@@ -300,7 +301,7 @@ module GraphEditor (G: GRAPH ) = struct
match v with
| `ControlPoint (x,y) ->
tr [ td [pcdata n ;
pcdata (": ("^(string_of_float x)^","^(string_of_float y)^")"); ];
pcdata (Printf.sprintf ": (%g,%g)" x y); ];
td [ ];
td [delbutton] ]
| `Choice ((str::_) as l) ->
......
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