Tcl Source Code

Artifact 1309a8c0852ea56c8077b1b32abad169e4f2a70e:

Attachment "dicttest.tcl" to ticket [1938032fff] added by beric 2008-04-09 01:34:31.

---

package require TclOO


oo::class create Component {

    # ----------------------------------------------------------------------
    #  Component::constructor --
    #
    # ----------------------------------------------------------------------
    constructor {name type childs} {
        my variable mName mType mChilds
        set mName $name
        set mType $type
        set mChilds $childs
    }

    # ----------------------------------------------------------------------
    #  Component::refresh --
    #
    # ----------------------------------------------------------------------
    method refresh {canvas params} {
        my variable mName mChilds
        set paramsChild $params
        
        set padding 25
        dict incr paramsChild level 
        dict incr paramsChild y $padding
        dict incr paramsChild x $padding

        foreach child $mChilds {
            set resultChild [$child refresh $canvas $paramsChild]
            dict incr paramsChild y [expr { $padding + [dict get $resultChild h] }]
            dict with params {
                if { $w + $x < [dict get $resultChild w] + [dict get $resultChild x] } {
                    set w [expr {[dict get $resultChild w] + [dict get $resultChild x] - $x}]
                }
                if { $h + $y < [dict get $resultChild h] + [dict get $resultChild y] } {
                    set h [expr {[dict get $resultChild h] + [dict get $resultChild y] - $y}]
                }
                incr h $padding
            }
        }
        dict incr params w $padding
        
        return $params
    }
    
    # ----------------------------------------------------------------------
    #  Component::destructor --
    #
    # ----------------------------------------------------------------------
    destructor {
    }
}


set a [Component new "name" "type" {}]
set b [Component new "name" "type" [list $a]]
set c [Component new "name" "type" [list $b $b]]

set p [$c refresh c {level 0 x 0 y 0 w 10 h 20}]
puts $p