Run dune fmt

examples/fill_rect.ml

@@ -5,4 +5,3 @@ let () =
   let r = rectangle 200 200 |> with_fill (rgb 255 0 0) in
   show [ r ];
   write ~filename:"fill-rect.png" ()
-

examples/line.ml

@@ -5,6 +5,5 @@ let _ =
   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];
+  show [ l1; l2; l3 ];
   write ~filename:"line.png" ()
-

lib/backend_cairo.ml

@@ -2,23 +2,23 @@ type context = {
   cairo_ctx : Cairo.context;
   surface : Cairo.Surface.t;
   size : int * int;
-  background_color: int * int * int * float;
-  axes: bool;
+  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 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 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;
@@ -68,9 +68,7 @@ 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;
+  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;
@@ -79,15 +77,19 @@ let draw_polygon ctx vertices stroke fill =
 
 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.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.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.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
@@ -101,4 +103,3 @@ let create ~background_color ~line_width ~size ~axes =
   set_background ctx background_color;
   set_line_width ctx line_width;
   ctx
-

lib/backend_cairo.mli

@@ -2,8 +2,8 @@ type context = {
   cairo_ctx : Cairo.context;
   surface : Cairo.Surface.t;
   size : int * int;
-  background_color: Color.color;
-  axes: bool;
+  background_color : Color.color;
+  axes : bool;
 }
 
 val set_color : context -> Color.color -> unit
@@ -12,4 +12,9 @@ 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 create :
+  background_color:Color.color ->
+  line_width:int ->
+  size:int * int ->
+  axes:bool ->
+  context

lib/backend_lazy.ml

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

lib/color.mli

@@ -2,7 +2,6 @@ type color = int * int * int * float
 
 val rgb : int -> int -> int -> color
 val color : ?a:float -> int -> int -> int -> color
-
 val black : color
 val white : color
 val red : color

lib/context.ml

@@ -1,56 +1,41 @@
 type context =
-    CairoContext of Backend_cairo.context
+  | CairoContext of Backend_cairo.context
   | SVGContext of Backend_svg.context
   | LazyContext of Backend_lazy.context
 
 exception No_context
 exception Unsupported_output_format of string
 
 let default = ref (LazyContext (Backend_lazy.create ()))
-
-let get_default _ =
-  !default
-
-let set_default ctx =
-  default := ctx
+let get_default _ = !default
+let set_default ctx = default := ctx
 
 let show ?ctx shapes =
-  let ctx = match ctx with
-    | Some ctx -> ctx
-    | None -> get_default ()
-  in
+  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 set_line_width ?ctx int =
-  let ctx = match ctx with
-  | Some ctx -> ctx
-  | None -> get_default ()
-  in
+  let ctx = match ctx with Some ctx -> ctx | None -> get_default () in
   match ctx with
   | CairoContext ctx -> Backend_cairo.set_line_width ctx int
   | SVGContext _ -> failwith "SVG.set_line_width ctx int"
   | LazyContext _ -> failwith "Backend_lazy.set_line_width ctx int"
 
 let writePNG ?ctx filename =
-  let ctx = match ctx with
-    | Some ctx -> ctx
-    | None -> get_default ()
-  in
+  let ctx = match ctx with Some ctx -> ctx | None -> get_default () in
   match ctx with
   | CairoContext ctx -> Backend_cairo.write ctx filename
-  | SVGContext _ -> raise (Unsupported_output_format "SVG context cannot render to PNG")
+  | SVGContext _ ->
+      raise (Unsupported_output_format "SVG context cannot render to PNG")
   | LazyContext _ -> failwith "Lazy.writePNG ctx filename"
 
 let writeSVG ?ctx =
-  let ctx = match ctx with
-    | Some ctx -> ctx
-    | None -> get_default ()
-  in
+  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")
+  | CairoContext _ ->
+      raise (Unsupported_output_format "Cairo context cannot render to SVG")
   | SVGContext _ -> failwith "SVG.writeSVG ctx"
   | LazyContext _ -> failwith "Lazy.writeSVG ctx"
-

lib/context.mli

@@ -1,5 +1,5 @@
 type context =
-    CairoContext of Backend_cairo.context
+  | CairoContext of Backend_cairo.context
   | SVGContext of Backend_svg.context
   | LazyContext of Backend_lazy.context
 
@@ -8,10 +8,7 @@ exception Unsupported_output_format of string
 
 val get_default : unit -> context
 val set_default : context -> unit
-
 val show : ?ctx:context -> Shape.shapes -> unit
 val set_line_width : ?ctx:context -> int -> unit
-
 val writeSVG : ?ctx:context -> string
 val writePNG : ?ctx:context -> string -> unit
-

lib/joy.ml

@@ -2,26 +2,34 @@ include Random
 include Shape
 include Transform
 include Color
-
 module Backend_cairo = Backend_cairo
 module Backend_svg = Backend_svg
 module Backend_lazy = Backend_lazy
 
 type context = Context.context
+
 let show = Context.show
 let set_line_width = Context.set_line_width
 
 let init ?(size = (500, 500)) ?(line_width = 2) ?(axes = false) _ =
-  let ctx = Backend_cairo.create ~background_color:Color.white ~size ~line_width ~axes in
+  let ctx =
+    Backend_cairo.create ~background_color:Color.white ~size ~line_width ~axes
+  in
   let ctx_container = Context.CairoContext ctx in
   Context.set_default ctx_container;
   if axes then
-    let half_w, half_h = ctx.size |> Util.tmap float_of_int |> Util.tmap (fun x -> x /. 2.0) in
+    let half_w, half_h =
+      ctx.size |> Util.tmap float_of_int |> Util.tmap (fun x -> x /. 2.0)
+    in
     let gray = Color.color 128 128 128 ~a:0.5 in
-    let x_axis = line ~a:{x = -.half_w; y = 0.} {x = half_w; y = 0.} |> with_stroke gray in
-    let y_axis = line ~a:{x = 0.; y = -.half_h} {x = 0.; y = half_h} |> with_stroke gray in
-    show ~ctx:ctx_container [x_axis; y_axis]
-
-let write ?(filename = "joy.png") () =
-  Context.writePNG filename
+    let x_axis =
+      line ~a:{ x = -.half_w; y = 0. } { x = half_w; y = 0. }
+      |> with_stroke gray
+    in
+    let y_axis =
+      line ~a:{ x = 0.; y = -.half_h } { x = 0.; y = half_h }
+      |> with_stroke gray
+    in
+    show ~ctx:ctx_container [ x_axis; y_axis ]
 
+let write ?(filename = "joy.png") () = Context.writePNG filename

lib/joy.mli

@@ -16,23 +16,19 @@ val ellipse : ?c:float point -> int -> int -> shape
 val line : ?a:float point -> float point -> shape
 val polygon : float point list -> shape
 val complex : shapes -> shape
-
 val rotate : int -> transformation
 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
 val map_fill : (color -> color) -> transformation
-
 val black : color
 val white : color
 val red : color
@@ -41,9 +37,7 @@ val blue : color
 val yellow : color
 val transparent : color
 val rgb : int -> int -> int -> color
-
-val init : ?size:(int * int) -> ?line_width:int -> ?axes:bool -> unit -> unit
+val init : ?size:int * int -> ?line_width:int -> ?axes:bool -> unit -> unit
 val write : ?filename:string -> unit -> unit
-
 val show : ?ctx:context -> shapes -> unit
 val set_line_width : ?ctx:context -> int -> unit

lib/shape.ml

@@ -1,13 +1,7 @@
 type 'a point = { x : 'a; y : 'a }
 type color = Color.color
 type line = { a : float point; b : float point; stroke : color }
-
-type circle = {
-  c : float point;
-  radius : float;
-  stroke : color;
-  fill : color;
-}
+type circle = { c : float point; radius : float; stroke : color; fill : color }
 
 type ellipse = {
   c : float point;
@@ -17,11 +11,7 @@ type ellipse = {
   fill : color;
 }
 
-type polygon = {
-  vertices : float point list;
-  stroke : color;
-  fill : color;
-}
+type polygon = { vertices : float point list; stroke : color; fill : color }
 
 type shape =
   | Circle of circle
@@ -39,7 +29,13 @@ let point x y =
 let origin = { x = 0.; y = 0. }
 
 let circle ?(c = origin) r =
-  Circle { c; radius = float_of_int r; stroke = Color.black; fill = Color.transparent }
+  Circle
+    {
+      c;
+      radius = float_of_int r;
+      stroke = Color.black;
+      fill = Color.transparent;
+    }
 
 let polygon vertices =
   Polygon { vertices; stroke = Color.black; fill = Color.transparent }
@@ -63,10 +59,10 @@ let complex shapes =
   match shapes with _ :: _ -> Complex shapes | [] -> Complex []
 
 let rec with_stroke stroke = function
-  | Circle circle' -> Circle { circle' with stroke = stroke }
-  | Ellipse ellipse' -> Ellipse { ellipse' with stroke = stroke }
+  | Circle circle' -> Circle { circle' with stroke }
+  | Ellipse ellipse' -> Ellipse { ellipse' with stroke }
   | Line line' -> Line { line' with stroke }
-  | Polygon polygon' -> Polygon { polygon' with stroke = stroke }
+  | Polygon polygon' -> Polygon { polygon' with stroke }
   | Complex complex' -> Complex (List.map (with_stroke stroke) complex')
 
 let rec with_fill fill = function
@@ -77,4 +73,3 @@ let rec with_fill fill = function
   | _ as line' ->
       print_endline "lines do not have a fill field!";
       line'
-

lib/shape.mli

@@ -1,12 +1,6 @@
 type color = Color.color
 type 'a point = { x : 'a; y : 'a }
-
-type circle = {
-  c : float point;
-  radius : float;
-  stroke : color;
-  fill : color;
-}
+type circle = { c : float point; radius : float; stroke : color; fill : color }
 
 type ellipse = {
   c : float point;
@@ -16,12 +10,7 @@ type ellipse = {
   fill : color;
 }
 
-type polygon = {
-  vertices : float point list;
-  stroke : color;
-  fill : color;
-}
-
+type polygon = { vertices : float point list; stroke : color; fill : color }
 type line = { a : float point; b : float point; stroke : color }
 
 type shape =