diff options
Diffstat (limited to 'properties.tcl')
| -rw-r--r-- | properties.tcl | 423 |
1 files changed, 0 insertions, 423 deletions
diff --git a/properties.tcl b/properties.tcl deleted file mode 100644 index d225d74..0000000 --- a/properties.tcl +++ /dev/null @@ -1,423 +0,0 @@ -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 [linsert $newconf 0 $::id($w) config]\; -} - -proc propertiespanel_close {w} { - pd [concat $::id($w) cancel \;] -} |