ulis, 2006-11-17. Un package rapidement hacké pour faire des panneaux empilés.
Pourquoi
Pour 'mettre au propre' le megawidget panes de Tk par l'exemple - le megawidget panes.
C'est aussi pour comparer l'effort entre une procédure (50 lignes) et un package (500 lignes).
Comment
Voir Tk par l'exemple - le megawidget panes.
Utilisation
stackedpanes .sp -titles {firefox opera iexplorer}
# ====================================
# options :
#
# - toutes les options du frame, plus
# -button commande pour créer un bouton (commande 'button')
# -count nombre de panneaux (aucun bouton visible)
# -orient orientation (horizontal ou vertical)
# -pane commande pour créer un panneau (commande 'frame')
# -titles liste des titres des boutons (si visibles)
#
# - toutes les options des boutons sous la forme :
# -b:option valeur (donne la valeur à cette option pour tous les boutons)
# -b($n):option valeur (donne la valeur à cette option pour le bouton $n)
#
# - toutes les options des panneaux sous la forme :
# -p:option valeur (donne la valeur à cette option pour tous les panneaux)
# -p($n):option valeur (donne la valeur à cette option pour le panneau $n)
# ------------------------------------
# opérations :
#
# cget : retourne la valeur d'une option
# create : crée un widget panes
# configure : modifie les valeurs des options
# get : retourne une valeur par défaut
# set : modifie des valeurs par défaut
# ------------------------------------
# sous-widgets
#
# $w.b($n) (le bouton $n)
# $w.p($n) (le panneau $n)
# ====================================Configuration
Installation
Utilisation
package require StackedPanes
Le package StackedPanes
if {[info exists ::stackedpanes::version]} { return }
namespace eval ::stackedpanes \
{
# #############################
#
# package (Staked)Panes
#
variable version 1.0
#
# (C) ulis, 2006
# Licence NOL (No Obligation Licence)
#
# ====================================
# options :
#
# - toutes les options du frame, plus
# -button commande pour créer un bouton (commande 'button')
# -count nombre de panneaux (aucun bouton visible)
# -orient orientation (horizontal ou vertical)
# -pane commande pour créer un panneau (commande 'frame')
# -titles liste des titres des boutons (si visibles)
#
# - toutes les options des boutons sous la forme :
# -b:option valeur (donne la valeur à cette option pour tous les boutons)
# -b($n):option valeur (donne la valeur à cette option pour le bouton $n)
#
# - toutes les options des panneaux sous la forme :
# -p:option valeur (donne la valeur à cette option pour tous les panneaux)
# -p($n):option valeur (donne la valeur à cette option pour le panneau $n)
# ------------------------------------
# opérations :
#
# cget : retourne la valeur d'une option
# create : crée un widget panes
# configure : modifie les valeurs des options
# get : retourne une valeur par défaut
# set : modifie des valeurs par défaut
# ------------------------------------
# sous-widgets
#
# $w.b($n) (le bouton $n)
# $w.p($n) (le panneau $n)
# ====================================
# #############################
##########################
#
# entry point
#
##########################
namespace export stackedpanes
##########################
#
# package
#
##########################
package require Tk 8.4
package provide StackedPanes $version
##########################
#
# globals
#
##########################
variable {}
variable options
set w ._stackedpanes_
frame $w
set options [list -bd -bg]
foreach option [$w config] \
{
if {[llength $option] == 5} \
{
foreach {key - - - value} $option break
if {[string match *color $key] || [string match *ground $key]} \
{
foreach {r g b} [winfo rgb . $value] break
foreach c {r g b} \
{ set $c [expr [set $c] & 255] }
set value [format #%2.2x%2.2x%2.2x $r $g $b]
}
switch -glob -- $key \
{
-padx -
-pady {}
-high* { set key [string range $key 0 10]* }
default { set key [string range $key 0 3]* }
}
array set {} [list $key $value]
lappend options $key
}
}
destroy $w
unset w
array set {} \
{
:-button button
:-count 0
:-height 200
:-orient horizontal
:-pane frame
:-relief ridge
:-titles {"1" "2"}
:-width 150
}
##########################
#
# panes proc
#
##########################
proc stackedpanes {{oper {}} args} \
{
set code [catch \
{
if {$oper == ""} \
{ error "panes operations are create, get or set" }
switch -glob -- $oper \
{
cre* { uplevel 1 ::stackedpanes::panes:create $args }
get { uplevel 1 ::stackedpanes::panes:get $args }
set { uplevel 1 ::stackedpanes::panes:set $args }
default \
{
if {[string match .* $oper]} \
{ uplevel 1 ::stackedpanes::panes:create $oper $args } \
else \
{ error "unknown panes operation '$oper'" }
}
}
} result]
return -code $code $result
}
##########################
#
# panes:get proc
#
##########################
proc panes:get {args} \
{
variable {}
variable options
if {[llength $args] != 1} \
{ error "use is 'panes get -option'" }
set key [lindex $args 0]
switch -glob -- $key \
{
-but* { set $(:-button) }
-cou* { set $(:-count) }
-hei* { set $(:-height) }
-ori* { set $(:-orient) }
-pan* { set $(:-pane) }
-rel* { set $(:-relief) }
-tit* { set $(:-titles) }
-wid* { set $(:-width) }
default \
{
if {[set n [lsearch -glob $options $key]] > -1} \
{
switch -- $key \
{
-bd { set (:-bor*) }
-bg { set (:-bac*) }
default { set (:[lindex $options $n]) }
}
} \
else \
{ error "unknown panes option '$key'" }
}
}
}
##########################
#
# panes:set proc
#
##########################
proc panes:set {args} \
{
variable {}
variable options
if {[llength $args] % 2 != 0} \
{ error "use is 'panes set ?-option value?...'" }
foreach {key value} $args \
{
switch -glob -- $key \
{
-but* { set $(:-button) $value }
-cou* { check:count "" $value }
-ori* { check:orient "" $value }
-pan* { set $(:-pane) $value }
-tit* { set (:-titles) $value }
default \
{
if {[lsearch -glob $options $key] > -1} \
{
switch -- $key \
{
-bd { set (:-bor*) $value }
-bg { set (:-bac*) $value }
default { set (:[lindex $options $n]) $value }
}
} \
else \
{ error "unknown panes option '$key'" }
}
}
}
}
##########################
#
# panes:create proc
#
##########################
proc panes:create {{w ""} args} \
{
variable {}
# default values
set defaults [list]
foreach name [array names {} :-*] \
{ lappend defaults [lindex [split $name :] 1] $($name) }
# create panes
frame $w -class Panes
$w config
canvas $w.c -bd 1 -highlightt 0
canvas $w.cc -bd 0 -highlightt 0
grid rowconfig $w 1000 -weight 1
grid columnconf $w 1000 -weight 1
grid $w.c -row 1 -column 1 -sticky nsew \
-rowspan 1000 -columnspan 1000
# create reference
rename $w ::stackedpanes::_$w
interp alias {} ::$w {} ::stackedpanes::panes:dispatch $w
# configure
set ($w:-orient) horizontal
set ($w:-titles) {}
set ($w:-count) 0
set ($w:count) 0
eval ::stackedpanes::panes:config $w $defaults
eval ::stackedpanes::panes:config $w $args
# select first
::stackedpanes::panes:select $w 0
# return reference
return $w
}
##########################
#
# panes:dispatch proc
#
##########################
proc panes:dispatch {w {oper ""} args} \
{
set code [catch \
{
if {$oper == ""} \
{ error "pane $w operations are cget, configure or select" }
switch -glob -- $oper \
{
cge* { uplevel 1 ::stackedpanes::panes:cget $w $args }
con* { uplevel 1 ::stackedpanes::panes:config $w $args }
sel* { uplevel 1 ::stackedpanes::panes:select $w $args }
default \
{ error "unknown pane operation '$oper'" }
}
} result]
return -code $code $result
}
##########################
#
# panes:cget proc
#
##########################
proc panes:cget {w args} \
{
variable {}
variable options
if {[llength $args] != 1} \
{ error "use is '$w cget -option'" }
set key [lindex $args 0]
switch -glob -- $key \
{
-but* { set ($w:-button) }
-hei* { set ($w:-height) }
-ori* { set ($w:-orient) }
-pan* { set ($w:-pane) }
-rel* { set ($w:-relief) }
-tit* { set ($w:-titles) }
-wid* { set ($w:-width) }
default \
{
if {[set n [lsearch -glob $options $key]] > -1} \
{ ::stackedpanes::_$w cget $key }
else \
{ error "unknown panes option '$key'" }
}
}
}
##########################
#
# panes:config proc
#
##########################
proc panes:config {w args} \
{
variable {}
variable options
if {[llength $args] % 2 != 0} \
{ error "use is '$w config ?-option value?...'" }
set fdraw 0
set ioptions [list]
foreach {key value} $args \
{
switch -glob -- $key \
{
-*:* { lappend ioptions $key $value }
-but* { set ($w:-button) $value }
-cou* \
{
check:count $w $value
set ($w:titles) 0
set fdraw 1
}
-hei* { $w.c config -height $value }
-ori* \
{
check:orient $w $value
set fdraw 1
}
-pan* { set ($w:-pane) $value }
-rel* { $w.c config -relief $value }
-tit* \
{
set ($w:-titles) $value
set ($w:titles) [llength $value]
set fdraw 1
}
-wid* { $w.c config -width $value }
default \
{
if {[lsearch -glob $options $key] > -1} \
{ ::stackedpanes::_$w config $key $value } \
else \
{ error "unknown panes option '$key'" }
}
}
}
if {$fdraw} { draw:panes $w }
eval item:config $w $ioptions
}
##########################
#
# panes:select proc
#
##########################
proc panes:select {w args} \
{
variable {}
switch [llength $args] \
{
0 \
{ return $($w:selected)}
1 \
{
set n [lindex $args 0]
incr n 0
set count [llength $($w:-titles)]
if {$n < 0 || $n > $count - 1} \
{ error "index '$n' is out of range" }
if {[winfo exists $w.b($n)]} \
{
set dim3 width; set dim4 height; set relx 0.0; set rely 1.0; set x -2; set y 2
if {$($w:-orient) == "vertical"} \
{ set dim3 height; set dim4 width; set relx 1.0; set rely 0.0; set x 2; set y -2 }
set dim [winfo $dim3 $w.b($n)]
incr dim -3
$w.cc config -$dim3 $dim -$dim4 2 -bg [$w.p($n) cget -bg]
place $w.cc -in $w.b($n) -x $x -y $y -relx $relx -rely $rely
raise $w.cc
}
raise $w.p($n)
set ($w:selected) $n
}
default \
{ error "use is '$w select count'" }
}
}
##########################
#
# draw:panes proc
#
##########################
proc draw:panes {w} \
{
variable {}
set titles $($w:-titles)
set oldcount $($w:count)
set butcount $($w:titles)
set newcount $butcount
if {$newcount == 0} { set newcount $($w:-count) }
set ($w:count) $newcount
set mincount $oldcount
if {$mincount > $newcount} { set mincount $newcount }
set maxcount $oldcount
if {$maxcount < $newcount} { set maxcount $newcount }
set dim1 row; set dim2 column
if {$($w:-orient) == "vertical"} \
{ set dim1 column; set dim2 row }
for {set n 0} {$n < $mincount} {incr n} \
{
if {$butcount == 0 && [winfo exists $w.b($n)]} \
{ destroy $w.b($n) } \
elseif {![winfo exists $w.b($n)]} \
{
$($w:-button) $w.b($n) -bd 1 -relief ridge \
-text [lindex $titles $n] \
-command [list ::stackedpanes::panes:select $w $n]
grid $w.b($n) -$dim1 0 -$dim2 [expr {$n + 1}]
} \
else \
{
$w.b($n) config -text [lindex $titles $n]
grid $w.b($n) -$dim1 0 -$dim2 [expr {$n + 1}]
}
grid $w.p($n) -row 1 -column 1 -sticky nsew \
-rowspan 1000 -columnspan 1000 -padx 1 -pady 1
}
for {set n $mincount} {$n < $maxcount} {incr n} \
{
if {$newcount > $mincount} \
{
if {![winfo exists $w.b($n)]} \
{
$($w:-button) $w.b($n) -bd 1 -relief ridge \
-text [lindex $titles $n] \
-command [list ::stackedpanes::panes:select $w $n]
grid $w.b($n) -$dim1 0 -$dim2 [expr {$n + 1}]
} \
else \
{
$w.b($n) config -text [lindex $titles $n]
grid $w.b($n) -$dim1 0 -$dim2 [expr {$n + 1}]
}
if {![winfo exists $w.p($n)]} \
{
$($w:-pane) $w.p($n)
grid $w.p($n) -row 1 -column 1 -sticky nsew \
-rowspan 1000 -columnspan 1000 -padx 1 -pady 1
} \
else \
{
grid $w.p($n) -row 1 -column 1 -sticky nsew \
-rowspan 1000 -columnspan 1000
}
} \
else \
{
if {[winfo exists $w.b($n)]} \
{ destroy $w.b($n) }
destroy $w.p($n)
}
}
}
##########################
#
# item:config proc
#
##########################
proc item:config {w args} \
{
variable {}
set count $($w:count)
foreach {key value} $args \
{
foreach {type n option} [item:option $key] break
if {$n == ""} \
{
for {set n 0} {$n < $count} {incr n} \
{ $w.${type}($n) config -$option $value }
} \
else \
{
if {$n < 0 || $n > $count - 1} \
{ error "index in '$key' is out of range" }
$w.${type}($n) config -$option $value
}
}
}
proc item:option {key} \
{
set items [split $key -:()]
set id ""
if {[llength $items] == 3} \
{ foreach {- type option} $items break } \
else \
{ foreach {- type id - option} $items break }
return [list $type $id $option]
}
##########################
#
# check procs
#
##########################
proc check:int {value} \
{
set x 0
incr x $value
}
proc check:color {w key value} \
{
variable {}
if {$value != "" && [catch { winfo rgb . $value }]} \
{ error "bad $key value '$value'" }
set ($w:$key) $value
}
proc check:count {w value} \
{
variable {}
if {![string is integer -strict $value] || $value < 0} \
{ error "bad -count value '$value'" }
set ($w:-count) $value
}
proc check:orient {w value} \
{
variable {}
switch -glob -- $value \
{
hor* { set ($w:-orient) horizontal }
ver* { set ($w:-orient) vertical }
default \
{ error "bad -orient value '$value'" }
}
}
}
namespace import ::stackedpanes::stackedpanesScript de description pkgIndex.tcl
package ifneeded StackedPanes 1.0 [list source [file join $dir StackedPanes.tcl]]
La démo
package require StackedPanes
. config -padx 10 -pady 10
set titles {firefox iexplorer opera}
set colors {#fee #eef #efe}
set w .sp
stackedpanes $w -titles $titles -orient vert -b:width 8 -b:height 5
set n -1
foreach title $titles color $colors \
{
incr n
$w config -p($n):bg $color -b($n):bg $color
label $w.p($n).l -text $title -bg $color
grid $w.p($n).l
}
grid $w
after 1 $w select 0
after 2000 [list $w select 2]
after 4000 [list $w config -orient horiz -b:height 1]
after 4001 [list $w select 1]
after 6000 [list $w config -count 2]
after 6001 [list $w select 1]
after 7000 [list $w select 0]Voir aussi
Discussion
Catégorie Paquet | Catégorie Interface utilisateur