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

fix linear solver

parent 2789156a
Pipeline #2161 passed with stage
in 34 seconds
...@@ -2,6 +2,8 @@ open Js_of_ocaml ...@@ -2,6 +2,8 @@ open Js_of_ocaml
type point = float * float type point = float * float
let print_point f (x, y) = Printf.fprintf f "(%f,%f)" x y
let ( +.. ) (x1, y1) (x2, y2) = (x2 +. x1, y2 +. y1) let ( +.. ) (x1, y1) (x2, y2) = (x2 +. x1, y2 +. y1)
let ( -.. ) (x2, y2) (x1, y1) = (x2 -. x1, y2 -. y1) let ( -.. ) (x2, y2) (x1, y1) = (x2 -. x1, y2 -. y1)
...@@ -33,6 +35,8 @@ let rot rho (x, y) = ...@@ -33,6 +35,8 @@ let rot rho (x, y) =
let pi = 4.0 *. atan 1.0 let pi = 4.0 *. atan 1.0
let normal (x, y) = mult (1.0 /. dist (y, -.x)) (y, -.x)
let angle (x, y) = let angle (x, y) =
if x > 0.0 then atan (y /. x) if x > 0.0 then atan (y /. x)
else if x < 0.0 then pi +. atan (y /. x) else if x < 0.0 then pi +. atan (y /. x)
...@@ -152,7 +156,7 @@ let flipColor ctx = ...@@ -152,7 +156,7 @@ let flipColor ctx =
setStrokeColor ctx fc; setStrokeColor ctx fc;
setFillColor ctx sc setFillColor ctx sc
let solve_linear a b = if a = 0.0 then [] else [ b /. a ] let solve_linear a b = if a = 0.0 then [] else [ -.b /. a ]
let solve_quadratic a b c = let solve_quadratic a b c =
if a = 0.0 then solve_linear b c if a = 0.0 then solve_linear b c
...@@ -402,8 +406,8 @@ module Line = struct ...@@ -402,8 +406,8 @@ module Line = struct
let point_at t ?(offset = 0.0) (spos, epos) = let point_at t ?(offset = 0.0) (spos, epos) =
let p0 = spos and p1 = epos in let p0 = spos and p1 = epos in
let port = rot (-.pi /. 2.0) (p1 -.. p0) in let no = normal (p1 -.. p0) in
p0 +.. mult t (p1 -.. p0) +.. mult (offset /. dist port) port p0 +.. mult t (p1 -.. p0) +.. mult offset no
end end
module Bezier2 = struct module Bezier2 = struct
...@@ -426,16 +430,21 @@ module Bezier2 = struct ...@@ -426,16 +430,21 @@ module Bezier2 = struct
let is_over tos mouse_pos ~thick bez = let is_over tos mouse_pos ~thick bez =
let (xA, yA), (xB, yB), c = poly_of tos bez in let (xA, yA), (xB, yB), c = poly_of tos bez in
let xC, yC = c -.. mouse_pos in let xC, yC = c -.. mouse_pos in
let ts = solve_quadratic xA xB xC in let epsx t =
let eps t = let x1 = (xA *. t *. t) +. (xB *. t) +. xC in
t >= 0.0 && t <= 1.0 && abs_float x1 <= 1.5 *. thick in
let epsy t =
let y1 = (yA *. t *. t) +. (yB *. t) +. yC in let y1 = (yA *. t *. t) +. (yB *. t) +. yC in
t >= 0.0 && t <= 1.0 && abs_float y1 <= 1.5 *. thick t >= 0.0 && t <= 1.0 && abs_float y1 <= 1.5 *. thick
in in
List.exists eps ts let b = List.exists epsy (solve_quadratic xA xB xC) || List.exists epsx (solve_quadratic yA yB yC) in
b
let point_at t ?offset:_ bez = let point_at t ?(offset = 0.0) bez =
let a, b, c = poly_of (fun x -> x) bez in let a, b, c = poly_of (fun x -> x) bez in
mult (t *. t) a +.. mult t b +.. c let no = normal @@ (mult (2.0 *. t) a +.. b) in
mult (t *. t) a +.. mult t b +.. c +.. mult offset no
end end
module Bezier3 = struct module Bezier3 = struct
...@@ -474,12 +483,17 @@ module Bezier3 = struct ...@@ -474,12 +483,17 @@ module Bezier3 = struct
let x = (xa *. t *. t *. t) +. (xb *. t *. t) +. (xc *. t) +. xd in let x = (xa *. t *. t *. t) +. (xb *. t *. t) +. (xc *. t) +. xd in
t >= 0.0 && t <= 1.0 && abs_float x <= 1.5 *. thick t >= 0.0 && t <= 1.0 && abs_float x <= 1.5 *. thick
in in
List.exists epsy (solve_cubic xa xb xc xd) let b = List.exists epsy (solve_cubic xa xb xc xd)
|| List.exists epsx (solve_cubic ya yb yc yd) || List.exists epsx (solve_cubic ya yb yc yd) in
b
let point_at t ?offset:_ bez = let point_at t ?(offset = 0.0) bez =
let a, b, c, d = poly_of (fun x -> x) bez in let a, b, c, d = poly_of (fun x -> x) bez in
mult (t *. t *. t) a +.. mult (t *. t) b +.. mult t c +.. d let no = normal @@ (mult (3.0 *. t *. t) a +.. mult (2.0 *. t) b +.. c) in
mult (t *. t *. t) a
+.. mult (t *. t) b
+.. mult t c +.. d +.. mult offset no
end end
module Arrow = struct module Arrow = struct
...@@ -598,7 +612,6 @@ let draw_shape tos ctx ?(thick = 3.0) = function ...@@ -598,7 +612,6 @@ let draw_shape tos ctx ?(thick = 3.0) = function
| `SimpleArrow a -> SimpleArrow.draw tos ctx ~thick a | `SimpleArrow a -> SimpleArrow.draw tos ctx ~thick a
| `RoundArrow a -> RoundArrow.draw tos ctx ~thick a | `RoundArrow a -> RoundArrow.draw tos ctx ~thick a
let print_point f (x, y) = Printf.fprintf f "(%f,%f)" x y
let print_shape f = function let print_shape f = function
| `Empty -> () | `Empty -> ()
......
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