Skip to main content

Multipaned container implemented in Tcl/Gnocl

The Gtk+ widget set contains two widgets, GtkHPaned and GtkVPaned which only allow the insertion of two child widgets. One might suppose that if more items are needed then folding boxed in a scrolling window would be adequate. One alternative, as I have used up to date, is the use of nested double panes.

Implementing a new container widget in C using the Gtk+ libraries is possible, but implementing such an beast in Tcl/Gnocl is somewhat less complex.

Over the past couple of evenings I've put together a proof of concept script to get the bare bones of this this megawidget in place. All seems well, although a little bit of easing on the gnocl source code side of things has helped. To this end I've added the geometry subcommand to the gnocl::fixed widget. The effect of this to allowing a single command to return the position and size of child objects placed in a gnocl:fixed container rather than making two separate calls in the script, one for the (x y) position and the other for (width height) size of the child.

As can be seen from this screenshot my test script my paned is somewhat overpopulated.

To test this out locally, download and install the lastet nightly build from SourceForge.

A click and drag of the mouse pointer on the separator bars sees the height of all of the panes resize correctly in real-time.

The next step is to introduce some minium settings, overlap prevention and collapse-expand double click behavious on the separator.


# mypaned-2.tcl
#!/bin/sh
#\
exec tclsh "$0" "$@"

package require Gnocl

set bar 15
set height 50
set width 200
set i 1
set handle_height 5


#---------------
#
#---------------
#
proc my_paned {} {

    set ::container [gnocl::fixed -onAdd {puts HI}]

    set wid [gnocl::eventBox]  ;#-background red]

    # add the first container
    $::container add $wid -x 0 -y 0 -width $::width -height $::height

    lappend ::panes $wid

    return $::container

}

#---------------
#
#---------------
#
proc _resize_above { handle } {

    set box [gnocl::winfo parent $handle]
    set i [lsearch $::handles $handle]
    set above [lindex $::panes $i]
   
    set w [lindex [gnocl::winfo geometry $box] 2]

    # get and process geometry
    foreach {ax ay aw ah} [$box geometry $above] {}
    foreach {hx hy} [$box position $handle] {}

if 0 {
        +---------------+ ay
        |               |
        |     ABOVE     | new height = hy - ay
        |               |
        +---------------+ hy
        |     HANDLE    |
        +---------------+  
}

    $box move $above -x $ax -y $ay -width $aw -height [expr $hy -$ay]
       
}

#---------------
#
#---------------
#
proc _resize_below { handle } {

    set box [gnocl::winfo parent $handle]
    set i [lsearch $::handles $handle]
    set below [lindex $::panes [incr i] ]

    # get and process geometry
    foreach {bx by bw bh} [$box geometry $below] {}
    foreach {hx hy hw hh} [$box geometry $handle] {}

if 0 {
        +---------------+ hy
        |     HANDLE    |
        +---------------+ hy+hh = by
        |               |
        |     BELOW     | new height = (by+bh) - (hy+hh)
        |               |
        +---------------+ by+bh 

}
    $box move $below -x $bx -y [expr $hy + $hh] -width $hw -height [expr ($by+$bh) - ($hy+$hh)]
       
}

#---------------
#
#---------------
#
proc move_handle { handle } {

    # get container
    set box [gnocl::winfo parent $handle]

    # move handle
    set hy1 [_pointer_ypos $handle]
    foreach {hw hh} [$box size $handle] {}
    $box move $handle -x 0 -y [_pointer_ypos $handle] -width $hw -height $hh

    _resize_above $handle
    _resize_below $handle   
       
}

#---------------
#
#---------------
#
proc _pointer_ypos { w } {
    return [expr [lindex [gnocl::winfo pointer [gnocl::winfo toplevel "$w"]] 1] -5]
}


#---------------
#
#---------------
#
proc adjust {w} {
    set i [lsearch $::handles $w]
    set l [expr [llength $::handles] -1]


    set ret "[expr $i] [expr $i+1]" 
       
    return $ret
}

#---------------
#
#---------------
#
proc add_handle { y } {
   
    set wid [ gnocl::eventBox ]
    $wid configure -child [ gnocl::separator ]
   
    set parent [gnocl::winfo parent $::container]
    foreach {a b width c} [gnocl::winfo geometry $parent] {}
   
    set y [expr $y -$::handle_height]
   
    $::container add $wid -x 0 -y $y -width $width -height $::handle_height   

    lappend ::handles $wid
   
    $wid configure -onMotion { move_handle %w }
       
}

#---------------
#
#---------------
#
proc add_pane { } {
   
    set lpane [lindex $::panes end]
   
    foreach {a y w h} [$::container geometry $lpane] {}
   
    set y [expr $y + $h +$::handle_height]
    set wid [gnocl::eventBox ]
   
    $::container add $wid -x 0 -y $y -width $w -height $h

    add_handle $y
   
    incr ::i
   
    lappend ::panes $wid
   
}

#---------------
# test-block
#---------------
#

set paned [my_paned]

gnocl::window -child $paned -height 600 -width 300

add_pane
add_pane
add_pane
add_pane
add_pane
add_pane
add_pane
add_pane

set txt(1) [gnocl::text -wrapMode word] ; $txt(1) lorem
set txt(2) [gnocl::text -wrapMode word] ; $txt(2) lorem
set txt(3) [gnocl::text -wrapMode word] ; $txt(3) lorem
set txt(4) [gnocl::text -wrapMode word] ; $txt(4) lorem

[lindex $panes 0] configure -child $txt(1)
[lindex $panes 1] configure -child [gnocl::label -text ONE]
[lindex $panes 2] configure -child [gnocl::label -text TWO]
[lindex $panes 3] configure -child $txt(2)
[lindex $panes 4] configure -child [gnocl::label -text FOUR]
[lindex $panes 5] configure -child [gnocl::label -text FIVE]
[lindex $panes 6] configure -child $txt(3)
[lindex $panes 7] configure -child [gnocl::label -text SIX]
[lindex $panes 8] configure -child $txt(4)

Comments

Popular posts from this blog

Simple Runtime Debugging Message Dialog

At times it's useful to see what values variables hold, or offer some pause point before the code goes elsewhere before causing havoc. Its possible to write output to the terminal but this can get lost in copious forms of other outputs, besides, there's no pausing the script execution either. The following proc creates a custom dialog which displays ad message along with the point in the calling script from which it was invoked. ## simple runtime debugging feedback dialog, alternative to console based gnocl::msg # @param msg message to display # @returns none # proc xxx::msg {txt} { set frame [info frame -1] append msg "Message:\n\n" append msg " $txt \n\n\n" append msg "Called from:\n\n" append msg "Proc:\t[lindex [info level -1] 0]\n" append msg "File:\t[file tail [dict get $frame file]]\n" append msg "Line:\t[dict get $frame line]\n" gnocl::dialog \ -type info \ -text $msg

Creating a button box with right aligned widgets

The dialog widget has its own internal functionaluty to create and position buttons at the bottom right corner of the window container. When creating these for ourselves it must be born in mind that default settings for fill and expand are both 0.5. Failing to set these will always place the child objects in the centre, regardless of alignment. For most cases these defaults are acceptable but, to create that dialog-button arrangement, use the following snippet as a model!   # to right align completely, set expand and fill to 0 set hbox [gnocl::hBox] set b1 [gnocl::button -text Select \                -data $lst                 -onClicked { puts DO-SOMETHING-WITH-%d} ] set b2 [gnocl::button -text Cancel -onClicked { puts DONE! } ] $vbox add $hbox -expand 0 -fill 0 -align right $hbox add $b1 $hbox add $b2

Changing Namespaces

I've been toying with the idea of changing the namespace used by gnocl, to something simplier, a proposition much more appealing now that I've begun migration to Gtk3 and soon to Gtk4. The changes from Gtk2 to Gtk4 will be subtantial due to many chages occuring within the Gtk api. Before committing myself, I thought how it would be useful to swap namespaces on the fly. So, here's a first quick solution:   package require -exact Gnocl 0.9.96 proc xxxx {ns1 ns2}  {     namespace eval ::${ns2} {}     set map [list $ns1 $ns2]          foreach type {commands vars procs } {         foreach item [info $type ${ns1}::*] {             set err ""             catch { rename $item [string map $map $item] } err             if { $err != "" } { puts $err }         }     }          namespace delete $ns1 } xxxx g set b1 [g::button -text BUTTON] set w1 [g::window -child $b1] set l1 [g::label -text rename] $w1 configure -child $l1 -title TEST