Image noise/OCaml/Xlib
Appearance
< Image noise | OCaml
(Redirected from Image Noise/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
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
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()