diff options
| -rw-r--r-- | colorpicker.tcl | 281 | ||||
| -rw-r--r-- | properties.tcl | 423 |
2 files changed, 704 insertions, 0 deletions
diff --git a/colorpicker.tcl b/colorpicker.tcl new file mode 100644 index 0000000..0c433cb --- /dev/null +++ b/colorpicker.tcl @@ -0,0 +1,281 @@ +if {[info exists ::colorpicker::version]} {return} +namespace eval ::colorpicker { + namespace export colorpicker + # ========================================= + # colorpicker + set version 0.1 + # (C) 2009 - Federico Ferri + # mescalinum (at) gmail (dot) com + # + # Released under GPL-3 license: + # http://www.gnu.org/licenses/gpl-3.0.html + # ========================================= + package provide colorpicker $version + + variable presets { + ffffff dfdfdf bbbbbb ffc7c6 ffe3c6 + feffc6 c6ffc7 c6feff c7c6ff e3c6ff + 9f9f9f 7c7c7c 606060 ff0400 ff8300 + faff00 00ff04 00faff 0400ff 9c00ff + 404040 202020 000000 551312 553512 + 535512 0f4710 0e4345 131255 2f004d + } + + proc colorpicker {w mode args} { + variable {} + set modes {switches hsv} + if {[lsearch -exact $modes $mode] == -1} { + error "bad mode: $mode. must be one of: $modes." + } + set ($w:mode) $mode + set ($w:color) "#000000" + set ($w:command) {} + set ($w:textvar) {} + frame $w + init_$mode $w + rename $w ::colorpicker::_$w + interp alias {} $w {} ::colorpicker::dispatch $w + if {$args != {}} {uplevel 1 ::colorpicker::config $w $args} + return $w + } + + proc dispatch {w cmd args} { + variable {} + switch -glob -- $cmd { + get {set ($w:color)} + set {uplevel 1 [linsert $args 0 ::colorpicker::set_color_ext $w]} + con* {uplevel 1 [linsert $args 0 ::colorpicker::config $w]} + default {uplevel 1 [linsert $args 0 ::colorpicker::_$w $cmd]} + } + } + + proc config {w args} { + variable {} + set options {} + set flag 0 + foreach {key value} $args { + switch -glob -- $key { + -com* { + set ($w:command) $value + set flag 1 + } + -textvar* { + set ($w:textvar) $value + set flag 1 + } + default { lappend options $key $value } + } + } + if {!$flag || $options != ""} { + uplevel 1 [linsert $options 0 ::scrolledframe::_$w config] + } + } + + proc set_color_ext {w c} { + # called by the widget public method + variable {} + set c [string tolower $c] + if {![regexp {^#[0-9a-f]{6,6}$} $c]} { + error "Invalid color: $c. Specify a color in the format #HHHHHH" + } + switch -exact -- $($w:mode) { + switches { + set_color $w $c + } + hsv { + set r [expr 0x[string range $c 1 2]] + set g [expr 0x[string range $c 3 4]] + set b [expr 0x[string range $c 5 6]] + set hsv [rgbToHsv $r $g $b] + hsv_set $w h [lindex $hsv 0] + hsv_set $w s [lindex $hsv 1] + hsv_set $w v [lindex $hsv 2] + set_color $w $c + } + } + } + + proc set_color {w c} { + # called internally in reaction to events + variable {} + set c [string tolower $c] + set ($w:color) $c + if {$($w:command) != {}} { + set cmd $($w:command) + lappend cmd $c + uplevel #0 $cmd + } + if {$($w:textvar) != {}} { + uplevel #0 [list set $($w:textvar) $c] + } + switch -exact -- $($w:mode) { + switches { + variable presets + set q 0 + for {set row 0} {$row < 3} {incr row} { + for {set col 0} {$col < 10} {incr col} { + set b [expr {$c == "#[lindex $presets $q]"}] + ${w}.r${row}c${col} configure \ + -relief [lindex {raised sunken} $b] + incr q + } + } + } + hsv { + } + } + } + + proc mkColor {rgb} { + set r [lindex $rgb 0]; set g [lindex $rgb 1]; set b [lindex $rgb 2] + if {$r < 0} {set r 0} elseif {$r > 255} {set r 255} + if {$g < 0} {set g 0} elseif {$g > 255} {set g 255} + if {$b < 0} {set b 0} elseif {$b > 255} {set b 255} + return #[format "%2.2x%2.2x%2.2x" $r $g $b] + } + + proc rgbToHsv {r g b} { + set sorted [lsort -real [list $r $g $b]] + set temp [lindex $sorted 0] + set v [lindex $sorted 2] + set value $v + set bottom [expr {$v-$temp}] + if {$bottom == 0} { + set hue 0 + set saturation 0 + set value $v + } else { + if {$v == $r} { + set top [expr {$g-$b}] + if {$g >= $b} { + set angle 0 + } else { + set angle 360 + } + } elseif {$v == $g} { + set top [expr {$b-$r}] + set angle 120 + } elseif {$v == $b} { + set top [expr {$r-$g}] + set angle 240 + } + set hue [expr {round(60*(double($top)/$bottom)+$angle)}] + } + if {$v == 0} { + set saturation 0 + } else { + set saturation [expr {round(255-255*(double($temp)/$v))}] + } + return [list $hue $saturation $value] + } + + proc hsvToRgb {h s v} { + set hi [expr {int(double($h)/60)%6}] + set f [expr {double($h)/60-$hi}] + set s [expr {double($s)/255}] + set v [expr {double($v)/255}] + set p [expr {double($v)*(1-$s)}] + set q [expr {double($v)*(1-$f*$s)}] + set t [expr {double($v)*(1-(1-$f)*$s)}] + switch -- $hi { + 0 {set r $v; set g $t; set b $p} + 1 {set r $q; set g $v; set b $p} + 2 {set r $p; set g $v; set b $t} + 3 {set r $p; set g $q; set b $v} + 4 {set r $t; set g $p; set b $v} + 5 {set r $v; set g $p; set b $q} + default {error "[lindex [info level 0] 0]: bad H value"} + } + set r [expr {round($r*255)}] + set g [expr {round($g*255)}] + set b [expr {round($b*255)}] + return [list $r $g $b] + } + + proc init_switches {w} { + variable {} + variable presets + set q 0 + for {set row 0} {$row < 3} {incr row} { + for {set col 0} {$col < 10} {incr col} { + set c "#[lindex $presets $q]" + set b [expr {$($w:color) == $c}] + grid [frame ${w}.r${row}c${col} -width 18 -height 16 \ + -borderwidth 1 -relief [lindex {raised sunken} $b] \ + -background $c -highlightthickness 0] \ + -row $row -column $col + bind ${w}.r${row}c${col} <ButtonPress-1> \ + "[namespace current]::set_color $w $c" + incr q + } + } + } + + proc init_hsv {w} { + variable colorhsv + set colorhsv($w:h) 0 + set colorhsv($w:s) 255 + set colorhsv($w:v) 255 + grid [canvas ${w}.hue -width 130 -height 15 -borderwidth 1 \ + -relief sunken -highlightthickness 0] -column 0 -row 0 + grid [canvas ${w}.sat -width 130 -height 14 -borderwidth 1 \ + -relief sunken -highlightthickness 0] -column 0 -row 1 + grid [canvas ${w}.val -width 130 -height 14 -borderwidth 1 \ + -relief sunken -highlightthickness 0] -column 0 -row 2 + grid [canvas ${w}.test -width 46 -height 46 -borderwidth 1 \ + -relief sunken -highlightthickness 0 -background red] \ + -column 1 -row 0 -rowspan 3 + variable mh + variable ms + variable mv + set mh($w) 0; set ms($w) 0; set mv($w) 0; + set sh "[namespace current]::hsv_set $w h \[expr {%x*360.0/130.0}\]" + set ss "[namespace current]::hsv_set $w s \[expr {%x*255.0/130.0}\]" + set sv "[namespace current]::hsv_set $w v \[expr {%x*255.0/130.0}\]" + bind ${w}.hue <ButtonPress-1> "set [namespace current]::mh($w) 1; $sh" + bind ${w}.sat <ButtonPress-1> "set [namespace current]::ms($w) 1; $ss" + bind ${w}.val <ButtonPress-1> "set [namespace current]::mv($w) 1; $sv" + bind ${w}.hue <ButtonRelease-1> "set [namespace current]::mh($w) 0" + bind ${w}.sat <ButtonRelease-1> "set [namespace current]::ms($w) 0" + bind ${w}.val <ButtonRelease-1> "set [namespace current]::mv($w) 0" + bind ${w}.hue <Motion> "if {\$[namespace current]::mh($w)} {$sh}" + bind ${w}.sat <Motion> "if {\$[namespace current]::ms($w)} {$ss}" + bind ${w}.val <Motion> "if {\$[namespace current]::mv($w)} {$sv}" + for {set x 0} {$x < 130} {incr x 3} { + set c [mkColor [hsvToRgb [expr {$x*360.0/130.0}] 255 255]] + ${w}.hue create rectangle $x 0 [expr {4+$x}] 16 -fill $c -outline {} + } + hsv_regen $w $colorhsv($w:h) + } + + proc hsv_regen {w hue} { + ${w}.sat delete all + ${w}.val delete all + for {set x 0} {$x < 130} {incr x 3} { + set x1 [expr {$x*255.0/130.0}] + set c1 [mkColor [hsvToRgb $hue $x1 255]] + set c2 [mkColor [hsvToRgb $hue 255 $x1]] + ${w}.sat create rectangle $x 0 [expr {4+$x}] 16 \ + -fill $c1 -outline {} + ${w}.val create rectangle $x 0 [expr {4+$x}] 16 \ + -fill $c2 -outline {} + } + } + + proc hsv_set {w what val} { + variable colorhsv + if {$what != {h} && $what != {s} && $what != {v}} {return} + set colorhsv($w:$what) $val + if {$colorhsv($w:$what) < 0.0} {set colorhsv($w:$what) 0} + if {$what == {h}} { + if {$colorhsv($w:$what) >= 360.0} {set colorhsv($w:$what) 0} + hsv_regen $w $colorhsv($w:$what) + } else { + if {$colorhsv($w:$what) > 255.0} {set colorhsv($w:$what) 255} + } + set c [mkColor [hsvToRgb \ + $colorhsv($w:h) $colorhsv($w:s) $colorhsv($w:v)]] + ${w}.test configure -background $c + set_color $w $c + } +} diff --git a/properties.tcl b/properties.tcl new file mode 100644 index 0000000..addb624 --- /dev/null +++ b/properties.tcl @@ -0,0 +1,423 @@ +if {[catch {package require colorpicker}]} { + source [file join [file dirname [info script]] colorpicker.tcl] + package require colorpicker +} +namespace import ::colorpicker::colorpicker + +proc propertieswindow {gfxstub_id {options {}} {title {}}} { + set win $gfxstub_id + set ::id($win.p) $gfxstub_id + set ::optkeys($win.p) [list] + foreach {k v} $options { + set ::config($win.p:$k) $v + lappend ::optkeys($win.p) $k + } + toplevel $win + pack [propertiespanel $win.p] + wm resizable $win 0 0 + wm title $win $title + set win +} + +proc has_key {w key} { + expr {[lsearch -exact $::optkeys($w) $key] != -1} +} + +proc propertiespanel {w} { + set pad [propertiespanel_padding $w] + incr pad $pad + frame $w -borderwidth 0 -relief raised -padx $pad -pady $pad + set subpanels {dimensions output behavior connective label colors} + foreach subpanel $subpanels { + set x [propertiespanel_$subpanel $w] + if {$x != {}} {grid $x -sticky ew -in $w} + } + set x [propertiespanel_buttons $w] + grid $x -in $w + grid columnconfigure . 0 -weight 1 + set w +} + +proc propertiespanel_padding {w} { + return 3 +} + +proc propertiespanel_dimensions {w} { + set x ${w}.dimensions + set pad [propertiespanel_padding $w] + labelframe $x -text "Dimensions:" -borderwidth 1 -relief raised + set count 0 + set row 0; set col 0 + if {[has_key $w -width]} { + grid [label ${x}.wl -text "Width (px):" -anchor e] \ + -row $row -column $col -sticky ew -padx $pad -pady $pad + incr col + grid [entry ${x}.w -textvar ::config($w:-width) -width 5] \ + -row $row -column $col -sticky ew -padx $pad -pady $pad + incr col + incr count + } + if {[has_key $w -height]} { + grid [label ${x}.hl -text "Height (px):" -anchor e] \ + -row $row -column $col -sticky ew -padx $pad -pady $pad + incr col + grid [entry ${x}.h -textvar ::config($w:-height) -width 5] \ + -row $row -column $col -sticky ew -padx $pad -pady $pad + incr col + incr count + } + incr row; set col 0 + if {[has_key $w -uwidth]} { + grid [label ${x}.uwl -text "Width (cells):" -anchor e] \ + -row $row -column $col -sticky ew -padx $pad -pady $pad + incr col + grid [entry ${x}.uw -textvar ::config($w:-uwidth) -width 5] \ + -row $row -column $col -sticky ew -padx $pad -pady $pad + incr col + incr count + } + if {[has_key $w -uheight]} { + grid [label ${x}.uhl -text "Height (cells):" -anchor e] \ + -row $row -column $col -sticky ew -padx $pad -pady $pad + incr col + grid [entry ${x}.uh -textvar ::config($w:-uheight) -width 5] \ + -row $row -column $col -sticky ew -padx $pad -pady $pad + incr col + incr count + } + incr row; set col 0 + if {[has_key $w -cellsize]} { + grid [label ${x}.csl -text "Cell size (pixels):" -anchor e] \ + -row $row -column $col -sticky ew -padx $pad -pady $pad + incr col + grid [entry ${x}.cs -textvar ::config($w:-cellsize) -width 5] \ + -row $row -column $col -sticky ew -padx $pad -pady $pad + incr col + incr count + } + incr row; set col 0 + if {[has_key $w -cellwidth]} { + grid [label ${x}.uwl -text "Cell width:" -anchor e] \ + -row $row -column $col -sticky ew -padx $pad -pady $pad + incr col + grid [entry ${x}.uw -textvar ::config($w:-cellwidth) -width 5] \ + -row $row -column $col -sticky ew -padx $pad -pady $pad + incr col + incr count + } + if {[has_key $w -cellheight]} { + grid [label ${x}.uhl -text "Cell height:" -anchor e] \ + -row $row -column $col -sticky ew -padx $pad -pady $pad + incr col + grid [entry ${x}.uh -textvar ::config($w:-cellheight) -width 5] \ + -row $row -column $col -sticky ew -padx $pad -pady $pad + incr col + incr count + } + incr row; set col 0 + if {$count == 0} {return {}} + set x +} + +proc propertiespanel_output {w} { + set x ${w}.output + set pad [propertiespanel_padding $w] + labelframe $x -text "Output range:" -borderwidth 1 -relief raised + set count 0 + set row 0; set col 0 + if {[has_key $w -rangebottom]} { + grid [label ${x}.rbl -text "Bottom:" -anchor e] \ + -row $row -column $col -sticky ew -padx $pad -pady $pad + incr col + grid [entry ${x}.rb -textvar ::config($w:-rangebottom) -width 5] \ + -row $row -column $col -sticky ew -padx $pad -pady $pad + incr col + incr count + } + if {[has_key $w -rangetop]} { + grid [label ${x}.rtl -text "Top:" -anchor e] \ + -row $row -column $col -sticky ew -padx $pad -pady $pad + incr col + grid [entry ${x}.rt -textvar ::config($w:-rangetop) -width 5] \ + -row $row -column $col -sticky ew -padx $pad -pady $pad + incr col + incr count + } + incr row; set col 0 + if {[has_key $w -rangeleft]} { + grid [label ${x}.rll -text "Left:" -anchor e] \ + -row $row -column $col -sticky ew -padx $pad -pady $pad + incr col + grid [entry ${x}.rl -textvar ::config($w:-rangeleft) -width 5] \ + -row $row -column $col -sticky ew -padx $pad -pady $pad + incr col + incr count + } + if {[has_key $w -rangeright]} { + grid [label ${x}.rrl -text "Right:" -anchor e] \ + -row $row -column $col -sticky ew -padx $pad -pady $pad + incr col + grid [entry ${x}.rr -textvar ::config($w:-rangeright) -width 5] \ + -row $row -column $col -sticky ew -padx $pad -pady $pad + incr col + incr count + } + incr row; set col 0 + if {[has_key $w -rangemin]} { + grid [label ${x}.rml -text "Min:" -anchor e] \ + -row $row -column $col -sticky ew -padx $pad -pady $pad + incr col + grid [entry ${x}.rm -textvar ::config($w:-rangemin) -width 5] \ + -row $row -column $col -sticky ew -padx $pad -pady $pad + incr col + incr count + } + if {[has_key $w -rangemax]} { + grid [label ${x}.rMl -text "Max:" -anchor e] \ + -row $row -column $col -sticky ew -padx $pad -pady $pad + incr col + grid [entry ${x}.rM -textvar ::config($w:-rangemax) -width 5] \ + -row $row -column $col -sticky ew -padx $pad -pady $pad + incr col + incr count + } + incr row; set col 0 + if {[has_key $w -logarithmic]} { + incr col + grid [checkbutton ${x}.rL -variable ::config($w:-logarithmic) \ + -text "Logarithmic"] \ + -row $row -column $col -columnspan 3 -sticky w -padx $pad -pady $pad + incr col + incr count + } + incr row; set col 0 + if {$count == 0} {return {}} + set x +} + +proc propertiespanel_behavior {w} { + set x ${w}.behavior + set pad [propertiespanel_padding $w] + labelframe $x -text "Widget behavior:" -borderwidth 1 -relief raised + set count 0 + set row 0; set col 0 + if {[has_key $w -jumponclick]} { + grid [checkbutton ${x}.joc -variable ::config($w:-jumponclick) \ + -text "Jump on click"] \ + -row $row -column $col -sticky w -padx $pad -pady $pad + incr col + incr count + } + if {[has_key $w -init]} { + grid [checkbutton ${x}.init -variable ::config($w:-init) \ + -text "Output init value"] \ + -row $row -column $col -sticky w -padx $pad -pady $pad + incr col + incr count + } + incr row; set col 0 + if {$count == 0} {return {}} + set x +} + +proc propertiespanel_label {w} { + set x ${w}.label + set pad [propertiespanel_padding $w] + labelframe $x -text "Label:" -borderwidth 1 -relief raised + set count 0 + set row 0 + if {[has_key $w -label]} { + grid [label ${x}.ll -text "Text:" -anchor e] \ + -row $row -column 0 -sticky ew -padx $pad -pady $pad + grid [entry ${x}.l -textvar ::config($w:-label)] \ + -row $row -column 1 -sticky ew -padx $pad -pady $pad + incr row + incr count + } + if {[has_key $w -labelpos]} { + grid [label ${x}.lpl -text "Position:" -anchor e] \ + -row $row -column 0 -sticky ew -padx $pad -pady $pad + frame ${x}.f + if {![info exists ::config($w:-labelpos)]} { + set ::config($w:-labelpos) top + } + grid [radiobutton ${x}.f.lp1 -variable ::config($w:-labelpos) \ + -value top -text Top] \ + -row 1 -column 1 -sticky w -padx $pad -pady $pad -in ${x}.f + grid [radiobutton ${x}.f.lp2 -variable ::config($w:-labelpos) \ + -value bottom -text Bottom] \ + -row 1 -column 2 -sticky w -padx $pad -pady $pad -in ${x}.f + grid [radiobutton ${x}.f.lp3 -variable ::config($w:-labelpos) \ + -value left -text Left] \ + -row 2 -column 1 -sticky w -padx $pad -pady $pad -in ${x}.f + grid [radiobutton ${x}.f.lp4 -variable ::config($w:-labelpos) \ + -value right -text Right] \ + -row 2 -column 2 -sticky w -padx $pad -pady $pad -in ${x}.f + grid ${x}.f -sticky w -row $row -column 1 + incr row + incr count + } + if {$count == 0} {return {}} + set x +} + +proc propertiespanel_connective {w} { + set x ${w}.connective + set pad [propertiespanel_padding $w] + labelframe $x -text "Messages:" -borderwidth 1 -relief raised + set count 0 + set row 0 + if {[has_key $w -sendsymbol]} { + grid [label ${x}.ssl -text "Send symbol:" -anchor e] \ + -row $row -column 0 -sticky ew -padx $pad -pady $pad + grid [entry ${x}.ss -textvar ::config($w:-sendsymbol) -width 15] \ + -row $row -column 1 -sticky ew -padx $pad -pady $pad + incr row + incr count + } + if {[has_key $w -receivesymbol]} { + grid [label ${x}.rsl -text "Receive symbol:" -anchor e] \ + -row $row -column 0 -sticky ew -padx $pad -pady $pad + grid [entry ${x}.rs -textvar ::config($w:-receivesymbol) -width 15] \ + -row $row -column 1 -sticky ew -padx $pad -pady $pad + incr row + incr count + } + if {$count == 0} {return {}} + set x +} + +proc propertiespanel_colors {w} { + set colors {-bgcolor Background -fgcolor Foreground -lblcolor Label} + set x ${w}.colors + set pad [propertiespanel_padding $w] + labelframe $x -text "Colors:" -borderwidth 1 -relief raised + set count 0 + set row 0 + foreach {optkey color} $colors { + if {![has_key $w $optkey]} {continue} + grid [label ${x}.l$color -text "${color}:" -anchor e] \ + -row $row -column 0 -sticky ew -padx $pad -pady $pad + grid [entry ${x}.t$color -textvar ::config($w:$optkey) -width 8] \ + -row $row -column 1 -sticky ew -padx $pad -pady $pad + grid [frame ${x}.p$color -width 20 -height 20 \ + -borderwidth 1 -relief sunken] \ + -row $row -column 2 -sticky ew -padx $pad -pady $pad + grid [button ${x}.b$color -text "Pick..." -overrelief {} \ + -command {} \ + ] -row $row -column 3 -sticky ew -padx $pad -pady $pad + bind ${x}.b$color <Enter> {break} + bind ${x}.b$color <Leave> {break} + bind ${x}.b$color <ButtonPress-1> [list \ + propertiespanel_colors_pick \ + $w $x $colors ${x}.b$color ${x}.p$color ${x}.t$color] + trace add variable ::config($w:$optkey) write [list \ + propertiespanel_colors_set_wrap $w $x ${x}.p$color $optkey] + incr row + incr count + } + if {![info exists ::cpt($w)]} {set ::cpt($w) switches} + foreach {optkey color} $colors { + if {![has_key $w $optkey]} {continue} + # trigger the variable trace: + if {[info exists ::config($w:$optkey)]} { + set ::config($w:$optkey) $::config($w:$optkey) + } + } + if {$count == 0} {return {}} + frame ${x}.f + grid [radiobutton ${x}.f.cpt1 -variable ::cpt($w) -justify right \ + -value switches -text Switches] \ + -row 0 -column 0 -sticky ew -padx $pad -pady $pad + grid [radiobutton ${x}.f.cpt2 -variable ::cpt($w) -justify right \ + -value hsv -text HSV] \ + -row 1 -column 0 -sticky ew -padx $pad -pady $pad + grid ${x}.f -row $row -column 0 + grid [colorpicker ${x}.cp2 hsv] \ + -row $row -column 1 -columnspan 3 -sticky ew -padx $pad -pady $pad + grid [colorpicker ${x}.cp1 switches -command [list ${x}.cp2 set]] \ + -row $row -column 1 -columnspan 3 -sticky ew -padx $pad -pady $pad + raise ${x}.cp1 + trace add variable ::cpt($w) write \ + [list propertiespanel_colors_switchpicker $w $x $row] + set x +} + +proc propertiespanel_colors_set_wrap {w x wp optkey config_ idx op} { + propertiespanel_colors_set $w $x $wp {} -1 $::config($w:$optkey) +} + +proc propertiespanel_colors_switchpicker {w x row cpt idx op} { + raise ${x}.cp[expr {1+($::cpt($w) == {hsv})}] +} + +proc propertiespanel_colors_pick {w x colors wb wp wt} { + foreach {k color} $colors { + ${x}.b$color configure -relief raised -state normal + } + set r [$wb cget -relief] + if {$r == {sunken}} { + $wb configure -relief raised + ${x}.cp1 configure -command {} + ${x}.cp2 configure -command {} + } else { + $wb configure -relief sunken + ${x}.cp1 configure -command \ + [list propertiespanel_colors_set $w $x $wp $wt 1] + ${x}.cp2 configure -command \ + [list propertiespanel_colors_set $w $x $wp $wt 2] + } +} + +proc propertiespanel_colors_set {w x wp wt from color} { + if {$wt != {}} {$wt delete 0 end ; $wt insert 0 $color} + $wp configure -background $color + if {$::cpt($w) == {switches} && $from == 1} { + ${x}.cp2 set $color + } +} + +proc propertiespanel_buttons {w} { + set x ${w}.buttons + set pad [propertiespanel_padding $w] + frame $x -padx $pad -pady $pad + set col 0 + foreach action {Cancel Apply Ok} { + grid [button ${x}.btn$action \ + -command [list propertiespanel_buttons_action $w $action] \ + -text $action] \ + -row 0 -column $col -padx $pad -pady $pad + incr col + } + set x +} + +proc propertiespanel_buttons_action {w action} { + switch -- $action { + Cancel { + propertiespanel_close $w + } + Apply { + propertiespanel_apply $w + } + Ok { + propertiespanel_apply $w + propertiespanel_close $w + } + } +} + +proc propertiespanel_apply {w} { + set newconf [list] + foreach key $::optkeys($w) { + set v $::config($w:$key) + if {$v == ""} {set v "empty"} + lappend newconf $key $v + } + set newconf [string map {$ \\$} $newconf] + pd [concat $::id($w) config {*}$newconf \;] +} + +proc propertiespanel_close {w} { + pd [concat $::id($w) cancel \;] +} |