{{libheader|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

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()

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