Image noise/OCaml/Xlib

Library: OCaml-Xlib

By default this program displays the noise with double buffering. The command-line options -single selects the single buffering.

Launch this program as a script with:

ocaml -I +Xlib Xlib.cma unix.cma noise_fps_x.ml                                                            
ocaml -I +Xlib Xlib.cma unix.cma noise_fps_x.ml -single

<lang ocaml>open Xlib

type buffering = Single | Double

let best_buffering = Double let default_buffering = Single

let num_frames = 1000

(* choose the buffering kind *) let buffering =

 match Sys.argv with
 | [| _; "-db" |] -> Double
 | [| _; "-best" |] -> best_buffering
 | [| _; "-single" |] -> Single
 | [| _; "-default" |] -> default_buffering
 | _ -> best_buffering

(* report the buffering chosen *) let () =

 print_endline (
   match buffering with
   | Double -> "double buffering"
   | Single -> "single buffering")

let () =

 let width = 320 and height = 240 in
 let dpy = xOpenDisplay "" in

 (* initialisation of the standard variables *)
 let screen = xDefaultScreen dpy in
 let root = xDefaultRootWindow dpy
 and visual = xDefaultVisual dpy screen
 and depth = xDefaultDepth dpy screen
 and black = xBlackPixel dpy screen
 and white = xWhitePixel dpy screen
 in

 (* set foreground and background in the graphics context *)
 let gcvalues = new_xGCValues() in
 xGCValues_set_foreground gcvalues black;
 xGCValues_set_background gcvalues white;
 let gc = xCreateGC dpy root [GCForeground;GCBackground] gcvalues in

 (* creation of the double buffer *)
 let db = xCreatePixmap dpy root width height depth in
 (* without these lines previous images from memory will appear *)
 xSetForeground dpy gc white;
 xFillRectangle dpy db gc 0 0 width height;
 xSetForeground dpy gc black;

 (* window attributes *)
 let xswa = new_win_attr() in

 (* the events we want *)
 xswa.set_event_mask [ExposureMask;PointerMotionMask;KeyPressMask];

 (* border and background colors *)
 xswa.set_background_pixel white;
 xswa.set_border_pixel black;

 let win =
   xCreateWindow
     dpy root 100 100 width height 2 depth InputOutput visual
     [CWEventMask;CWBorderPixel;CWBackPixel] xswa.attr
 in

 (* show the window on screen *)
 xMapRaised dpy win;

 (* connect the close button of the window handle *)
 let wm_delete_window = xInternAtom dpy "WM_DELETE_WINDOW" true in
 xSetWMProtocols dpy win wm_delete_window 1;

 let t0 = Unix.gettimeofday() in
 let event = new_xEvent() in

 for i = 1 to num_frames do
   if xPending dpy > 0 then
   begin
     (* handle events *)
     xNextEvent dpy event;
     match xEventType event with
     | Expose ->
         (* remove all the Expose events from the event stack *)
         while (xCheckTypedEvent dpy Expose event) do () done;
         xCopyArea dpy db win gc 0 0 width height 0 0;
         (* force refresh the screen *)
         xFlush dpy;

     | KeyPress ->
         (* exit on any key press *)
         xCloseDisplay dpy;
         exit 0;

     | ClientMessage ->
         (* delete window event *)
         let xclient = to_xClientMessageEvent event in
         let atom = xEvent_xclient_data xclient in
         if atom = wm_delete_window then exit 0

     | _ -> ()
   end;

   begin
     match buffering with
     | Double ->
         (* animation with the double buffer *)
         xSetForeground dpy gc white;
         xFillRectangle dpy db gc 0 0 width height;
         xSetForeground dpy gc black;

         let points = Array.init (width * height / 2) (fun _ ->
           { pnt_x = Random.int width; pnt_y = Random.int height }) in
         xDrawPoints dpy db gc points CoordModeOrigin;

         xCopyArea dpy db win gc 0 0 width height 0 0;
         (* force refresh the screen *)
         xFlush dpy;
     | Single ->
         (* animation without double buffer *)
         xClearWindow dpy win;

         let points = Array.init (width * height / 2) (fun _ ->
           { pnt_x = Random.int width; pnt_y = Random.int height }) in

         xDrawPoints dpy win gc points CoordModeOrigin;
   end
 done;

 (* tell what was the FPS for num_frames frames *)
 let t_end = Unix.gettimeofday() in
 let fps = (float num_frames) /. (t_end -. t0) in
 print_string ">> fps:";
 print_float fps;
 print_newline()</lang>

You can also compile this program to native-code with the following command:

$ ocamlopt -I +Xlib Xlib.cmxa unix.cmxa noise_fps_x.ml -o noise_fps_x.opt

and then execute the result with:

$ ./noise_fps_x.opt