Skip to content

Instantly share code, notes, and snippets.

@fccm
Created November 7, 2020 04:18
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save fccm/f537701f7da8a413b14c25feb93bac4b to your computer and use it in GitHub Desktop.
Save fccm/f537701f7da8a413b14c25feb93bac4b to your computer and use it in GitHub Desktop.
Mini-demo of using Cairo2 and SDL2 together in OCaml
(* Mini-demo of using Cairo2 and SDL2 together in OCaml
Copyright (C) 2020 Florent Monnier
This software is provided "AS-IS", without any express or implied warranty.
In no event will the authors be held liable for any damages arising from
the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it freely.
*)
open Sdlevent
open Sdl
let pi2 = 8. *. atan 1.
let draw cr width height x y =
let x = x -. width *. 0.5 and y = y -. height *. 0.5 in
let r = 0.5 *. sqrt (x *. x +. y *. y) in
Cairo.set_source_rgba cr 0. 1. 0. 0.5;
Cairo.arc cr (0.5 *. width) (0.35 *. height) r 0. pi2;
Cairo.fill cr;
Cairo.set_source_rgba cr 1. 0. 0. 0.5;
Cairo.arc cr (0.35 *. width) (0.65 *. height) r 0. pi2;
Cairo.fill cr;
Cairo.set_source_rgba cr 0. 0. 1. 0.5;
Cairo.arc cr (0.65 *. width) (0.65 *. height) r 0. pi2;
Cairo.fill cr;
;;
let r_mask, g_mask, b_mask, a_mask =
if Sys.big_endian then
(0xff000000l,
0x00ff0000l,
0x0000ff00l,
0x000000ffl)
else (* little endian, like x86 *)
(0x000000ffl,
0x0000ff00l,
0x00ff0000l,
0xff000000l)
let () =
Sdl.init [`VIDEO];
let width, height = (320, 240) in
let window, renderer =
Sdlrender.create_window_and_renderer ~width ~height ~flags:[]
in
let ba =
Bigarray.Array1.create Bigarray.int8_unsigned Bigarray.c_layout
(width * height * 3)
in
let rec loop (mx, my) =
(* Create a cairo context from a cairo surface and do our drawings on it. *)
let cr_img = Cairo.Image.create Cairo.Image.RGB24 width height in
let cr = Cairo.create cr_img in
draw cr (float width) (float height) (float mx) (float my);
(* Don't forget to flush the surface before using its content. *)
Cairo.Surface.flush cr_img;
(* Access the surface data of Cairo *)
let data32 = Cairo.Image.get_data32 cr_img in
(* Transfer the data from Cairo to the BA *)
for i = 0 to pred (width * height) do
let x = i mod width in
let y = i / width in
let rgb = Int32.to_int data32.{y, x} in
let r = (rgb land 0xFF0000) lsr 16 in
let g = (rgb land 0x00FF00) lsr 8 in
let b = (rgb land 0x0000FF) in
let x = i * 3
and y = i * 3 + 1
and z = i * 3 + 2 in
ba.{x} <- r;
ba.{y} <- g;
ba.{z} <- b;
done;
(* Transfer the data from the BA to a SDL2 surface *)
let surface =
Sdlsurface_ba.create_rgb_surface_from ~pixels:ba
~width ~height ~depth:24 ~pitch:(3 * width)
~r_mask ~g_mask ~b_mask ~a_mask
in
let texture = Texture.create_from_surface renderer surface in
Surface.free surface;
(* Use rectangles of different width and height to scale *)
let dst_rect = Rect.make4 0 0 width height in
let src_rect = Rect.make4 0 0 width height in
let angle = 0.0 in (* rotate *)
Render.copyEx renderer ~texture ~src_rect ~dst_rect ~angle ();
(* Flush to the Renderer *)
Sdlrender.render_present renderer;
(* Get user events *)
match Sdlevent.poll_event () with
| Some Sdlevent.Mouse_Motion e -> loop (e.mm_x, e.mm_y)
| Some Event.KeyDown { Event.keycode = Keycode.Q }
| Some Event.KeyDown { Event.keycode = Keycode.Escape }
| Some Sdlevent.Quit _ -> Sdl.quit (); exit 0
| _ -> loop (mx, my)
in
loop (0, 0)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment