prog

editor/DrawingGeom.ml

@@ -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 =

editor/graphDrawing.ml

@@ -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) ->