Image noise/OCaml/Xlib: Difference between revisions
< Image noise | OCaml
Content added Content deleted
(with X) |
m (→{{header|OCaml}}: better command line parameters handling) |
||
Line 1: | Line 1: | ||
{{libheader|OCaml-Xlib}} |
|||
<lang ocaml>open Xlib |
<lang ocaml>open Xlib |
||
type buffering = Single | Double |
|||
(* animate with or without double buffering *) |
|||
⚫ | |||
Sys.argv = [| Sys.argv.(0); "-db" |] |
|||
let |
let best_buffering = Double |
||
let default_buffering = Single |
|||
⚫ | |||
⚫ | |||
let num_frames = 1000 |
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 *) |
|||
⚫ | |||
print_endline ( |
|||
match buffering with |
|||
⚫ | |||
⚫ | |||
let () = |
let () = |
||
Line 89: | Line 104: | ||
end; |
end; |
||
begin |
|||
match buffering with |
|||
| Double -> |
|||
(* animation with the double buffer *) |
(* animation with the double buffer *) |
||
⚫ | |||
xSetForeground dpy gc white; |
|||
xFillRectangle dpy db gc 0 0 width height; |
|||
⚫ | |||
let points = Array.init (width * height / 2) (fun _ -> |
let points = Array.init (width * height / 2) (fun _ -> |
||
{ pnt_x = Random.int width; pnt_y = Random.int height }) in |
{ pnt_x = Random.int width; pnt_y = Random.int height }) in |
||
xDrawPoints dpy db gc points CoordModeOrigin; |
xDrawPoints dpy db gc points CoordModeOrigin; |
||
xCopyArea dpy db win gc 0 0 width height 0 0; |
xCopyArea dpy db win gc 0 0 width height 0 0; |
||
(* force refresh the screen *) |
(* force refresh the screen *) |
||
xFlush dpy; |
xFlush dpy; |
||
| Single -> |
|||
⚫ | |||
else |
|||
⚫ | |||
begin |
|||
⚫ | |||
⚫ | |||
let points = Array.init (width * height / 2) (fun _ -> |
let points = Array.init (width * height / 2) (fun _ -> |
||
{ pnt_x = Random.int width; pnt_y = Random.int height }) in |
{ pnt_x = Random.int width; pnt_y = Random.int height }) in |
||
xDrawPoints dpy win gc points CoordModeOrigin; |
xDrawPoints dpy win gc points CoordModeOrigin; |
||
end |
|||
done; |
done; |
||
let t_end = Unix.gettimeofday() in |
let t_end = Unix.gettimeofday() in |
||
let fps = (float num_frames) /. (t_end -. t0) in |
let fps = (float num_frames) /. (t_end -. t0) in |
Revision as of 22:12, 7 October 2010
<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 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;
let t_end = Unix.gettimeofday() in let fps = (float num_frames) /. (t_end -. t0) in print_string ">> fps:"; print_float fps; print_newline()</lang>