pd/src desire.tk,1.1.2.212,1.1.2.213 - Pd-cvs

28 May 2006


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv21047
Modified Files:
      Tag: devel_0_39
    desire.tk 
Log Message:
worked on somemore on the ddrc editor and a quick hack to get 
read/write working
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.212
retrieving revision 1.1.2.213
diff -C2 -d -r1.1.2.212 -r1.1.2.213
*** desire.tk	24 May 2006 11:19:00 -0000	1.1.2.212
--- desire.tk	27 May 2006 22:16:03 -0000	1.1.2.213
***************
*** 1171,1175 ****
  def Canvas reload {} {pd ".$self map 0; .$self map 1"}
! def Canvas redraw {} {
      $self changed
      foreach x $@children {$x changed}
--- 1171,1175 ----
  def Canvas reload {} {pd ".$self map 0; .$self map 1"}
! def* Canvas redraw {} {
      $self changed
      foreach x $@children {$x changed}
***************
*** 1291,1296 ****
  }
! def Canvas draw {} {
! 
  }
--- 1291,1301 ----
  }
! def* Canvas draw {} {
! 	global look
! 	if {$@editmode} {
! 	.$self.c configure -background $look(canvasbgedit)} else {
! 	.$self.c configure -background $look(canvasbgrun)
! 	}
! 	
  }
***************
*** 3664,3676 ****
  proc color_popup_select {self name c} {
    global _ preset_colors
! 	set _($self:$name) $c
    set fg_color [complement [format #%6.6x $c]]
    .$self.$name configure \
! 		-background [format #%6.6x $_($self:$name)] -foreground $fg_color
    	# somehow this hilites one more pixel outside of what it should be
    	#-highlightbackground [format #%6.6x $_($self:$name)]
  }
! proc color_popup {self w name i} {
    set self [string trimleft $self .]
    set old_w $w.$name
--- 3669,3682 ----
  proc color_popup_select {self name c} {
    global _ preset_colors
! 	#set _($self:$name) $c
    set fg_color [complement [format #%6.6x $c]]
    .$self.$name configure \
! 		-background [format #%6.6x $c] -foreground $fg_color -text [format #%6.6x $c]
! 		#-background [format #%6.6x $_($self:$name)] -foreground $fg_color
    	# somehow this hilites one more pixel outside of what it should be
    	#-highlightbackground [format #%6.6x $_($self:$name)]
  }
! proc* color_popup {self w name i} {
    set self [string trimleft $self .]
    set old_w $w.$name
***************
*** 3691,3702 ****
      set self [string trimleft $id .]
      global _ look
-     #set c $_($self:$var)
      set c 0xFFFFFF
-     #if {[string index $c 0]=="#"} {set c [string replace $c 0 0 0x]}
-     #set color [tk_chooseColor -title $title \
-     #	    -initialcolor [format "#%6.6x" [expr $c&0xFFFFFF]]]
      set color [tk_chooseColor -title $title -initialcolor $title]
- 	$id.$var configure -text $color
      if {$color != ""} {
    color_popup_select $self $var [expr [string replace $color 0 0 "0x"]&0xFFFFFF]
      }
--- 3697,3704 ----
      set self [string trimleft $id .]
      global _ look
      set c 0xFFFFFF
      set color [tk_chooseColor -title $title -initialcolor $title]
      if {$color != ""} {
+     	$id.$var configure -text $color
    color_popup_select $self $var [expr [string replace $color 0 0 "0x"]&0xFFFFFF]
      }
***************
*** 3709,3713 ****
  }
! proc properties_dialog {self w ok which struct} {
      global _ look
      foreach {name label type options} $struct {
--- 3711,3715 ----
  }
! proc properties_dialog {self w ok struct} {
      global _ look
      foreach {name label type options} $struct {
***************
*** 3737,3744 ****
    	set c 0xFCFCFC
    	set text_color [complement $look($name)]
! 		button $f.color -text $look($name) -font {Courier 8} -width 10 -pady 2 -fg $text_color \
    		-command [list iemgui_choose_col $w $name.color $look($name)] \
    		-relief sunken -background $look($name) \
! 			-highlightbackground       [format #%6.6x $c]
    	set i 10
    	#puts "self : $self | w : $w | name : $name"	
--- 3739,3746 ----
    	set c 0xFCFCFC
    	set text_color [complement $look($name)]
! 		button $f.color -text $look($name) -font {Courier 10} -width 10 -pady 2 -fg $text_color \
    		-command [list iemgui_choose_col $w $name.color $look($name)] \
    		-relief sunken -background $look($name) \
! 			-highlightbackground [format #%6.6x $c] -activebackground [darker $look($name)]
    	set i 10
    	#puts "self : $self | w : $w | name : $name"	
***************
*** 3885,3889 ****
class_new Dialog
! def Dialog ok      {} {$self cancel; $self apply}
  def Dialog cancel  {} {}
  def Dialog apply   {} {}
--- 3887,3892 ----
class_new Dialog
! #what's the difference between ok and apply? 
! def Dialog ok      {} {$self apply; $self cancel}
  def Dialog cancel  {} {}
  def Dialog apply   {} {}
***************
*** 4100,4104 ****
    	set babble {}
    	foreach subname $names {lappend babble [say [lindex [split $subname |] 0]]}
! 		properties_dialog $self $f.main.$section ServerPrefsDialog_ok server \
    		[list [lindex $name 0] $babble choice {}]
        }
--- 4103,4107 ----
    	set babble {}
    	foreach subname $names {lappend babble [say [lindex [split $subname |] 0]]}
! 		properties_dialog $self $f.main.$section ServerPrefsDialog_ok \
    		[list [lindex $name 0] $babble choice {}]
        }
***************
*** 4106,4110 ****
    	#properties_dialog $self $f.main.$section ServerPrefsDialog_ok \
    	#	[list $name "$name: [say $name]" $type {}]
! 		properties_dialog $self $f.main.$section ServerPrefsDialog_ok server \
    		[list $name [say $name] $type {}]
        }
--- 4109,4113 ----
    	#properties_dialog $self $f.main.$section ServerPrefsDialog_ok \
    	#	[list $name "$name: [say $name]" $type {}]
! 		properties_dialog $self $f.main.$section ServerPrefsDialog_ok \
    		[list $name [say $name] $type {}]
        }
***************
*** 4121,4125 ****
  set ddrc_options {
  section section_color
!  subsection canvas_color
    color canvasbgedit
    color canvasbgrun
--- 4124,4128 ----
  set ddrc_options {
  section section_color
!  subsection canvas_color 
    color canvasbgedit
    color canvasbgrun
***************
*** 4138,4142 ****
    color inletfg
    color outletfg
!   color selrect 
  section test
  }
--- 4141,4145 ----
    color inletfg
    color outletfg
!   color selrect
  section test
  }
***************
*** 4146,4190 ****
  def ClientPrefsDialog apply  {} {$self write}
! def ClientPrefsDialog read {} {
! 	global ddrc_options ddrc_options_h cmdline
    set fd [open $cmdline(ddrcfilename) "RDONLY CREAT"]
! 	set contents [split [string map {"\n" " "} [read $fd]] " "]
    close $fd
! 	foreach {type name desc} $ddrc_options {
    	set @$name ""
    	foreach subname [split $name |] {
! 			set ddrc_options_h($subname) [list $type $name $desc]
    	}
    }
    set i 0
! 	while {$i < [llength $contents]} {
! 		set op [lindex $contents $i]
! 		puts "op=$op"
! 		if {[string length $op]==0} {break}
! 		if {![info exists ddrc_options_h($op)]} {
! 			error "unknown option: $op"
    	}
- 		foreach {type name desc} $ddrc_options_h($op) {}
    	switch $type {
    		folders {incr i; lappend @$name [lindex $contents $i]}
    		files   {incr i; lappend @$name [lindex $contents $i]}
    		void            {set @$name 1}
    		default {incr i; set @$name [lindex $contents $i]}
    	}
! 		incr i
    }
  }
! def ClientPrefsDialog write {} {
! 	global ddrc_options ddrc_options_h cmdline
! 	set fd [open $cmdline(rcfilename) w]
! 	foreach {type name desc} $ddrc_options {
! 		set v $@$name
! 		set op [lindex [split $name |] 0]
    	switch $type {
! 			folders {foreach x $v {puts $fd "$op $x"}}
! 			files   {foreach x $v {puts $fd "$op $x"}}
! 			void    {if {[string length $v]} {if {$v} {puts $fd $op}}}
! 			default {if {[string length $v]} {puts $fd "$op $v"}}
    	}
    }
--- 4149,4220 ----
  def ClientPrefsDialog apply  {} {$self write}
! def* ClientPrefsDialog read {} {
! 	global ddrc_options ddrc_options_h cmdline look
    set fd [open $cmdline(ddrcfilename) "RDONLY CREAT"]
! 	#set contents [split [string map {"\n" " "} [read $fd]] " "]
! 	set contents [split [read $fd] "\n"]
    close $fd
! 	foreach {type name} $ddrc_options {
    	set @$name ""
    	foreach subname [split $name |] {
! 			set ddrc_options_h($subname) [list $type $name]
    	}
    }
    set i 0
! 	foreach line $contents {
! 		foreach {type item value} $line {
! 		if {![info exists ddrc_options_h($item)]} {
! 			error "unknown option: $item"
    	}
    	switch $type {
    		folders {incr i; lappend @$name [lindex $contents $i]}
    		files   {incr i; lappend @$name [lindex $contents $i]}
    		void            {set @$name 1}
+ 			color {set look($item) $value}
    		default {incr i; set @$name [lindex $contents $i]}
    	}
! 		}
! 		
    }
+ 	#while {$i < [llength $contents]} {
+ 	#	set op [lindex $contents $i]
+ 	#	puts "op=$op"
+ 	#	if {[string length $op]==0} {break}
+ 	#	if {![info exists ddrc_options_h($op)]} {
+ 	#		error "unknown option: $op"
+ 	#	}
+ 	#	foreach {type name} $ddrc_options_h($op) {}
+ 	#	switch $type {
+ 	#		folders {incr i; lappend @$name [lindex $contents $i]}
+ 	#		files   {incr i; lappend @$name [lindex $contents $i]}
+ 	#		void            {set @$name 1}
+ 	#		color { puts "reading colors $name" }
+ 	#		default {incr i; set @$name [lindex $contents $i]}
+ 	#	}
+ 	#	incr i
+ 	#}
  }
! def* ClientPrefsDialog write {} {
! 	global ddrc_options ddrc_options_h cmdline look
! 	set fd [open $cmdline(ddrcfilename) w]
! 	#puts "fd ===== $fd"
! 	foreach {type name} $ddrc_options {
! 		#puts "type::: $type || name:: $name"
! 		
! 		#set v $@$name
! 		#set op [lindex [split $name |] 0]
    	switch $type {
! 			#folders {foreach x $v {puts $fd "$op $x"}}
! 			#files   {foreach x $v {puts $fd "$op $x"}}
! 			#void    {if {[string length $v]} {if {$v} {puts $fd $op}}}
! 			color	{
! 				set var ${name}path
! 				puts "var = $var"
! 				set new_color [$@$var cget -background]
! 				set look($name) $new_color 
! 				puts $fd "$type $name $new_color"
! 				}
! 			#default {if {[string length $v]} {puts $fd "$op $v"}}
    	}
    }
***************
*** 4210,4214 ****
    	}
        subsection {
- 	    	#puts "|| $f.main.$section.$name ||"
    	set subself $self.1.main.$section.subsections
    	if {!$subsection} {SubPagedDialog new_as $subself}
--- 4240,4243 ----
***************
*** 4217,4236 ****
    	set which_section .$subself.main.$subsection
    	set which_self $subself
- 	    	#properties_dialog $subself .$subself ClientPrefsDialog_ok client \
- 		#	[list [lindex $name 0] "$desc" subsection {}]
        }
        alias {}
        radio {
! 		properties_dialog $which_self $which_section ClientPrefsDialog_ok client \
    		[list [lindex $name 0] "$desc" choice {}]
        }
        color {
! 		properties_dialog $which_self $which_section ClientPrefsDialog_ok client \
    		[list [lindex $name 0] [say $name] color {}]
        }
        default {
! 		#properties_dialog $which_self $f.main.$section ClientPrefsDialog_ok \
! 		#	[list $name "$name: $desc" $type {}]
! 		properties_dialog $which_self $which_section ClientPrefsDialog_ok client \
    		[list $name [say $name] $type {}]
        }
--- 4246,4265 ----
    	set which_section .$subself.main.$subsection
    	set which_self $subself
        }
        alias {}
        radio {
! 		properties_dialog $which_self $which_section ClientPrefsDialog_ok \
    		[list [lindex $name 0] "$desc" choice {}]
        }
        color {
! 	    	#puts "${name}path"
! 		set var ${name}path
! 		#this stores the path to the widget on the gui editor. 
! 	    	set @$var $which_section.$name.color
! 		properties_dialog $which_self $which_section ClientPrefsDialog_ok \
    		[list [lindex $name 0] [say $name] color {}]
        }
        default {
! 		properties_dialog $which_self $which_section ClientPrefsDialog_ok \
    		[list $name [say $name] $type {}]
        }