Merge pull request #129 from Sudha247/refactor

Refactor and rename: backends, cairo, contexts

examples/axes.ml

@@ -4,7 +4,6 @@ open Joy
 let _ =
   (* intialize rendering context with the axes flag set to true *)
   init ~axes:true ();
-  (* set background to opaque white *)
   let c = circle 50 in
   show [ c ];
   (* Write to PNG! *)

examples/circle_packing.ml

@@ -16,19 +16,19 @@ let max_attempts = 100_000
 let palette =
   [
     (* purple *)
-    (107, 108, 163);
+    rgb 107 108 163;
     (* light blue *)
-    (135, 188, 189);
+    rgb 135 188 189;
     (* green *)
-    (111, 153, 84);
+    rgb 111 153 84;
     (* light purple *)
-    (150, 155, 199);
+    rgb 150 155 199;
     (* light green *)
-    (137, 171, 124);
+    rgb 137 171 124;
     (* dark purple *)
-    (67, 68, 117);
+    rgb 67 68 117;
     (* darker purple *)
-    (44, 45, 84);
+    rgb 44 45 84;
   ]
 
 (* utility Functions *)

examples/dune

@@ -58,6 +58,11 @@
  (modules line)
  (libraries joy))
 
+(executable
+ (name parallel_lines)
+ (modules parallel_lines)
+ (libraries joy))
+
 (executable
  (name higher_transforms)
  (modules higher_transforms)
@@ -132,3 +137,8 @@
  (name smile)
  (modules smile)
  (libraries joy))
+
+(executable
+  (name simple_rotate_ellipse)
+  (modules simple_rotate_ellipse)
+  (libraries joy))

examples/fill_rect.ml

@@ -2,6 +2,6 @@ open Joy
 
 let () =
   init ();
-  let r = rectangle 200 200 |> with_fill (255, 0, 0) in
+  let r = rectangle 200 200 |> with_fill (rgb 255 0 0) in
   show [ r ];
   write ~filename:"fill-rect.png" ()

examples/flowfield.ml

@@ -91,7 +91,8 @@ let add_color flowfield line (x, y) =
     |> ( *. ) (float_of_int (List.length palette))
     |> int_of_float |> List.nth palette
   in
-  line |> Joy.with_stroke color
+  let r, g, b = color in
+  line |> Joy.with_stroke (Joy.rgb r g b)
 
 let () =
   let open Joy in

examples/line.ml

@@ -1,22 +1,9 @@
 open Joy
 
-let size = 800
-let interval = 16
-let line_interval = 800 / interval
-let rec range a b = if a > b then [] else a :: range (a + 1) b
-let inc x = x + 1
-
 let _ =
-  init ~size:(size, size) ();
-  let half_size = size / 2 in
-  let lines =
-    List.map
-      (fun i ->
-        let newx = i |> inc |> ( * ) line_interval in
-        line
-          ~a:(point (newx - half_size) (-half_size))
-          (point (newx - half_size) half_size))
-      (range 0 interval)
-  in
-  show lines;
+  init ();
+  let l1 = line (point 50 50) in
+  let l2 = line (point (-50) 50) in
+  let l3 = line ~a:(point (-50) 50) (point 50 50) in
+  show [ l1; l2; l3 ];
   write ~filename:"line.png" ()

examples/parallel_lines.ml

@@ -0,0 +1,22 @@
+open Joy
+
+let size = 800
+let interval = 16
+let line_interval = 800 / interval
+let rec range a b = if a > b then [] else a :: range (a + 1) b
+let inc x = x + 1
+
+let _ =
+  init ~size:(size, size) ();
+  let half_size = size / 2 in
+  let lines =
+    List.map
+      (fun i ->
+        let newx = i |> inc |> ( * ) line_interval in
+        line
+          ~a:(point (newx - half_size) (-half_size))
+          (point (newx - half_size) half_size))
+      (range 0 interval)
+  in
+  show lines;
+  write ~filename:"parallel_lines.png" ()

examples/quadtree.ml

@@ -6,8 +6,8 @@ let half_size = size /. 2.
 let max_leaf_points = 4
 let clusters = 32
 let point_size = 1
-let box_color = (0, 0, 0)
-let point_color = (255, 1, 1)
+let box_color = Joy.rgb 0 0 0
+let point_color = Joy.rgb 255 1 1
 
 (* Point utils *)
 let splat n : point = { x = n; y = n }

examples/rotate_ellipse.ml

@@ -4,12 +4,11 @@ let max = 32.
 let rec range a b = if a > b then [] else a :: range (a +. 1.) b
 
 let _ =
-  init ();
-  let rect = rectangle 100 50 |> translate 195 220 in
+  init ~size:(500, 500) ~axes:true ();
   let ell = ellipse 100 50 |> translate 60 60 in
   let nums = range 0. max in
   let rotated =
     List.map (fun i -> rotate (int_of_float (i /. max *. 360.0)) ell) nums
   in
-  show (rect :: rotated);
+  show rotated;
   write ~filename:"rotate_ellipse.png" ()

examples/simple_rotate_ellipse.ml

@@ -0,0 +1,7 @@
+open Joy
+
+let _ =
+  init ();
+  let ell = ellipse 100 50 in
+  show [ ell; ell |> rotate 60 ];
+  write ~filename:"simple_rotate_ellipse.png" ()

examples/smile.ml

@@ -1,27 +1,26 @@
 open Joy
 
 let make_nose () =
-    let l = line (point 0 50)|> translate 0 (-25) in
-    let l1 = l in
-    let l2 = l |> rotate 90|> translate 0 (-25) in
-    let nose = complex [l1; l2] in
-    nose
+  let l = line (point 0 50) |> translate 0 (-25) in
+  let l1 = l in
+  let l2 = l |> rotate 90 |> translate 0 (-25) in
+  let nose = complex [ l1; l2 ] in
+  nose
 
-let make_arc rx ry = 
-    let r = rectangle ~c:(point 0 (ry / 2)) (2 * rx) ry in 
-    let col = r |> with_fill white |> with_stroke white in
-    let e = ellipse ~c:(point 0 0) rx ry in
-    complex [e; col]
+let make_arc rx ry =
+  let r = rectangle ~c:(point 0 (ry / 2)) (2 * rx) ry in
+  let col = r |> with_fill white |> with_stroke white in
+  let e = ellipse ~c:(point 0 0) rx ry in
+  complex [ e; col ]
 
 let () =
-    init ();
-    let a = circle 200 in
-    let d = circle ~c:(point 50 50) 20 in
-    let b = circle ~c:(point (-50) 50) 20 in
-    let nose = make_nose () in
-    let leb = make_arc 26 14 |> rotate 180 |> translate 50 70  in
-    let reb = make_arc 26 14 |> rotate 180 |> translate (-50) 70  in 
-    let mouth = make_arc 80 40 |>translate 0 (-60) in 
-    show [mouth;leb;reb;a;d;b;nose];
-    write ()
-
+  init ();
+  let a = circle 200 in
+  let d = circle ~c:(point 50 50) 20 in
+  let b = circle ~c:(point (-50) 50) 20 in
+  let nose = make_nose () in
+  let leb = make_arc 26 14 |> rotate 180 |> translate 50 70 in
+  let reb = make_arc 26 14 |> rotate 180 |> translate (-50) 70 in
+  let mouth = make_arc 80 40 |> translate 0 (-60) in
+  show [ mouth; leb; reb; a; d; b; nose ];
+  write ()

lib/backend_cairo.ml

@@ -0,0 +1,109 @@
+type context = {
+  cairo_ctx : Cairo.context;
+  surface : Cairo.Surface.t;
+  size : int * int;
+  background_color : int * int * int * float;
+  axes : bool;
+}
+
+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 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;
+
+  Cairo.Path.clear ctx.cairo_ctx
+
+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 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 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 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

lib/backend_cairo.mli

@@ -0,0 +1,20 @@
+type context = {
+  cairo_ctx : Cairo.context;
+  surface : Cairo.Surface.t;
+  size : int * int;
+  background_color : Color.color;
+  axes : bool;
+}
+
+val set_color : context -> Color.color -> unit
+val set_background : context -> Color.color -> 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

lib/backend_lazy.ml

@@ -0,0 +1,4 @@
+type context = unit
+
+let show _ctx _shapes = ()
+let create _ = ()

lib/backend_lazy.mli

@@ -0,0 +1,4 @@
+type context = unit
+
+val show : context -> Shape.shapes -> unit
+val create : unit -> context

lib/backend_svg.ml

@@ -0,0 +1,4 @@
+type context = unit
+
+let show _ctx _shapes = ()
+let create _ = ()

lib/backend_svg.mli

@@ -0,0 +1,4 @@
+type context = unit
+
+val show : context -> Shape.shapes -> unit
+val create : unit -> context