[Lablgtk-list] taking the full OO approach

Philippe Strauss philou at philou.ch
Tue Mar 29 17:50:13 CEST 2011


Hello lablgtk users,

How do I write lablgtk code to be able to reuse some assembly of widgets multiple times in my app, until now I've used a lot the functional closure between class and object keyword to express my GUI and pack it, but it only works fine at the toplevel or if you use this class only once in your whole app.

example:

-- 8< --

class gui_t =
    let wtop    = GWindow.window ~title:"gtk react test" () in
    let vbox    = GPack.vbox ~packing:wtop #add () in
    let menubar = GMenu.menu_bar ~packing: vbox #pack () in
    let toolbar = GButton.toolbar ~packing:(vbox #pack ~expand:false) () in
    let _ = toolbar #set_orientation `HORIZONTAL in
    (* menu *)
    let menu_action    = GMenu.menu_item ~label:"Action" ~packing: menubar #append () in
    let menu_act       = GMenu.menu () in
    let menu_act_quit  = GMenu.image_menu_item ~stock:`QUIT ~packing:menu_act #append () in
    let _ = menu_action #set_submenu menu_act in
    let menu_help    = GMenu.menu_item ~label:"Help" ~packing: menubar #append ~right_justified:true () in
    let menu_h       = GMenu.menu () in
    let menu_h_about = GMenu.image_menu_item ~stock:`ABOUT ~packing:menu_h #append () in
    let _ = menu_help #set_submenu menu_h in 
    (* now in the toolbar *)
    let hbox_tbar  = GPack.hbox ~packing:toolbar #add () in
    (* radio buttons in the toolbar *)
    let frame_chan = GBin.frame ~label:"Channel" ~packing:hbox_tbar #add () in
    let hbox_radio = GPack.hbox ~packing:frame_chan #add () in
    (* FRP *)
    let rdomain, set_domain = S.create Time in
    let rchannel, set_channel = S.create 0 in
    let rstart, set_start = S.create 0. in
    (* pretty printers *)
    let pprint_domain dom =
        match dom with
        | Time -> Printf.printf "domain: time\n%!"
        | Frequency -> Printf.printf "domain: frequency\n%!" in
    let pprint_channel ch =
        Printf.printf "channel: %d\n%!" ch in
    let pprint_start st =
        Printf.printf "start: %3.2f\r%!" st in
    let hmap = Hashtbl.create 3 in
    let map_retain fmap rval id =
        Hashtbl.add hmap id (S.map fmap rval) in
        
    (* channels buttons *)
    let btn_array = Array.create 4 (GButton.radio_button ~label:"1" ~packing: hbox_radio #add () ~active:true) in
    let _ = btn_array.(0) #connect #clicked ~callback:(fun () -> set_channel 0) in
    let _ = begin for i = 1 to 3 do
        btn_array.(i) <- GButton.radio_button ~label:(string_of_int (i+1)) ~group: (btn_array.(0) #group)
            ~packing: hbox_radio #add () ;
        ignore(btn_array.(i) #connect #clicked ~callback:(fun () -> set_channel i))
    done end in 
    let frame_tf = GBin.frame ~label:"Domain" ~packing:hbox_tbar #add () in
    let hbox_tf  = GPack.hbox ~packing:frame_tf #add () in
    let btn_t    = GButton.radio_button ~label:"Time" ~packing: hbox_tf #add () ~active:true in
    let btn_f    = GButton.radio_button ~label:"Frequency" ~group: (btn_t #group) ~packing: hbox_tf #add () in

    (* a slider *)
    let adj_start   = GData.adjustment ~lower:0. ~upper:100. ~step_incr:1. ~page_size:0. () in
    let sc_start    = GRange.scale `HORIZONTAL ~adjustment:adj_start ~draw_value:false
        ~packing:(vbox #pack) () in

    (* statusbar *)
    let _ = GMisc.statusbar ~packing:(vbox #pack ~expand:false) () in

    object(self)

        method window_toplevel_show = wtop #show ()

        method on_quit () = GMain.Main.quit ()

        method on_about () =
            let dialog = GWindow.about_dialog
                ~name:"react gtk test" 
                ~authors:["Philippe Strauss\nphilou at philou.ch"]
                ~license:"N/A"
                ~website:"http://www.philou.ch"
                ~version:"v0.0.1"
                () in
            ignore (dialog #connect #response ~callback:(
                fun _ -> try
                    dialog #coerce #destroy ()
                with Not_found -> ())) ;
            try
                ignore (dialog #run ())
            with Not_found | Failure "dialog destroyed" -> ()

        initializer
            ignore (wtop            #connect #destroy  ~callback:(self #on_quit)) ;
            ignore (menu_act_quit   #connect #activate ~callback:(self #on_quit)) ;
            ignore (menu_h_about    #connect #activate ~callback:(self #on_about)) ;
            ignore (btn_t           #connect #clicked  ~callback:(fun () -> set_domain Time)) ;
            ignore (btn_f           #connect #clicked  ~callback:(fun () -> set_domain Frequency)) ;
            ignore (adj_start #connect #value_changed ~callback:(fun () -> set_start (adj_start #value))) ;
            
            map_retain pprint_domain rdomain "domain" ;
            map_retain pprint_channel rchannel "channel" ;
            map_retain pprint_start rstart "start" ;

end

-- 8< --

One way seems to use something close to what lablgladecc does, but few usage of such approach are availables as examples (haven't found any actually) and I do not know how to express packing with this approach (I prefer hand written code):

class gui_t =
    object(self)
        val wtop    = new GWindow.window
        method wtop = wtop
        val vbox    = new GPack.box
        method vbox = vbox        
        val menubar = new GMenu.menu_shell
        method menubar = menubar
	...
end

Thanks for any advice.


More information about the Lablgtk-list mailing list