From: Jon Harrop <jon at jdh30.plus.com>
Organization: University of Cambridge
To: lablgtk at kaba.or.jp
Subject: Resize problems with GLGTK
Date: Fri, 28 Jan 2005 08:59:53 +0000
MIME-Version: 1.0
Content-Type: text/plain;
  charset="us-ascii"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline
Message-Id: <200501280859.53447.jon at jdh30.plus.com>


Hi!

I'm porting an ocaml program from lablglut to lablgtk2. I am trying to get a 
window containing a menu-bar at the top and the rest dedicated to a GL 
widget. Then I just need to mimic the functionality of the glut callbacks 
(reshape, redisplay, idle, motion, passive_motion etc.) for the GL widget.

Unexpectedly, I am finding mimicing the callbacks fairly easy but I can't get 
the 2-widget window to work!

I've boiled my problem down to the code at the end of this mail which I'm 
compiling with:

ocamlc -custom -I +lablGL -I +lablgtk2 lablgl.cma lablgtk.cma lablgtkgl.cma 
gtkInit.cmo editor.ml -o editor

If "test_mode" is true then the program tries to draw a vbox containing a 
simple menu-bar and a (expand+fill) scroll widget. This appears to work 
perfectly with the window resize_mode set to either `QUEUE or `PARENT but 
enlarges the menu bar and leaves a gap at the bottom with `IMMEDIATE.

If "test_mode" is false then the program replaces the scroll widget with a GL 
widget which draws a coloured square. This doesn't work properly and I have 
found that the incorrect behaviour depends upon the resize mode of the 
window.

Setting the resize_mode to `IMMEDIATE causes the menu-bar to be enlarged 
vertically and the GL widget fails to fill the remainder of the window, 
leaving a gap at the bottom. Setting the resize_mode to `QUEUE or `PARENT, 
the GL widget does try to fill the remainder of the window but based upon the 
previous window's size when resizing. This is manifested slightly more subtly 
as a border at bottom and right whilst enlarging the window (releasing the 
mouse button whilst dragging leaves a grey gap around the GL widget), and by 
an incorrect viewport when the window is maximised/minimised.

I don't pretend to understand what the implications of the resize_mode should 
be but I can't see where I should go from here. I'd appreciate any 
constructive criticism! :-)

While I'm here, can I also get people's thoughts on using GL and GTK in a 
commercial application?

let test_mode = true

open GMain

let open_file () = ()
let save_dialog () = ()
let save_file () = ()

class view area = object (self)
  val area : GlGtk.area = area

  method width = area#misc#allocation.Gtk.width
  method height = area#misc#allocation.Gtk.height

  method display () =
    print_endline "display";
    GlClear.color (0.0, 0.0, 0.0);
    GlClear.clear [`color];
    GlDraw.color (1.0, 1.0, 1.0);
    GlDraw.shade_model `smooth;
    GlDraw.begins `polygon;
    GlDraw.color (1., 0., 0.);
    GlDraw.vertex ~x:(-0.5) ~y:(-0.5) ();
    GlDraw.color (1., 1., 0.);
    GlDraw.vertex ~x:(-0.5) ~y:(0.5) ();
    GlDraw.color (0., 0., 1.);
    GlDraw.vertex ~x:(0.5) ~y:(0.5) ();
    GlDraw.color (1., 0., 1.);
    GlDraw.vertex ~x:(0.5) ~y:(-0.5) ();
    GlDraw.ends ();
    Gl.flush();
    area#swap_buffers ()

  method reshape ~width ~height =
    print_endline ("reshape "^string_of_int width^"x"^string_of_int height);
    GlDraw.viewport ~x:0 ~y:0 ~w:width ~h:height;
    GlMat.mode `projection;
    GlMat.load_identity ();
    GlMat.ortho ~x:(-1., 1.) ~y:(-1., 1.) ~z:(-1., 1.);
    GlMat.mode `modelview

  method button_press event =
    let button = GdkEvent.Button.button event in
    print_endline ("button_press "^string_of_int button);
    let x = GdkEvent.Button.x event in
    let y = GdkEvent.Button.y event in
    true

  method button_release event =
    let button = GdkEvent.Button.button event in
    print_endline ("button_release "^string_of_int button);
    let x = GdkEvent.Button.x event in
    let y = GdkEvent.Button.y event in
    true

  method motion event =
    let event : GdkEvent.Motion.t = event in
    let x = GdkEvent.Motion.x event in
    let y = GdkEvent.Motion.y event in
    true

  method key sym = match sym with
  | "\027" -> area#misc#toplevel#destroy (); exit 0
  | _ -> ()

  initializer
    ignore (area#connect#display ~callback:self#display);
    ignore (area#connect#reshape ~callback:self#reshape)
end

let create_file_menu ~packing =
  let file_menu = GMenu.menu ~packing () in
  let f (label, callback) =
    let item = GMenu.menu_item ~label ~packing:file_menu#append () in
    ignore (item#connect#activate ~callback)
  in
  List.iter f ["Open", (fun () -> print_endline "Open");
        "Save", (fun () -> print_endline "Save");
        "Quit", GMain.Main.quit];
  file_menu

let () =
  let window =
    GWindow.window ~title:"Fire Vector Graphics" () in
  ignore (window#connect#destroy ~callback:Main.quit);
  ignore (window#set_resize_mode `QUEUE);

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

  let menubar = GMenu.menu_bar ~packing:vbox#pack () in
  let factory = new GMenu.factory menubar in
  let accel_group = factory#accel_group in
  let file_menu = factory#add_submenu "File" in

  let factory = new GMenu.factory file_menu ~accel_group in
  ignore (factory#add_item "Open" ~callback:open_file);
  ignore (factory#add_item "Save" ~callback:save_file);
  ignore (factory#add_item "Save as..." ~callback:save_dialog);
  ignore (factory#add_separator ());
  ignore (factory#add_item "Quit" ~callback:window#destroy);

  if test_mode then
    ignore (GBin.scrolled_window ~packing:(vbox#pack ~expand:true ~fill:true) 
())
  else begin
    let area =
      GlGtk.area [`DEPTH_SIZE 16; `RGBA; `DOUBLEBUFFER; `STENCIL_SIZE 1]
 ~packing:(vbox#pack ~expand:true ~fill:true) ~show:true () in
    area#event#add [`BUTTON1_MOTION;
      `BUTTON2_MOTION;
      `BUTTON3_MOTION;
      `BUTTON_MOTION;
      `BUTTON_PRESS;
      `BUTTON_RELEASE;
      `ENTER_NOTIFY;
      `EXPOSURE;
      `FOCUS_CHANGE;
      `KEY_PRESS;
      `KEY_RELEASE;
      `LEAVE_NOTIFY;
      `POINTER_MOTION;
      `PROPERTY_CHANGE;
      `PROXIMITY_IN;
      `PROXIMITY_OUT;
      `SCROLL;
      `STRUCTURE;
      `SUBSTRUCTURE;
      `VISIBILITY_NOTIFY];
    
    let view = new view area in
    ignore (window#event#connect#key_press
       ~callback:(fun ev -> view#key (GdkEvent.Key.string ev); true));
    ignore (window#event#connect#motion_notify ~callback:view#motion);
    ignore (window#event#connect#button_press ~callback:view#button_press);
    ignore (window#event#connect#button_release ~callback:view#button_release)
  end;

  ignore (window#show ());
  Main.main ()

-- 
Dr Jon D Harrop, Flying Frog Consultancy Ltd.