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

prog

parent 939c566b
Pipeline #870 failed with stages
in 15 seconds
......@@ -266,7 +266,42 @@ module Circle =
else false
end
module Bezier3 =
struct
type t = point * point *point *point
let draw to_screen ctx ~thick (spos,control1,control2,epos) =
let (x1,y1) = to_screen spos
and (xc1,yc1) = to_screen control1
and (xc2,yc2) = to_screen control2
and (x2,y2) = to_screen epos in
ctx##.lineWidth := thick;
ctx##beginPath;
ctx##(moveTo x1 y1);
ctx##(bezierCurveTo xc1 yc1 xc2 yc2 x2 y2);
ctx##stroke
let is_over tos mouse_pos ~thick (spos,control1,control2,epos) =
let p0 = tos spos
and p1 = tos control1
and p2 = tos control2
and p3 = tos epos in
let aA = sspos +.. (mult (-2.0) scontrol) +.. sepos
and bB = mult 2.0 (scontrol -.. sspos)
and cC = sspos -..mouse_pos
and dD = 0 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
end
module Arrow =
struct
type t = point * point
......@@ -310,7 +345,8 @@ module Circle =
| `TokenSet of TokenSet.t
| `Colors of string*string
| `Line of Line.t
| `Bezier2 of Bezier2.t
| `Bezier2 of Bezier2.t
| `Bezier3 of Bezier3.t
| `Arrow of Arrow.t
| `RoundArrow of RoundArrow.t]
......@@ -318,6 +354,7 @@ module Circle =
| `Colors of string*string
| `Line of Line.t
| `Bezier2 of Bezier2.t
| `Bezier3 of Bezier3.t
| `Arrow of Arrow.t
| `RoundArrow of RoundArrow.t
]
......@@ -351,6 +388,7 @@ module Circle =
ctx##.fillStyle := (Js.string c2)
| `Line l -> Line.draw tos ctx ~thick l
| `Bezier2 l -> Bezier2.draw tos ctx ~thick l
| `Bezier3 l -> Bezier3.draw tos ctx ~thick l
| `Arrow a -> Arrow.draw tos ctx ~thick a
| `RoundArrow a -> RoundArrow.draw tos ctx ~thick a
......@@ -412,7 +450,10 @@ module Circle =
(match (pp,x) with
| [], `Point pip -> [x],l
| `Point pi::_ ,`Point pip -> [x],(`Line (pi,pip)::l)
| `ControlPoint p2::`Point p1::_ ,`Point pip -> [x],(`Bezier2 (p1,p2,pip)::l)
| `ControlPoint p2::`Point p1::_ ,`Point pip ->
[x],(`Bezier2 (p1,p2,pip)::l)
| `ControlPoint p3::`ControlPoint p2:: `Point p1::_,`Point pip ->
[x],(`Bezier3 (p1,p2,p3,pip)::l)
| hist,`ControlPoint pip -> x::hist , ( l ))
)
([`Point pos1], (match arrow1 with None -> [] | Some f -> [ f pos1 last])
......
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