1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69
|
(**************************************************************************)
(* Lablgtk - Examples *)
(* *)
(* This code is in the public domain. *)
(* You may freely copy parts of it in your application. *)
(* *)
(**************************************************************************)
(* $Id$ *)
(*
let get_pixbuf ~file =
try GdkPixbuf.from_file file
with GdkPixbuf.GdkPixbufError(_,msg) as exn ->
let d = GWindow.message_dialog ~message:msg ~message_type:`ERROR
~buttons:GWindow.Buttons.close ~show:true () in
d#run ();
raise exn
*)
class directory ~path = object (self)
val d = Unix.opendir path
method read = path ^"/"^ Unix.readdir d
method rewind = Unix.rewinddir d
method close = Unix.closedir d
method read_file =
let f = self#read in
if (Unix.stat f).Unix.st_kind = Unix.S_REG then f
else self#read_file
method next_file =
try self#read_file with End_of_file -> self#rewind; self#read_file
method read_pix =
let f = self#read_file in
try GdkPixbuf.from_file f
with GdkPixbuf.GdkPixbufError _ -> self#read_pix
end
let () =
let w = GWindow.window () in
let da = GMisc.drawing_area ~packing:w#add () in
da#misc#realize ();
let dw = new GDraw.drawable da#misc#window in
let dir = new directory "." in
let pm = ref None in
let set_pm pxm =
Gaux.may (fun pm -> Gdk.Pixmap.destroy pm) !pm;
pm := Some pxm;
dw#put_pixmap ~x:0 ~y:0 pxm
in
let set_pix pix =
let pxm, _ = GdkPixbuf.create_pixmap pix
and width = GdkPixbuf.get_width pix
and height = GdkPixbuf.get_height pix in
w#set_default_size ~width ~height;
set_pm pxm
in
let pix = dir#read_pix in set_pix pix;
da#event#connect#expose ~callback:
(fun _ -> Gaux.may (dw#put_pixmap ~x:0 ~y:0) !pm; true);
GMain.Timeout.add ~ms:2000 ~callback:
(fun () -> try
let pix =
try dir#read_pix with End_of_file -> dir#rewind; dir#read_pix in
set_pix pix;
true
with _ -> false);
w#connect#destroy GMain.quit;
w#show ();
GMain.main ()
|