remove all deps except SVG

.gitignore

@@ -1,4 +1,8 @@
 _build
 .vscode
 .DS_Store
-*.png
+*.png
+*.cmi
+*.cmx
+*.cma
+*.o

examples/circle_packing.ml

@@ -32,7 +32,7 @@ let palette =
   ]
 
 (* utility Functions *)
-let rand_nth coll = List.length coll |> random |> List.nth coll
+let rand_nth coll = List.length coll |> Joy.random |> List.nth coll
 let tmap f (a, b) = (f a, f b)
 
 (* Pareto distribution float random for radii *)

examples/dune

@@ -140,11 +140,6 @@
  (modules smile)
  (libraries joy))
 
-(executable
-  (name svg)
-  (modules svg)
-  (libraries joy))
-
 (executable
   (name simple_rotate_ellipse)
   (modules simple_rotate_ellipse)

lib/backend_cairo.ml

@@ -1,109 +1,18 @@
-type context = {
-  cairo_ctx : Cairo.context;
-  surface : Cairo.Surface.t;
-  size : int * int;
-  background_color : int * int * int * float;
-  axes : bool;
-}
+type context = { dummy: string; size: int * int }
 
-let write ctx filename =
-  Cairo.PNG.write ctx.surface filename;
-  Cairo.Surface.finish ctx.surface
-
-let set_color ctx color =
-  let to_float i = float_of_int i /. 255. in
-  let r, g, b, a = color in
-  let r, g, b = Util.tmap3 to_float (r, g, b) in
-  Cairo.set_source_rgba ctx.cairo_ctx r g b a
-
-let set_background ctx color =
+let string_of_color color =
   let r, g, b, a = color in
-  let to_float i = float_of_int i /. 255. in
-  let r, g, b = Util.tmap3 to_float (r, g, b) in
-  Cairo.set_source_rgba ctx.cairo_ctx r g b a;
-  Cairo.paint ctx.cairo_ctx ~alpha:a;
-  Cairo.fill ctx.cairo_ctx
-
-(** Sets the width of lines for both stroke of shapes and line primitives. 
-    Can be any positive integer, with larger numbers producing thicker lines. *)
-let set_line_width ctx line_width =
-  Cairo.set_line_width ctx.cairo_ctx (float_of_int line_width)
-
-let draw_circle ctx (cx, cy) radius stroke fill =
-  Cairo.arc ctx.cairo_ctx cx (Float.neg cy) ~r:radius ~a1:0. ~a2:(Float.pi *. 2.);
-  set_color ctx stroke;
-  Cairo.stroke_preserve ctx.cairo_ctx;
-  set_color ctx fill;
-  Cairo.fill_preserve ctx.cairo_ctx;
-  Cairo.Path.clear ctx.cairo_ctx
-
-let draw_ellipse ctx (cx, cy) rx ry rotation stroke fill =
-  (* Save the current transformation matrix *)
-  let save_matrix = Cairo.get_matrix ctx.cairo_ctx in
-
-  (* Apply rotation *)
-  let radians = Util.to_radians rotation in
-  Cairo.rotate ctx.cairo_ctx radians;
-
-  (* Translate and scale to create an ellipse from a circle *)
-  Cairo.translate ctx.cairo_ctx cx (Float.neg cy);
-  Cairo.scale ctx.cairo_ctx rx ry;
-
-  (* Arc from 0 to 2pi is a circle *)
-  Cairo.arc ctx.cairo_ctx 0. 0. ~r:1. ~a1:0. ~a2:(2. *. Float.pi);
-
-  (* Restore the original transformation matrix *)
-  Cairo.set_matrix ctx.cairo_ctx save_matrix;
-
-  set_color ctx stroke;
-  Cairo.stroke_preserve ctx.cairo_ctx;
-  set_color ctx fill;
-  Cairo.fill_preserve ctx.cairo_ctx;
+  Printf.sprintf "(%d, %d, %d, %f)" r g b a
 
-  Cairo.Path.clear ctx.cairo_ctx
+let create ~background_color ~size ~line_width ~axes =
+  let s = Printf.sprintf "create: background_color=%s size=(%d, %d) line_width=%d axes=%b\n"
+    (string_of_color background_color) (fst size) (snd size) line_width axes in
+  { dummy = s; size = size }
 
-let draw_line ctx (x1, y1) (x2, y2) stroke =
-  set_color ctx stroke;
-  Cairo.move_to ctx.cairo_ctx x1 (Float.neg y1);
-  Cairo.line_to ctx.cairo_ctx x2 (Float.neg y2);
-  Cairo.stroke ctx.cairo_ctx
+let show _ctx _shapes = ()
 
-let draw_polygon ctx vertices stroke fill =
-  let x, y = List.hd vertices in
-  let t = List.tl vertices in
-  Cairo.move_to ctx.cairo_ctx x (Float.neg y);
-  List.iter (fun (x', y') -> Cairo.line_to ctx.cairo_ctx x' (Float.neg y')) t;
-  Cairo.Path.close ctx.cairo_ctx;
-  set_color ctx stroke;
-  Cairo.stroke_preserve ctx.cairo_ctx;
-  set_color ctx fill;
-  Cairo.fill ctx.cairo_ctx
+let set_line_width _ctx _line_width = ()
 
-let show ctx shapes =
-  let rec render = function
-    | Shape.Circle circle ->
-        draw_circle ctx (circle.c.x, circle.c.y) circle.radius circle.stroke
-          circle.fill
-    | Shape.Ellipse ellipse ->
-        draw_ellipse ctx (ellipse.c.x, ellipse.c.y) ellipse.rx ellipse.ry
-          ellipse.rotation ellipse.stroke ellipse.fill
-    | Shape.Line line ->
-        draw_line ctx (line.a.x, line.a.y) (line.b.x, line.b.y) line.stroke
-    | Shape.Polygon polygon ->
-        let to_tuple (point : float Shape.point) = (point.x, point.y) in
-        draw_polygon ctx
-          (List.map to_tuple polygon.vertices)
-          polygon.stroke polygon.fill
-    | Shape.Complex complex -> List.iter render complex
-  in
-  List.iter render shapes
+let write _ctx _filename = ()
 
-let create ~background_color ~line_width ~size ~axes =
-  let w, h = size in
-  let surface = Cairo.Image.create Cairo.Image.ARGB32 ~w ~h in
-  let cairo_ctx = Cairo.create surface in
-  Cairo.translate cairo_ctx (w / 2 |> float_of_int) (h / 2 |> float_of_int);
-  let ctx = { cairo_ctx; surface; size = (w, h); background_color; axes } in
-  set_background ctx background_color;
-  set_line_width ctx line_width;
-  ctx
+let clear _ctx = ()

lib/backend_cairo.mli

@@ -1,20 +1,8 @@
-type context = {
-  cairo_ctx : Cairo.context;
-  surface : Cairo.Surface.t;
-  size : int * int;
-  background_color : Color.color;
-  axes : bool;
-}
+type context = { dummy: string; size: int * int }
 
-val set_color : context -> Color.color -> unit
-val set_background : context -> Color.color -> unit
+val create : background_color:int * int * int * float ->
+            size:int*int -> line_width:int -> axes:bool -> context
+val show : context -> Shape.shape list -> unit
 val set_line_width : context -> int -> unit
-val show : context -> Shape.shapes -> unit
 val write : context -> string -> unit
-
-val create :
-  background_color:Color.color ->
-  line_width:int ->
-  size:int * int ->
-  axes:bool ->
-  context
+val clear : context -> unit

lib/backend_lazy.ml

@@ -2,3 +2,4 @@ type context = unit
 
 let show _ctx _shapes = ()
 let create _ = ()
+let clear _ctx = ()

lib/backend_lazy.mli

@@ -2,3 +2,4 @@ type context = unit
 
 val show : context -> Shape.shapes -> unit
 val create : unit -> context
+val clear : context -> unit

lib/backend_svg.ml

@@ -1,17 +1,26 @@
+open Js_of_ocaml
+
 type context = {
   shapes: Shape.shape list ref;
   size: int * int;
   axes: bool;
+  elt: Dom_html.divElement Js.t;
 }
 
-let show ctx shapes =
-  ignore (ctx.shapes := !(ctx.shapes) @ shapes)
-
-let create ~size ~axes = {
-  shapes = ref [];
-  size;
-  axes;
-}
+let create ~size ~axes ~eltId =
+  let elt =
+    Js.Opt.get
+      (Js.Opt.bind
+        (Dom_html.document##getElementById (Js.string eltId))
+        Dom_html.CoerceTo.div)
+      (fun _ -> failwith "Could not find element with id")
+  in
+  {
+    shapes = ref [];
+    size;
+    axes;
+    elt;
+  }
 
 let string_of_color (r, g, b, a) =
   Printf.sprintf "rgba(%d, %d, %d, %f)" r g b a
@@ -71,10 +80,23 @@ let rec render_shape ctx s =
   | Shape.Polygon p -> render_polygon ctx p
   | Shape.Complex shapes -> String.concat "" (List.map (render_shape ctx) shapes)
 
-let write ctx =
+let make_svg ctx =
   let shapes = !(ctx.shapes) in
   let svg = String.concat "" (List.map (render_shape ctx) shapes) in
   let (width, height) = ctx.size in
   let svg = Printf.sprintf "<svg width=\"%d\" height=\"%d\" xmlns=\"http://www.w3.org/2000/svg\">%s</svg>" width height svg in
   svg
 
+let write ctx =
+  let svg = make_svg ctx in
+  let elt = ctx.elt in
+  elt##.innerHTML := Js.string svg
+
+let show ctx shapes =
+  ctx.shapes := !(ctx.shapes) @ shapes;
+  write ctx
+
+let clear ctx =
+  ctx.shapes := [];
+  write ctx
+

lib/backend_svg.mli

@@ -2,8 +2,11 @@ type context = {
   shapes: Shape.shape list ref;
   size: int * int;
   axes: bool;
+  elt: Js_of_ocaml.Dom_html.element Js_of_ocaml.Js.t;
 }
 
-val show : context -> Shape.shapes -> unit
-val create : size:int * int -> axes:bool -> context
-val write : context -> string
+val show : context -> Shape.shape list -> unit
+val create : size:int * int -> axes:bool -> eltId:string -> context
+val make_svg : context -> string
+val write : context -> unit
+val clear : context -> unit

lib/context.ml

@@ -10,13 +10,20 @@ let default = ref (LazyContext (Backend_lazy.create ()))
 let get_default _ = !default
 let set_default ctx = default := ctx
 
-let show ?ctx shapes =
+let show ?ctx (shapes: Shape.shape list) =
   let ctx = match ctx with Some ctx -> ctx | None -> get_default () in
   match ctx with
   | CairoContext ctx -> Backend_cairo.show ctx shapes
   | SVGContext ctx -> Backend_svg.show ctx shapes
   | LazyContext ctx -> Backend_lazy.show ctx shapes
 
+let clear ?ctx _ =
+  let ctx = match ctx with Some ctx -> ctx | None -> get_default () in
+  match ctx with
+  | CairoContext ctx -> Backend_cairo.clear ctx
+  | SVGContext ctx -> Backend_svg.clear ctx
+  | LazyContext ctx -> Backend_lazy.clear ctx
+
 let set_line_width ?ctx int =
   let ctx = match ctx with Some ctx -> ctx | None -> get_default () in
   match ctx with
@@ -32,10 +39,18 @@ let writePNG ?ctx filename =
       raise (Unsupported_output_format "SVG context cannot render to PNG")
   | LazyContext _ -> failwith "Lazy.writePNG ctx filename"
 
-let writeSVG ?ctx _ =
+(* let writeSVG ?ctx _ =
   let ctx = match ctx with Some ctx -> ctx | None -> get_default () in
   match ctx with
   | CairoContext _ ->
       raise (Unsupported_output_format "Cairo context cannot render to SVG")
   | SVGContext ctx -> Backend_svg.write ctx
-  | LazyContext _ -> failwith "Lazy.writeSVG ctx"
+  | LazyContext _ -> failwith "Lazy.writeSVG ctx" *)
+
+let makeSVG ?ctx _ =
+  let ctx = match ctx with Some ctx -> ctx | None -> get_default () in
+  match ctx with
+  | CairoContext _ ->
+      raise (Unsupported_output_format "Cairo context cannot render to SVG")
+  | SVGContext ctx -> Backend_svg.make_svg ctx
+  | LazyContext _ -> failwith "Lazy.makeSVG ctx"

lib/context.mli

@@ -8,7 +8,9 @@ exception Unsupported_output_format of string
 
 val get_default : unit -> context
 val set_default : context -> unit
-val show : ?ctx:context -> Shape.shapes -> unit
+val show : ?ctx:context -> Shape.shape list -> unit
+val clear : ?ctx:context -> unit -> unit
 val set_line_width : ?ctx:context -> int -> unit
-val writeSVG : ?ctx:context -> unit -> string
+
+val makeSVG : ?ctx:context -> unit -> string
 val writePNG : ?ctx:context -> string -> unit

lib/dune

@@ -1,4 +1,5 @@
 (library
  (name joy)
  (public_name joy)
- (libraries cairo2))
+ (preprocess (pps js_of_ocaml-ppx))
+ (libraries js_of_ocaml))

lib/joy.ml

@@ -1,4 +1,3 @@
-include Random
 include Shape
 include Transform
 include Color
@@ -8,9 +7,14 @@ module Backend_cairo = Backend_cairo
 module Backend_svg = Backend_svg
 module Backend_lazy = Backend_lazy
 
+let random = Random.random
+let frandom = Random.frandom
+let fractal_noise = Random.fractal_noise
+
 type context = Context.context
 
 let show = Context.show
+let clear = Context.clear
 let set_line_width = Context.set_line_width
 
 let init ?(size = (500, 500)) ?(line_width = 1) ?(axes = false) _ =
@@ -34,8 +38,8 @@ let init ?(size = (500, 500)) ?(line_width = 1) ?(axes = false) _ =
     in
     show ~ctx:ctx_container [ x_axis; y_axis ]
 
-let init_svg ?(size = (500, 500)) ?(axes = false) _ =
-  let ctx = Backend_svg.create ~size ~axes in
+let init_svg ?(size = (500, 500)) ?(axes = false) eltId =
+  let ctx = Backend_svg.create ~size ~axes ~eltId in
   let ctx_container = Context.SVGContext ctx in
   Context.set_default ctx_container;
   if axes then

lib/joy.mli

@@ -22,10 +22,6 @@ val translate : int -> int -> transformation
 val scale : float -> transformation
 val compose : transformation -> transformation -> transformation
 val repeat : int -> transformation -> transformation
-val random : ?min:int -> int -> int
-val frandom : ?min:float -> float -> float
-val noise : float list -> float
-val fractal_noise : ?octaves:int -> float list -> float
 val with_stroke : color -> transformation
 val with_fill : color -> transformation
 val map_stroke : (color -> color) -> transformation
@@ -38,8 +34,14 @@ val blue : color
 val yellow : color
 val transparent : color
 val rgb : int -> int -> int -> color
+val color : ?a:float -> int -> int -> int -> color
 val init : ?size:int * int -> ?line_width:int -> ?axes:bool -> unit -> unit
-val init_svg : ?size:int * int -> ?axes:bool -> unit -> unit
+val init_svg : ?size:int * int -> ?axes:bool -> string -> unit
 val write : ?filename:string -> unit -> unit
 val show : ?ctx:context -> shapes -> unit
+val clear : ?ctx:context -> unit -> unit
 val set_line_width : ?ctx:context -> int -> unit
+
+val random : ?min:int -> int -> int
+val frandom : ?min:float -> float -> float
+val fractal_noise : ?octaves:int -> float list -> float