Image noise/OCaml/Xlib

<lang ocaml>open Xlib

(* animate with or without double buffering *) let do_db =

 Sys.argv = [| Sys.argv.(0); "-db" |]

let () =

 print_endline (if do_db then "double buffering"
                         else "single buffering") ;;

let num_frames = 1000

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
     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;

   if do_db then
     begin
       (* 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;
     end
   else
     begin
       (* 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;
 let t_end = Unix.gettimeofday() in
 let fps = (float num_frames) /. (t_end -. t0) in
 print_string ">> fps:";
 print_float fps;
 print_newline()</lang>