Date: Tue, 21 Oct 2003 13:38:17 +0100
To: lablgtk at kaba.or.jp
Subject: Crashing bug in lablgtk2 2.2.0 when reading image from pixmap (Windows only)
Message-ID: <20031021123817.GA5277 at redhat.com>
Mime-Version: 1.0
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline
From: Richard Jones <rich at annexia.org>

Note this bug is specific to the Windows port. I cannot reproduce it
under Linux at all.

Save the program below as test.ml and compile it with:

ocamlc -w s -I +lablgtk2 lablgtk.cma gtkInit.cmo test.ml -o test.exe

Then run it and click on the "Save" button a few times. After the
_second_ or _third_ time you should see:

In callback for signal clicked, uncaught exception:
Glib.Critical("GLib-GObject", "file gobject.c: line 1338 (g_object_unref):
assertion `object->ref_count > 0' failed")

After a few more clicks the program will segfault.

Rich.

----------------------------------------------------------------------
open Printf

let (//) = Filename.concat

let save_it () =
  prerr_endline "Getting data from the pixmap and saving to print.ppm ...";

  let pb = GdkPixbuf.from_file "fish.jpg" in

  let pm, _ = GdkPixbuf.create_pixmap pb in

  let width = GdkPixbuf.get_width pb in
  let height = GdkPixbuf.get_height pb in

  let img = Gdk.Image.get pm ~x:0 ~y:0 ~width ~height in
  let vis = Gdk.Image.get_visual img in

  let colparser =
    match Gdk.Visual.get_type vis with
	`TRUE_COLOR | `DIRECT_COLOR ->
	  let red_mask = Gdk.Visual.red_mask vis in
	  let red_shift = Gdk.Visual.red_shift vis in
	  let green_mask = Gdk.Visual.green_mask vis in
	  let green_shift = Gdk.Visual.green_shift vis in
	  let blue_mask = Gdk.Visual.blue_mask vis in
	  let blue_shift = Gdk.Visual.blue_shift vis in
	  (fun pix ->
	     let r = (pix land red_mask) lsr red_shift in
	     let g = (pix land green_mask) lsr green_shift in
	     let b = (pix land blue_mask) lsr blue_shift in
	     r, g, b
	  )
      | `PSEUDO_COLOR ->
	  prerr_endline "warning: faking colourmap in PseudoColor visual";
	  (fun i ->
	     (* XXX Apparently no way to map colour indices to RGB values. *)
	     let r = i land 0xc0 in
	     let g = (i lsl 2) land 0xe0 in
	     let b = (i lsl 5) land 0xe0 in
	     r, g, b)
      | _ ->
	  failwith "visual type not supported (greyscale monitor?)"
  in
	
  let chan = open_out_bin "print.ppm" in
  output_string chan (Printf.sprintf "P6 %d %d 255\n" width height);
  for y = 0 to height-1 do
    for x = 0 to width-1 do
      let pix = Gdk.Image.get_pixel img ~x ~y in
      let r, g, b = colparser pix in
      output_char chan (char_of_int r);
      output_char chan (char_of_int g);
      output_char chan (char_of_int b)
    done;
  done;
  close_out chan;

  Gc.full_major ()

let () =
  let title = "Printing test" in
  let window = GWindow.window ~title () in
  window#connect#destroy GMain.quit;

  let vbox = GPack.vbox ~packing:window#add () in

  let button = GButton.button ~label:"Save as print.ppm"
		 ~packing:vbox#pack () in

  button#connect#clicked ~callback:save_it;

  window#show ();
  GMain.main ()
----------------------------------------------------------------------
-- 
Richard Jones. http://www.annexia.org/ http://freshmeat.net/users/rwmj
Merjis Ltd. http://www.merjis.com/ - all your business data are belong to you.
C2LIB is a library of basic Perl/STL-like types for C. Vectors, hashes,
trees, string funcs, pool allocator: http://www.annexia.org/freeware/c2lib/