[PD-cvs] pd/src desire.tk,1.1.2.400,1.1.2.401
chunlee
chunlee at users.sourceforge.net
Thu Aug 24 05:38:45 CEST 2006
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]
More information about the Pd-cvs
mailing list