Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4609
Modified Files: Tag: devel_0_39 desire.tk Log Message: small rendering fixes and the new ClientPrefsDialog write to write the new ddrc format
Index: desire.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v retrieving revision 1.1.2.400 retrieving revision 1.1.2.401 diff -C2 -d -r1.1.2.400 -r1.1.2.401 *** desire.tk 23 Aug 2006 22:23:57 -0000 1.1.2.400 --- desire.tk 24 Aug 2006 03:38:43 -0000 1.1.2.401 *************** *** 957,961 **** foreach name $list { if {$name == ""} {$menu add separator; continue} ! if {[llength [array names key $name]]} {set k $key($@_class:$name)} {set k ""} $menu add command -label [say $name] -command "$self $name" \ -accelerator [accel_munge $k] --- 957,964 ---- foreach name $list { if {$name == ""} {$menu add separator; continue} ! #if {[llength [array names key $name]]} {set k $key($@_class:$name); puts "here"} {set k ""} ! if {[info exists key($@_class:$name)]} { ! if {[string length $key($@_class:$name)]} {set k $key($@_class:$name)} {set k ""} ! } $menu add command -label [say $name] -command "$self $name" \ -accelerator [accel_munge $k] *************** *** 1007,1011 ****
def Menuable ctrlkey {key shift} { - puts "class:: $@_class" global accels set key [if {$shift} {string toupper $key} {string tolower $key}] --- 1010,1013 ---- *************** *** 1787,1791 **** def TextBox text {} {return $text}
! def TextBox draw {} { global font #$self update_size --- 1789,1793 ---- def TextBox text {} {return $text}
! def* TextBox draw {} { global font #$self update_size *************** *** 1854,1870 **** }
! def* TextBox update_size {} { global font set n [string length $@text] set textwidth [expr $font(padx)+$font(width)*($n+$@edit)] ! #if {[llength [.$@canvas.c gettags ${self}TEXT]]} { ! # mset {x1 y1 x2 y2} [.$@canvas.c bbox ${self}TEXT] ! # set textwidth [expr (($x2 - $x1)/[$@canvas scale])+$font(padx)] ! #} #if {[llength [.$@canvas.c gettags ${self}text]]} { catch { set n [expr [string length [.$@canvas.c.${self}text get 1.0 1.end]] -1] mset {x1 y1 w h} [.$@canvas.c.${self}text bbox 1.$n] ! set textwidth [expr ($font(padx) + $x1 + ($w * 2)) / [$@canvas scale]] } #} --- 1856,1872 ---- }
! def TextBox update_size {} { global font set n [string length $@text] set textwidth [expr $font(padx)+$font(width)*($n+$@edit)] ! if {[llength [.$@canvas.c gettags ${self}TEXT]]} { ! mset {x1 y1 x2 y2} [.$@canvas.c bbox ${self}TEXT] ! set textwidth [expr (($x2 - $x1)/[$@canvas scale])+$font(padx)] ! } #if {[llength [.$@canvas.c gettags ${self}text]]} { catch { set n [expr [string length [.$@canvas.c.${self}text get 1.0 1.end]] -1] mset {x1 y1 w h} [.$@canvas.c.${self}text bbox 1.$n] ! set textwidth [expr ($font(padx) + $x1 + ($w * 2)+$font(padx)+2) / [$@canvas scale]] } #} *************** *** 1921,1925 **** }
! def ObjectBox draw_box {} { global font super --- 1923,1927 ---- }
! def* ObjectBox draw_box {} { global font super *************** *** 1928,1934 **** set xyb [l+ [list $x2 $y1 $x1 $y1 $x1 $y2] [list -1 +1 +1 +1 +1 -1]] set xyc [l+ [list $x2 $y1 $x2 $y2 $x1 $y2] [list -1 +1 -1 -1 +1 -1]] ! $self item BASE rectangle $xya -fill [$self look bg] -width 1 ! $self item BASE1 line $xyb -fill [$self look frame1] -width 1 ! $self item BASE2 line $xyc -fill [$self look frame2] -width 1 .$@canvas.c lower ${self}BASE ${self}TEXT } --- 1930,1936 ---- set xyb [l+ [list $x2 $y1 $x1 $y1 $x1 $y2] [list -1 +1 +1 +1 +1 -1]] set xyc [l+ [list $x2 $y1 $x2 $y2 $x1 $y2] [list -1 +1 -1 -1 +1 -1]] ! $self item BASE rectangle $xya -fill [$self look bg] -outline [$self look frame1] -width 1 ! #$self item BASE1 line $xyb -fill [$self look frame1] -width 1 ! #$self item BASE2 line $xyc -fill [$self look frame2] -width 1 .$@canvas.c lower ${self}BASE ${self}TEXT } *************** *** 3078,3084 **** for {set i 0} {$i<$n} {incr i} { set onset [expr $x1 + ($xs-([$self look iowidth])) * $i / $nplus] ! set points [list [expr $onset] [expr $y-1] [expr $onset+[$self look iowidth]] $y] switch $which { i {set color [$self look inletfg]} o {set color [$self look outletfg]}} ! $self item [list $which$i $which] rectangle $points -outline $color -fill $color } } --- 3080,3086 ---- for {set i 0} {$i<$n} {incr i} { set onset [expr $x1 + ($xs-([$self look iowidth])) * $i / $nplus] ! set points [list [expr $onset] [expr $y-0] [expr $onset+[$self look iowidth]] [expr $y+0]] switch $which { i {set color [$self look inletfg]} o {set color [$self look outletfg]}} ! $self item [list $which$i $which] rectangle $points -outline $color -fill $color -width 1 } } *************** *** 3111,3116 **** if {$port >= $ports} {set port [expr $ports-1]} set p $self$type$port set outline [switch $type {i {concat [$self look outletfg]} o {concat [$self look inletfg]}}] ! $c create rectangle [l+ [$c coords $p] {-4 -4 +4 +4}] -outline $outline -width 1 -tags ${p}b switch $type {i {set tip "inlet $port"} o {set tip "outlet $port"}} if {[$self look tooltip]} {$@canvas show_tooltip $x $y $tip} --- 3113,3119 ---- if {$port >= $ports} {set port [expr $ports-1]} set p $self$type$port + set hilitebox [lmap * [list -3 -3 +3 +3] [$@canvas scale]] set outline [switch $type {i {concat [$self look outletfg]} o {concat [$self look inletfg]}}] ! $c create rectangle [l+ [$c coords $p] $hilitebox] -outline $outline -width 1 -tags ${p}b switch $type {i {set tip "inlet $port"} o {set tip "outlet $port"}} if {[$self look tooltip]} {$@canvas show_tooltip $x $y $tip} *************** *** 5006,5010 **** set v $_($self:$name) ;# bug in objtcl frame $f - puts " f::: $f" label $f.label -text $label set text_color [complement $v] --- 5009,5012 ---- *************** *** 5749,5757 **** --- 5751,5810 ---- } } + + #proc cons {x y} { list $x $y } + #proc car {l} { lindex $l 0} } + #proc cdr {l} { lindex $l 1 } + def* ClientPrefsDialog write {} { global ddrc_options ddrc_options_h cmdline look accels key crosshair #set fd [open $cmdline(ddrcfilename) w] + set fd [open ~/.ddrc2 w] + set categories [list color key crosshair bar] + set classes [list Canvas View Comment Wire FutureWire SelRect] + set conf {} + + foreach category $categories { + set tmp {} + set x [lsearch -start 0 $ddrc_options $category] + while {$x>=0} { + #puts "[lindex $ddrc_options [expr $x+1]] [lindex $ddrc_options [expr $x+2]]" + lappend tmp [lindex $ddrc_options [expr $x+1]] + lappend tmp [lindex $ddrc_options [expr $x+2]] + set x [lsearch -start [expr $x+1] $ddrc_options $category] + } + set class_list {} + foreach class $classes { + set tmp2 {} + set x [lsearch -start 0 $tmp $class] + while {$x>=0} { + foreach y [lindex $tmp [expr $x+1]] { + if {$category != "key"} { + if {[info exists look($class:$y)]} {set var $look($class:$y);lappend tmp2 [list $y $var]} else {break} + } else { + if {[info exists key($class:$y)]} {set var $key($class:$y);lappend tmp2 [list $y $var]} else {break} + } + } + set x [lsearch -start [expr $x+1] $tmp $class] + } + + set class_pair [list $class $tmp2] + lappend class_list $class_pair + if {$x < 0} {break} + } + set cat_pair [list $category $class_list] + lappend conf $cat_pair + } + puts $conf + puts $fd $conf + close $fd + + } + + def* ClientPrefsDialog write3 {} { + global ddrc_options ddrc_options_h cmdline look accels key crosshair + #set fd [open $cmdline(ddrcfilename) w] set check_key {} set color {} + foreach {type class name} $ddrc_options { switch $type { *************** *** 5856,5860 **** } def ClientPrefsDialog init {} { - puts " class:: $@_class" global ddrc_options look key crosshair bar $self read --- 5909,5912 ---- *************** *** 5900,5908 **** #this stores the path to the widget on the gui editor. set @$str2 $which_section.$str.color ! puts " str2::: $@$str2" #set @$name $look($name) #set @$name $look($class:$name) set @$str $look($class:$name) ! puts "$str :::: $look($class:$name)" #$self add $which_section [list [lindex $name 0] color] $self add $which_section [list $str color] --- 5952,5960 ---- #this stores the path to the widget on the gui editor. set @$str2 $which_section.$str.color ! #puts " str2::: $@$str2" #set @$name $look($name) #set @$name $look($class:$name) set @$str $look($class:$name) ! #puts "$str :::: $look($class:$name)" #$self add $which_section [list [lindex $name 0] color] $self add $which_section [list $str color]
-
chunlee