[Lablgtk-list] taking the full OO approach

Philippe Strauss philou at philou.ch
Wed Mar 30 18:43:22 CEST 2011


Thanks Jacques I will look at it for the ml_signals.

I was the approach depicted by the following code, for getting out of the singleton of the local declaration between class and object keyword:

translation of my example of the other day, much more verbose but can be instanciated many times, even if my example is a bit pointless since it's a toplevel:

-- 8< --

open React

type domain_t = Time | Frequency

let mk_channels_buttons n =
    let ret = Array.create n (GButton.radio_button ~label:"1" ~active:true ()) in
    for i = 1 to n-1 do
        ret.(i) <- GButton.radio_button ~label:(string_of_int (i+1)) ~group: (ret.(0) #group) () ;
    done ;
    ret

let pack_channels_buttons hbox btn_arr =
    for i = 0 to (Array.length btn_arr) - 1 do
        hbox #add (btn_arr.(i) #coerce) ;
    done ;

class gui_t =
    object(self)
        val wtop             = GWindow.window ~title:"gtk react test" ()
        method wtop          = wtop
        val vbox             = GPack.vbox ()
        method vbox          = vbox        
        val menubar          = GMenu.menu_bar ()
        method menubar       = menubar
        val toolbar          = GButton.toolbar ()
        method toolbar       = toolbar
        val menu_action      = GMenu.menu_item ~label:"Action" ()
        method menu_action   = menu_action
        val menu_act         = GMenu.menu ()
        method menu_act      = menu_act
        val menu_act_quit    = GMenu.menu_item ~label:"Quit" ()
        method menu_act_quit = menu_act_quit
        val menu_help        = GMenu.menu_item ~label:"Help" ~right_justified:true ()
        method menu_help     = menu_help
        val menu_h           = GMenu.menu ()
        method menu_h        = menu_h
        val menu_h_about     = GMenu.menu_item ~label:"About" ()
        method menu_h_about  = menu_h_about 
        (* now in the toolbar *)
        val hbox_tbar        = GPack.hbox ()
        method hbox_tbar     = hbox_tbar
        (* radio buttons in the toolbar *)
        val frame_chan       = GBin.frame ~label:"Channel" ()
        method frame_chan    = frame_chan
        val hbox_radio       = GPack.hbox ()
        method hbox_radio    = hbox_radio
        (* channels buttons *)
        val btn_array        = mk_channels_buttons 4
        method btn_array     = btn_array
        (* domain buttons *) 
        val frame_tf         = GBin.frame ~label:"Domain" ()
        method frame_tf      = frame_tf
        val hbox_tf          = GPack.hbox ()
        method hbox_tf       = hbox_tf
        val btn_t            = GButton.radio_button ~label:"Time" ~active:true ()
        method btn_t         = btn_t
        val btn_f            = GButton.radio_button ~label:"Frequency" ()
        method btn_f         = btn_f
        (* a slider *)
        val adj_start        = GData.adjustment ~lower:0. ~upper:100. ~step_incr:1. ~page_size:0. ()
        method adj_start     = adj_start
        val sc_start         = GRange.scale `HORIZONTAL ~draw_value:false ()
        method sc_start      = sc_start
        (* statusbar *)
        val statusbar        = GMisc.statusbar ()
        method statusbar     = statusbar

        method window_toplevel_show = self #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
            (* 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

            self #wtop #add (self #vbox #coerce) ;
            self #vbox #pack ~expand:false (self #menubar #coerce) ;
            self #menubar #append (self #menu_action) ;
            self #menu_action #set_submenu (self #menu_act) ;
            self #menu_act #append (self #menu_act_quit) ;
            self #menubar #append (self #menu_help) ;
            self #menu_help #set_submenu (self #menu_h) ;
            self #menu_h #append (self #menu_h_about) ;
            self #toolbar #set_orientation `HORIZONTAL ;
            self #vbox #pack ~expand:false (self #toolbar #coerce) ;
            self #toolbar #add (self #hbox_tbar #coerce) ;
            self #hbox_tbar #add (self #frame_chan #coerce) ;
            self #frame_chan #add (self #hbox_radio #coerce) ;
            pack_channels_buttons (self #hbox_radio) (self #btn_array) ;
            self #hbox_tbar #add (self #frame_tf #coerce) ;
            self #frame_tf #add (self #hbox_tf #coerce) ;
            self #btn_f #set_group (self #btn_t #group) ;
            self #hbox_tf #add (self #btn_t #coerce) ;
            self #hbox_tf #add (self #btn_f #coerce) ;
            self #vbox #pack ~expand:false (self #sc_start #coerce) ;
            self #vbox #pack ~expand:false (self #statusbar #coerce) ;

            ignore (self #wtop #connect #destroy  ~callback:(self #on_quit)) ;
            ignore (self #menu_act_quit #connect #activate ~callback:(self #on_quit)) ;
            ignore (self #menu_h_about #connect #activate ~callback:(self #on_about)) ;
            for i = 0 to (Array.length (self #btn_array)) - 1 do
                (self #btn_array).(i) #connect #clicked ~callback:(fun () -> set_channel i) ;
            done ;
            ignore (self #btn_t #connect #clicked  ~callback:(fun () -> set_domain Time)) ;
            ignore (self #btn_f #connect #clicked  ~callback:(fun () -> set_domain Frequency)) ;
            ignore (self #sc_start #set_adjustment (self #adj_start)) ;
            ignore (self #adj_start #connect #value_changed ~callback:(fun () -> set_start (self #adj_start #value))) ;
            
            map_retain pprint_domain rdomain "domain" ;
            map_retain pprint_channel rchannel "channel" ;
            map_retain pprint_start rstart "start" ;
end

let () =
    let gui = new gui_t in
    gui #window_toplevel_show ;
    GMain.Main.main ()

-- 8< --

Le 30 mars 2011 à 02:20, Jacques Garrigue a écrit :

> On 2011/03/30, at 0:50, Philippe Strauss wrote:
> 
>> 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.
> 
> You may have look at the IRC client in applications/camlirc of the lablgtk source distribution.
> It tries to do things in a reasonably modular way.
> To allow repacking components, one just adds a ?packing argument, which is forwarded
> to the most external container inside your component.
> To allow communication between components, you can use the ML signal framework
> provided by GUtil.ml_signal.
> 
> Jacques Garrigue



More information about the Lablgtk-list mailing list