[WIP] Wayland

examples/Gradients.ml

@@ -0,0 +1,44 @@
+open OcamlCanvas
+open Float
+
+
+let interpInt x1 x2 t =
+  int_of_float ((1. -. t)*.(float_of_int x1) +. t*.(float_of_int x2))
+let interpColor c1 c2 t =
+    let r1, g1, b1 = Color.to_rgb c1 and r2, g2, b2 = Color.to_rgb c2 in
+    Color.of_rgb (interpInt r1 r2 t) (interpInt g1 g2 t) (interpInt b1 b2 t)
+let hsv_to_rgb h s v = 
+  let c = v *. s in 
+  let m = v -. c in
+  let x = c *. (1. -. abs( ( (rem (h /. 60.) 2.) -. 1.))) in
+  let r,g,b = match(h) with
+    |a when a < 60. -> c,x,0.
+    |a when a < 120. -> x,c,0.
+    |a when a < 180. -> 0.,c,x
+    |a when a < 240. -> 0.,x,c
+    |a when a < 300. -> x,0.,c
+    |_ -> c,0.,x 
+  in Color.of_rgb (int_of_float((r +. m)*.255.)) (int_of_float((g +. m)*.255.)) (int_of_float((b +. m)*.255.))
+
+open Int64
+
+let () =
+  Backend.(init default_options);
+  let c = Canvas.createFramed "test" ~pos:(960-640,540-360) ~size:(1280,720) in
+  Canvas.setFillColor c Color.white;
+  Canvas.fillRect c ~pos:(0.,0.) ~size:(1280.,720.);
+  Canvas.show c;
+  let r = ref (-1.) in 
+  Backend.run(function 
+    |Frame { canvas = c; timestamp = _ } ->
+      r := !r +. 1. /. 60.;
+      Canvas.setFillColor c (hsv_to_rgb (!r *. 36.)  1. 1.);
+      Canvas.fillRect c ~pos:(128. *. !r,0.) ~size:(128., 360.);
+      Canvas.setFillColor c (interpColor Color.black Color.white (!r *. 0.1));
+      Canvas.fillRect c ~pos:(128. *. !r,360.) ~size:(128., 360.);
+      true;
+    |_ ->
+      false;
+  )(function () ->
+    Printf.printf "Goodbye !\n"
+  )

examples/SimpleSnakeGame.ml

@@ -0,0 +1,83 @@
+open OcamlCanvas
+open Int64
+open Random
+
+let buildBackground c =
+  Canvas.setFillColor c Color.black;
+  Canvas.fillRect c ~pos:(0.,0.) ~size:(500.,500.);
+  Canvas.setFillColor c Color.white;
+  Canvas.fillRect c ~pos:(0.,0.) ~size:(500.,10.);
+  Canvas.fillRect c ~pos:(0.,490.) ~size:(500.,10.);
+  Canvas.fillRect c ~pos:(0.,0.) ~size:(10.,500.);
+  Canvas.fillRect c ~pos:(490.,0.) ~size:(10.,500.);
+  ()
+
+let placeBlock c (x,y) col = 
+  Canvas.setFillColor c col; 
+  Canvas.fillRect c ~pos:(x *. 10. , y *. 10.) ~size:(10.,10.);
+  ()
+
+let rec drawSnake c s = match(s) with
+  |[] -> ()
+  |h::t -> placeBlock c h Color.orange; drawSnake c t
+
+let rec moveSnake s p = match(s) with
+  |[] -> []
+  |h::t -> p::(moveSnake t h)
+
+let sumCoord (a,b) (c,d) = (a +. c,b +. d)
+
+let moveSnakeDirection s d = match(s) with
+  |[] -> []
+  |h::t -> moveSnake s (sumCoord d h)
+
+let snakeHitSelf s = match(s) with
+  |[] -> false
+  |h::t -> (List.mem h t)
+let snakeHitWall s = let h::t = s in let (x,y) = h in (x < 1.) or (x > 48.) or (y < 1.) or (y > 48.)
+
+
+let () =
+  Random.self_init();
+  Backend.(init default_options);
+  let c = Canvas.createFramed "test" ~pos:(960-250,540-250) ~size:(500,500) in
+  Canvas.show c;
+  let r = ref (-1.) in 
+  let snake = ref [(6.,8.);(6.,7.)] and currentDirection = ref (0.,1.) and foodLocation = ref(24.,24.) in
+  Backend.run(function 
+    |KeyAction { canvas = c; timestamp = _;
+    key = KeyUpArrow; char; flags = _; state = Down } ->
+      let (x,y) = !currentDirection in
+      if (y = 0.) then currentDirection := (0.,-1.);
+      true;
+    |KeyAction { canvas = c; timestamp = _;
+    key = KeyDownArrow; char; flags = _; state = Down } ->
+      let (x,y) = !currentDirection in
+      if (y = 0.) then currentDirection := (0.,1.);
+      true;
+    |KeyAction { canvas = c; timestamp = _;
+    key = KeyLeftArrow; char; flags = _; state = Down } ->
+      let (x,y) = !currentDirection in
+      if (x = 0.) then currentDirection := (-1.,0.);
+      true;
+    |KeyAction { canvas = c; timestamp = _;
+    key = KeyRightArrow; char; flags = _; state = Down } ->
+      let (x,y) = !currentDirection in
+      if (x = 0.) then currentDirection := (1.,0.);
+      true;
+
+    |Frame { canvas = c; timestamp = _ } ->
+      r := !r +. 1. /. 60.;
+      buildBackground c;
+      let h::t = !snake in
+        if ((sumCoord h !currentDirection) = !foodLocation) then (snake := !foodLocation::!snake; foodLocation := (2. +. float_of_int (Random.int 47),2. +. float_of_int (Random.int 47)));
+      if !r > 0.033 then (r := 0.; snake := moveSnakeDirection !snake !currentDirection);
+      if (snakeHitSelf !snake or snakeHitWall !snake) then Backend.stop();
+      drawSnake c !snake;
+      placeBlock c !foodLocation Color.green;
+      true;
+    |_ ->
+      false;
+  )(function () ->
+    Printf.printf "Goodbye !\n"
+  )

examples/dune

@@ -14,3 +14,19 @@
  (modules test_canvas)
  (libraries ocaml-canvas)
 )
+
+(executable
+ (name Gradients)
+ (public_name Gradients)
+ (modes byte_complete native js)
+ (modules Gradients)
+ (libraries ocaml-canvas)
+)
+
+(executable
+ (name SimpleSnakeGame)
+ (public_name Snake)
+ (modes byte_complete native js)
+ (modules SimpleSnakeGame)
+ (libraries ocaml-canvas)
+)

src/implem/backend.c

@@ -133,7 +133,7 @@ backend_init(
     case_GDI(result = gdi_backend_init());
     case_QUARTZ(result = qtz_backend_init());
     case_X11(result = x11_backend_init());
-    case_WAYLAND(/*result = wl_backend_init()*/);
+    case_WAYLAND(result = wl_backend_init());
     default_ignore();
   }
 

src/implem/surface.c

@@ -137,7 +137,12 @@ surface_destroy(
   }
 
   if (s->data) {
-    free(s->data);
+    switch_IMPL() {
+      case_WAYLAND(munmap(s->data,s->width * s->height * 4));
+      default:
+        free(s->data);
+        break;
+    }
   }
 
   free(s);
@@ -191,7 +196,12 @@ surface_resize(
 
     _surface_copy_to_buffer(s, data, width, height);
 
-    free(s->data);
+    switch_IMPL() {
+      case_WAYLAND(munmap(s->data,s->width * s->height * 4));
+      default:
+        free(s->data);
+        break;
+    }
 
   } else {