From: Amélia Coutard-Sander Date: Sat, 26 Jul 2025 17:45:25 +0000 (+0200) Subject: Page basique avec canvas et cercle dessiné X-Git-Url: https://git.ameliathe1st.gay/?a=commitdiff_plain;h=32f3dbd15ea1ebe98ef86df80c70fc8fd7c5129f;p=marbrures.git Page basique avec canvas et cercle dessiné --- diff --git a/marbrures/index.html b/marbrures/index.html index 4182a8b..c54bc9a 100644 --- a/marbrures/index.html +++ b/marbrures/index.html @@ -21,6 +21,7 @@ Marbrures Mathématiques + diff --git a/marbrures/main.ml b/marbrures/main.ml index 465d400..9717d70 100644 --- a/marbrures/main.ml +++ b/marbrures/main.ml @@ -14,4 +14,25 @@ * along with this program. If not, see . *) -let () = Printf.printf "Hello, page !" +open Js_of_ocaml + +let canvas = + match Dom_html.getElementById_coerce "canvas" Dom_html.CoerceTo.canvas with + | Some canvas -> canvas + | None -> failwith "No canvas." + +let ctx = canvas##getContext Dom_html._2d_ + +let circle = + Shape.from_f (fun t -> + let t = Float.pi *. 2. *. t in + Shape.Vector.(add (400., 400.) (scale 250. (fromAngle t)))) + +let main () = + ctx##.fillStyle := Js.string "#00001f"; + ctx##fillRect 0.0 0.0 (float_of_int canvas##.width) (float_of_int canvas##.height); + ctx##.fillStyle := Js.string "#ffffff"; + Shape.path ctx circle; + ctx##fill + +let _interval_id = Dom_html.window##setInterval (Js.wrap_callback main) (1000.0 /. 60.0) diff --git a/marbrures/shape.ml b/marbrures/shape.ml new file mode 100644 index 0000000..352a67c --- /dev/null +++ b/marbrures/shape.ml @@ -0,0 +1,64 @@ +(* Copyright 2025 Amélia COUTARD . + * + * This file from the program marbrures is free software: you can redistribute + * it and/or modify it under the terms of the GNU Affero General Public License + * as published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License + * for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with this program. If not, see . + *) + +let res = 20.0 + +module Vector = struct + type t = float * float + + let fromAngle a = (cos a, sin a) + + let add (x, y) (x', y') = (x +. x', y +. y') + + let sub (x, y) (x', y') = (x -. x', y -. y') + + let scale f (x, y) = (x *. f, y *. f) + + let dstSq (x, y) (x', y') = ((x -. x') *. (x -. x')) +. ((y -. y') *. (y -. y')) +end + +(* f : [0..1] -> (x, y) + * ps : (t, f t) + *) +type shape = { f: float -> Vector.t; ps: (float * Vector.t) list } + +let balance_points { f; ps } = + let rec aux ps = + match ps with + | [] | [_] -> ps + | (t, p) :: (t', p') :: ps -> + if Vector.dstSq p p' > res *. res + then + let avgt = (t +. t') /. 2. in + aux ((t, p) :: (avgt, f avgt) :: (t', p') :: ps) + else (t, p) :: aux ((t', p') :: ps) + in + { f; ps = aux ps } + +let from_f f = + let samples = [0.0; 0.1; 0.2; 0.3; 0.4; 0.5; 0.6; 0.7; 0.8; 0.9; 1.0] in + balance_points { f; ps = List.map (fun t -> (t, f t)) samples } + +let transform tf { f; ps } = balance_points { f = (fun t -> tf (f t)); ps = List.map (fun (t, p) -> (t, tf p)) ps } + +let path ctx { ps; _ } = + ctx##beginPath; + (match ps with + | [] -> () + | (_, (x, y)) :: ps -> + ctx##moveTo x y; + List.iter (fun (_, (x, y)) -> ctx##lineTo x y) ps); + ctx##closePath diff --git a/marbrures/shape.mli b/marbrures/shape.mli new file mode 100644 index 0000000..115830e --- /dev/null +++ b/marbrures/shape.mli @@ -0,0 +1,38 @@ +(* Copyright 2025 Amélia COUTARD . + * + * This file from the program marbrures is free software: you can redistribute + * it and/or modify it under the terms of the GNU Affero General Public License + * as published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License + * for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with this program. If not, see . + *) + +module Vector : sig + type t = float * float + + val fromAngle : float -> t + + val add : t -> t -> t + + val sub : t -> t -> t + + val scale : float -> t -> t + + val dstSq : t -> t -> float +end + +type shape + +(* [0..1] -> (x, y) *) +val from_f : (float -> Vector.t) -> shape + +val transform : (Vector.t -> Vector.t) -> shape -> shape + +val path : Js_of_ocaml.Dom_html.canvasRenderingContext2D Js_of_ocaml__.Js.t -> shape -> unit