* along with this program. If not, see <https://www.gnu.org/licenses/>.
*)
-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)
--- /dev/null
+(* Copyright 2025 Amélia COUTARD <https://www.ameliathe1st.gay>.
+ *
+ * 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 <https://www.gnu.org/licenses/>.
+ *)
+
+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
--- /dev/null
+(* Copyright 2025 Amélia COUTARD <https://www.ameliathe1st.gay>.
+ *
+ * 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 <https://www.gnu.org/licenses/>.
+ *)
+
+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
projects / marbrures.git / commitdiff