namespace eval ::monster::wmu {}

# wdropdown  whichWindow  parentWindow  ?options?
#
# Places window "near" another window, with the meaning of "near"
# depending on options:
# 
# -dimensions {requested|parent|current|<integer>}
# -width {requested|parent|current|<integer>}
# -height {requested|parent|current|<integer>}
#    these options determine the new size of the dropdown window.
#    -dimensions is generic, may be overridden by -width and -height 
#    requested = use winfo reqwidth/reqheight, 
#    current = use winfo width/height,
#    parent = equal to parent's width/height,
#    <integer> = size in pixels
#
# -direction gives a direction, similar to BWidget/utils.tcl
#    below / above / left / right
#
# -distance gives the amount of pixels that must be left between
#    the closest edges of the dropdown window and the parent (0=default,
#    that means that the dropdown will "touch" the parent).
#    Negative distance may be used to make the dropdown window overlap
#    the parent (1-2 pixels is often desirable for combobox)
#
# -fixed 
#    left|right for below/above, top|bottom for left/right direction
#    If the dropdown window is of another size than its parent,
#    this option determines WHICH edge of the child window will
#    be 'attached' to THE SIMILAR edge of the parent.
#
# -return xywh|ltrb|geometry
#    don't move/resize window, return the calculated geometry instead:
#       xywh - return [list x y width height]
#       ltrb - return [list left top right bottom]
#       geometry - return WxH+X+Y 
#
# If there's NO REAL PARENT WIDGET, only a point or rectangle,
# the parent argument may be a list of 2 or 4 values,
# {x y} for points and {left top right bottom} for rectangles.
#
proc ::monster::wmu::wdropdown {path parent args} {
    array set opts {-return {} -dimensions {requested} -direction below}
    array set opts $args
    set reversematrix 0
    lassign [
        switch -exact -- $opts(-direction) {
            below { list vertical 0 left }
            above { list vertical 1 left }
            left { list horizontal 1 top }
            right { list horizontal 0 top }
        } ] \
        opts(-orient) reversematrix deffixed
    if {![info exists opts(-fixed)]} { set opts(-fixed) $deffixed }
    set mtxlist [DropdownMatrices [array get opts]]
    if {$reversematrix} {
        set mtxlist [list [lindex $mtxlist 1] [lindex $mtxlist 0]]
    }
    if {[winfo exists $parent]} {
        set L [winfo rootx $parent]
        set T [winfo rooty $parent]
        set R [expr {$L+[winfo width $parent]-1}]
        set B [expr {$T+[winfo height $parent]-1}]
    } else {
        if {[llength $parent] == 2} {
            lassign $parent L T 
            lassign $parent R B 
        } else {
            lassign $parent L T R B
        }
    }
    foreach dim {width height} {
        if {[info exists opts(-$dim)]} {
            set algo $opts(-$dim)
        } else {
            set algo $opts(-dimensions)
        }
        if {[string is integer $algo]} {
            set value $algo
        } else {
            switch -exact -- $algo {
                requested {set value [winfo req$dim $path] }
                current {set value [winfo $dim $path] }
                parent {set value [winfo $dim $parent] }
                default {
                    return -code error \
                    "Bad dimension specifier $algo: \
                    should be requested, current, parent or INTEGER."
                }
            }
        }
        set REQ($dim) $value
    }
    set rect [DropdownBestRectangle $mtxlist $L $T $R $B \
            [winfo screenwidth $parent] \
            [winfo screenheight $parent] \
            $REQ(width) $REQ(height) ]
    lassign $rect cL cT cR cB
    set cW [expr {$cR-$cL+1}]
    set cH [expr {$cB-$cT+1}]
    switch -exact -- $opts(-return) {
        {}   {wm geometry $path ${cW}x${cH}+$cL+$cT}
        geometry {return ${cW}x${cH}+$cL+$cT}
        xywh     {return [list $cL $cT $cW $cH]}
        ltrb     {return [list $cL $cT $cR $cB]}
        default  {return -code error "Bad -return: must be geometry, xywh or ltrb"}
    }
}

# Really deep magic workhorse procedure that calculates a best 
# position for a window that should be shown "near" another window
#
# It takes the list of placement matrices to select the best one of them
# to apply, L-T-R-B rectangle of the parent window, screen width
# and height and requested child width and height.
#
# Returns a L-T-R-B rectangle of the child window, adjusted so 
# the window will be totally visible.
#
# Placement matrix layout:
#   matrix ::= [list $xMatrix $yMatrix]
#   xMatrix ::= [list $qParentLeft $qParentRight $qChildW $offsetX]
#   yMatrix ::= [list $qParentTop $qParentBottom $qChildH $offsetY]
# Placement matrix application:
#   x(child) = left(parent)*qParentLeft + right(parent)*qParentRight +
#              + width(child)*qChildW + offsetX
#   y(child) = top(parent)*qParentTop + bottom(parent)*qParentBottom +
#              + height(child)*qChildH + offsetY
#
# Algorithm details:
#
# For each matrix and each coordinate, an "offence" value is calculated.
# The "offence" is > 0 when a calculated rectangle of a child window
# crosses the screen boundaries. Then the matrix with the minimal 
# overall (x+y) "offence" is selected, and the children's coordinates
# are adjusted to prevent crossing the screen.
#
# If all matrices produce the same offence (offence=0 is the common case),
# the first matrix is chosen.

proc ::monster::wmu::DropdownBestRectangle {
    matrices L T R B screenw screenh childw childh
}   {
    set priority 0
    foreach matrix $matrices {
        set dims [list]
        set coords [list]
        set overall_offence 0
        foreach \
            row $matrix \
            mults [list [list $L $R $childw 1] [list $T $B $childh 1]] \
            limit [list $screenw $screenh] \
            size [list $childw $childh] \
            {
            set coord 0
            foreach q $row d $mults {incr coord [expr {$q*$d}]}
            set offence_toofar [expr {$coord+$size-$limit}]
            if {$offence_toofar<0} {set offence_toofar $priority}
            set offence_negative [expr {$coord<0? -$coord:$priority}]
            set offence [expr {$offence_toofar+$offence_negative}]
            incr overall_offence $offence
            if {$offence > 1} {
                lassign $row d0 d1 d2
                set shrink [expr \
                    {!(($d0==1 &&$d1==0 &&$d2==0)||
                    ($d0==0&&$d1==-1&&$d2==1))}]
                if {$coord<0} {
                    if {$shrink} {
                        incr size $coord
                    }
                    set coord 0
                }
                if {$offence_toofar>1} {
                    if {$shrink} {
                        set size [expr {$size-$offence_toofar}]
                    } else {
                        set coord [expr {$coord-$offence_toofar}]
                    }
                }
            }
            lappend coords $coord
            lappend dims $size
        }
        lappend xycoords $coords
        lappend xydims $dims
        lappend xyoffences $overall_offence
        if {!$overall_offence} {break} 
        incr priority
    }
    set index [expr {[lindex $xyoffences end]<[lindex $xyoffences 0]}]
    lassign [lindex $xycoords $index] x y
    lassign [lindex $xydims $index] w h
    return [list $x $y [expr {$x+$w-1}] [expr {$y+$h-1}]]
}

# Turns human-readable options for dropdown placement 
# into matrix list for DropdownBestRectangle.
#
# -orient vertical: for combobox dropdown list.
# -orient horizontal: for submenu of a normal/tearoff menu
# -fixed {left|right} for vertical, {top|bottom} for horizontal: 
#   which edge of the child window will go at the same coordinate
#   as the same edge of its parents. I've seen comboboxes where
#   left,right or both edges were 'fixed'.
# 
# DropdownBestRectangle look at the -orient (well, really at the matrix)
# when adjusting a child window: the window will be SHRUNK if the axis
# that must be adjusted is PARALLEL to -orient, otherwise it will be MOVED.
# Thus e.g. the combobox may shrink vertically, but not horizontally.

proc ::monster::wmu::DropdownMatrices {{optList {}}} {
    array set opts {-fixed left -orient vertical -distance 0}
    array set opts $optList
    switch -exact -- $opts(-fixed).$opts(-orient) {
        left.vertical {
            set m {{{1 0 0 0} {0 1 0 0}} {{1 0 0 0} {1 0 -1 0}}}
        }
        right.vertical {
            set m {{{0 1 -1 0} {0 1 0 0}} {{0 1 -1 0} {1 0 -1 0}}}
        }
        top.horizontal {
            set m {{{0 1 0 0} {1 0 0 0}} {{1 0 -1 0} {1 0 0 0}}}
        }
        bottom.horizontal {
            set m {{{0 1 0 0} {0 1 -1 0}} {{1 0 -1 0} {0 1 -1 0}}}
        }
    }
    if {$opts(-distance)} {
        set is_vertical [expr {$opts(-orient) eq "vertical"? 1 : 0 }]
        lset m 0   $is_vertical end $opts(-distance)
        lset m end $is_vertical end [expr {-$opts(-distance)}]
    }
    return $m
}

# Forward-compatible lassign
if {[info commands lassign]==""} {
    proc lassign {list args} {
        foreach item $list var $args {
            if {$var eq ""} {break}
            upvar 1 $var v
            set v $item
        }
        lrange $list [llength $args] end
    }
}

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References