Delivered-To: garrigue at math.nagoya-u.ac.jp
Delivered-To: lablgtk at yquem.inria.fr
Date: Mon, 5 Jul 2010 20:48:12 +0200
From: Maxence Guesdon <maxence.guesdon at inria.fr>
To: lablgtk at yquem.inria.fr
Subject: Re: [Lablgtk] Pixbuf column for a tree custom model
Message-ID: <20100705204812.56cd05ee at haddock.home>
In-Reply-To: <AANLkTikePfrBqbvNySqsnX2mxMIQ4Y6S29D1J3Ixnl8n at mail.gmail.com>
References: <AANLkTikWQw7m-u-kQ7mrdcNBPKlm1AVaCOalF6X1RKh4 at mail.gmail.com>
	<20100705121304.6c3d7845@haddock.home>
	<AANLkTikePfrBqbvNySqsnX2mxMIQ4Y6S29D1J3Ixnl8n@mail.gmail.com>
Mime-Version: 1.0
Content-Type: multipart/mixed; boundary="MP_/WY6/Kw9JO_ku0SBvwtMDfc_"
Status: U

--MP_/WY6/Kw9JO_ku0SBvwtMDfc_
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: quoted-printable
Content-Disposition: inline

Le Mon, 5 Jul 2010 14:56:43 +0400,
Dmitry Bely <dbely@mail.ru> a =C3=A9crit :

> Hi Maxence,
>=20
> Thanks a lot but that's not what I need. You describe how to create a
> Gtk list store that holds pixbuf data; I know that. But my question
> was about the custom model

Oups, sorry, I read too fast. I made an attempt to modify the example
custom_tree_generic.ml. Here is a modified version where I managed to
display a pixbuf in an additional column, but I get warning about
incompatible types:
  (ocaml:3769): GLib-GObject-WARNING **: unable to set property
  `pixbuf' of type `GdkPixbuf' from value of type `Caml'

I may have missed something.

The custom_tree_generic.ml example works fine on my system (but I had
to make clean lablgtk to prevent some problem with
ml_gtk_tree_....._visible_range).

Hope this helps,
Maxence

> (http://www.tupelo-schneck.org/robert/custom-model), now integrated
> into Lablgtk. There are some examples in Lablgtk distribution
> (examples/custom_*.ml) with a custom_value method like
>=20
>   method custom_value (t:Gobject.g_type) (row:custom_tree) ~column =3D
>     if column =3D 0 then `CAML (Obj.repr row)
>     else if column =3D 1 then
>       `BOOL (match row with File {finfo=3D{fchecked=3Db}} -> b
>              | _ -> false )
>     else if column =3D 2 then
>       `INT (5+(get_nb row))
>     else assert false
>=20
> It illustrates that returning basic Ocaml types is trivial. But how to
> return pixbuf? It's not clear to me.
>=20
> - Dmitry Bely
>=20
> BTW, custom_tree_generic.ml example does not work in my system. What
> about you?
>=20
> On Mon, Jul 5, 2010 at 2:13 PM, Maxence Guesdon
> <maxence.guesdon@inria.fr> wrote:
> > Le Mon, 5 Jul 2010 11:02:17 +0400,
> > Dmitry Bely <dmitry.bely@gmail.com> a =C3=A9crit :
> >
> >> Hello,
> >
> > Hello,
> >
> >>
> >> How to return GdkPixbuf.pixbuf from a user-defined method
> >> custom_get_value (custom_tree_model_type)? Probably it should be
> >> `POINTER but I fail to see how to construct it from a pixbuf. Any
> >> hints are greatly appreciated.
> >
> > You may hav a look at the Gmytree module included in cameleon2:
> > =C2=A0http://svn.gna.org/viewcvs/cameleon/trunk/src/utils/gmytree.ml?re=
v=3D749&view=3Dmarkup
> >
> > It gives a way to define a tree with a description of the columns.
> > For a use case, you may look at
> > =C2=A0http://svn.gna.org/viewcvs/cameleon/trunk/src/editor/ed_odoc.ml?r=
ev=3D749&view=3Dmarkup
> > =C2=A0(in class view)
> >
> > The important part of Gmytree is;
> >
> > =C2=A0...
> > =C2=A0let tcols =3D new GTree.column_list in
> > =C2=A0let disp_cols =3D List.map
> > =C2=A0 =C2=A0 =C2=A0(function
> > =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0`String _ ->
> > =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0`String (tcols#add Gobject.Dat=
a.string)
> > =C2=A0 =C2=A0 =C2=A0 =C2=A0| `Pixmap _ ->
> > =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0`Pixbuf (tcols#add (Gobject.Da=
ta.gobject :
> > GdkPixbuf.pixbuf Gobject.data_conv)) ) cols
> > =C2=A0in
> > =C2=A0let (datacol : 'a GTree.column) =3D =C2=A0tcols#add Gobject.Data.=
caml in
> > =C2=A0let store =3D GTree.tree_store tcols in
> > =C2=A0let view =3D GTree.view
> > =C2=A0 =C2=A0 =C2=A0~headers_visible: false
> > =C2=A0 =C2=A0 =C2=A0~model: store ~packing: wscroll#add_with_viewport (=
) in
> > =C2=A0let renderer =3D GTree.cell_renderer_text [] in
> > =C2=A0let pix_renderer =3D GTree.cell_renderer_pixbuf [] in
> > =C2=A0let _ =3D
> > =C2=A0 =C2=A0List.iter
> > =C2=A0 =C2=A0 =C2=A0(fun c ->
> > =C2=A0 =C2=A0 =C2=A0 =C2=A0let col =3D
> > =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0match c with
> > =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0`String c -> GTree.view_column=
 () ~renderer: (renderer,
> > =C2=A0["text", c]) | `Pixbuf c -> GTree.view_column () ~renderer:
> > =C2=A0(pix_renderer, ["pixbuf",c]) in
> > =C2=A0 =C2=A0 =C2=A0 =C2=A0ignore (view#append_column col)
> > =C2=A0 =C2=A0 =C2=A0)
> > =C2=A0 =C2=A0 =C2=A0disp_cols
> > =C2=A0in
> > =C2=A0...
> >
> > Hope this helps,
> >
> > Maxence
> >
> >
> > _______________________________________________
> > Lablgtk mailing list
> > Lablgtk@yquem.inria.fr
> > http://yquem.inria.fr/cgi-bin/mailman/listinfo/lablgtk
> >
>=20
> _______________________________________________
> Lablgtk mailing list
> Lablgtk@yquem.inria.fr
> http://yquem.inria.fr/cgi-bin/mailman/listinfo/lablgtk

--MP_/WY6/Kw9JO_ku0SBvwtMDfc_
Content-Type: text/x-ocaml
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment; filename=custom_tree_generic2.ml

(**************************************************************************)
(*    Lablgtk - Examples                                                  *)
(*                                                                        *)
(*    There is no specific licensing policy, but you may freely           *)
(*    take inspiration from the code, and copy parts of it in your        *)
(*    application.                                                        *)
(*                                                                        *)
(**************************************************************************)

(* ../src/lablgtk2 -localdir custom_tree_generic.ml *)


let debug = false
let () =
  if debug then begin
  Gc.set { (Gc.get()) with Gc.verbose = 0x00d; space_overhead = 0 };
  ignore (Gc.create_alarm (fun () ->
  let s = Gc.stat () in
  Format.printf "blocks=%d words=%d@."
  s.Gc.live_blocks
  s.Gc.live_words))
  end

module MAKE(TREE:sig type t
		     val sons: t -> t array
                     val custom_value: Gobject.g_type -> t -> column:int -> Gobject.basic
                     val column_list:GTree.column_list
	    end) =
struct
  type custom_tree =
      {finfo: TREE.t;
       mutable sons: custom_tree array;
       mutable parent: custom_tree option;
       fidx: int (* invariant: parent.(fidx)==myself *) }

  let inbound i a = i>=0 && i<Array.length a

  (** The custom model itself *)
  class custom_tree_class column_list =
  object (self)
    inherit
      [custom_tree,custom_tree,unit,unit] GTree.custom_tree_model column_list

    method custom_encode_iter cr = cr, (), ()
    method custom_decode_iter cr () () = cr

    val mutable num_roots : int = 0
    val mutable roots :  custom_tree array = [||]

    method custom_get_iter (path:Gtk.tree_path) : custom_tree option =
      let indices: int array  = GTree.Path.get_indices path in
      match indices with
      | [||] ->
          None
      | _ ->
          if inbound indices.(0) roots then
            let result = ref (roots.(indices.(0))) in
            try
              for depth=1 to Array.length indices - 1 do
                let index = indices.(depth) in
                if inbound index !result.sons then
                  result:=!result.sons.(index)
                else raise Not_found
              done;
              Some !result
            with Not_found ->
              None
          else None

    method custom_get_path (row:custom_tree) : Gtk.tree_path =
      let current_row = ref row in
      let path = ref [] in
      while !current_row.parent <> None do
        path := !current_row.fidx::!path;
        current_row := match !current_row.parent with Some p -> p
        | None -> assert false
      done;
      GTree.Path.create ((!current_row.fidx)::!path)

    method custom_value (t:Gobject.g_type) (row:custom_tree) ~column =
      TREE.custom_value t row.finfo ~column

    method custom_iter_next (row:custom_tree) : custom_tree option =
      let nidx = succ row.fidx in
      match row.parent with
      | None -> if inbound nidx roots then Some roots.(nidx)
        else None
      | Some parent ->
          if inbound nidx parent.sons then
            Some parent.sons.(nidx)
          else None

    method custom_iter_children (rowopt:custom_tree option) :custom_tree option =
      match rowopt with
      | None -> if inbound 0 roots then Some roots.(0) else None
      | Some row -> if inbound 0 row.sons then Some row.sons.(0) else None

    method custom_iter_has_child (row:custom_tree) : bool =
      Array.length row.sons  > 0

    method custom_iter_n_children (rowopt:custom_tree option) : int =
      match rowopt with
      | None -> Array.length roots
      | Some row -> Array.length row.sons

    method custom_iter_nth_child (rowopt:custom_tree option) (n:int)
      : custom_tree option =
      match rowopt with
      | None when inbound n roots -> Some roots.(n)
      | Some row when inbound n row.sons -> Some (row.sons.(n))
      | _ -> None

    method custom_iter_parent (row:custom_tree) : custom_tree option =
      row.parent

    method append_tree (t:TREE.t) =
      let rec make_forest root sons =
        Array.mapi
          (fun i t -> let result = {finfo=t; fidx=i; parent = Some root;
                                    sons = [||] }
           in
           let sons = make_forest result (TREE.sons t) in
           result.sons<-sons;
           result)
          sons
      in
      let pos = num_roots in
      num_roots <- num_roots+1;
      let root = { finfo = t; sons = [||];
                   parent = None;
                   fidx = pos }
      in

      let sons = make_forest root (TREE.sons t)
      in
      root.sons <- sons;
      roots <-
        Array.init num_roots (fun n -> if n = num_roots - 1 then root
                              else roots.(n))

  end

  let custom_tree () =
    new custom_tree_class TREE.column_list
end


  let pix_size = 16
  let pix =
    let f file =
      GdkPixbuf.from_file_at_size file ~width: pix_size ~height: pix_size
    in
    f  Sys.argv.(1)

module T=struct
  type leaf = {mutable checked: bool; mutable lname: string; }
  type t = Leaf of leaf |  Node of string* t list

  let sons t = match t with
  | Leaf _ -> [||]
  | Node (_,s)-> Array.of_list s

  (** The columns in our custom model *)
  let column_list = new GTree.column_list ;;
  let col_file = (column_list#add Gobject.Data.caml: t GTree.column);;
  let col_bool = column_list#add Gobject.Data.boolean;;
  let col_int = column_list#add Gobject.Data.int;;
  let col_is_leaf = column_list#add Gobject.Data.boolean;;
  let col_pb = (column_list#add Gobject.Data.caml: GdkPixbuf.pixbuf GTree.column);;

  let custom_value _ t ~column =
    match column with
    | 0 -> (* col_file *) `CAML (Obj.repr t)
    | 1 -> (* col_bool *) `BOOL false
    | 2 -> (* col_int *) `INT 0
    | 3 -> (* col_is_leaf*) `BOOL (match t with Leaf _ -> true | _ -> false)
    | 4 -> (* col_pb *) `CAML (Obj.repr pix)
    | _ -> assert false

end

module MODEL=MAKE(T)

let nb = ref 0

let make_tree n p =
  let rec aux p0 =
    if p=p0 then
      begin
        incr nb;
        T.Leaf {T.lname = "Leaf "^string_of_int !nb; checked = false}
      end
    else begin
      incr nb;
      let name = "Node "^string_of_int !nb in
      T.Node (name,aux_list n (succ p0))
    end
  and aux_list n p =
    if n = 0 then []
    else aux p::aux_list (n-1) p
  in
  aux 0

let fill_model t =
  for i = 0 to 10000 do
    t#append_tree (make_tree 1 1)
  done



let create_view_and_model () : GTree.view =
  let custom_tree = MODEL.custom_tree () in
  fill_model custom_tree;
  let view = GTree.view ~fixed_height_mode:true ~model:custom_tree () in
  let renderer = GTree.cell_renderer_text [] in
  let col_name = GTree.view_column ~title:"Name" ~renderer:(renderer,[]) () in
  col_name#set_sizing `FIXED;
  col_name#set_fixed_width 150;
  col_name#set_cell_data_func
    renderer
    (fun model row ->
       try
	 let data = model#get ~row ~column:T.col_file in
	 match data with
	 | T.Leaf {T.lname = s} | T.Node (s,_) ->
	     renderer#set_properties [ `TEXT s ];
       with exn ->
	 let s = GtkTree.TreePath.to_string (model#get_path row) in
	 Format.printf "Accessing %s, got '%s' @." s (Printexc.to_string exn));
  ignore (view#append_column col_name);

  let renderer = GTree.cell_renderer_toggle [] in
  let col_tog = GTree.view_column ~title:"Check"
    ~renderer:(renderer,["visible", T.col_is_leaf])
    ()
  in
  col_tog#set_sizing `FIXED;
  col_tog#set_fixed_width 10;
  col_tog#set_cell_data_func
    renderer
    (fun model row ->
       try
	 let data = model#get ~row ~column:T.col_file in
	 match data with
	 | T.Leaf {T.checked = b}  -> renderer#set_properties [ `ACTIVE b ]
         | _ -> ()
       with exn ->
	 let s = GtkTree.TreePath.to_string (model#get_path row) in
	 Format.printf "Accessing %s, got '%s' @." s (Printexc.to_string exn));

  ignore(renderer#connect#toggled
           (fun path ->
              let row = custom_tree#custom_get_iter path in
              match row with
              | Some {MODEL.finfo=T.Leaf l} ->
                  l.T.checked <- not l.T.checked
              | _ -> ()));
  ignore (view#append_column col_tog);

  let pix_renderer = GTree.cell_renderer_pixbuf [] in
  let col_pb = GTree.view_column () ~renderer: (pix_renderer, ["pixbuf",T.col_pb]) in
  col_pb#set_sizing `FIXED;
  col_pb#set_fixed_width 16;
  col_pb#set_cell_data_func
    pix_renderer
    (fun model row ->
       try
	       pix_renderer#set_properties [ `PIXBUF pix ]
       with exn ->
	      let s = GtkTree.TreePath.to_string (model#get_path row) in
	      Format.printf "Accessing %s, got '%s' @." s (Printexc.to_string exn)
	 );

  ignore (view#append_column col_pb);
  view

let _ =
  ignore (GtkMain.Main.init ());
  let window = GWindow.window ~width:200 ~height:400 () in
  ignore
    (window#event#connect#delete
       ~callback:(fun _ -> exit 0));
  let scrollwin = GBin.scrolled_window ~packing:window#add () in
  let view = create_view_and_model () in
  scrollwin#add view#coerce;
  window#show ();
  GtkMain.Main.main ()

--MP_/WY6/Kw9JO_ku0SBvwtMDfc_
Content-Type: text/plain; charset="us-ascii"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Content-Disposition: inline

_______________________________________________
Lablgtk mailing list
Lablgtk@yquem.inria.fr
http://yquem.inria.fr/cgi-bin/mailman/listinfo/lablgtk

--MP_/WY6/Kw9JO_ku0SBvwtMDfc_--