pd/src desire.tk,1.1.2.127,1.1.2.128 - Pd-cvs

26 Nov 2005


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9259
Modified Files:
      Tag: devel_0_39
    desire.tk 
Log Message:
.
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.127
retrieving revision 1.1.2.128
diff -C2 -d -r1.1.2.127 -r1.1.2.128
*** desire.tk	25 Nov 2005 09:54:37 -0000	1.1.2.127
--- desire.tk	26 Nov 2005 07:35:26 -0000	1.1.2.128
***************
*** 14,20 ****
  #-----------------------------------------------------------------------------------#
- # for future use
- # if {$tcl_version < 8.5} {source pre8.5.tcl}
- 
  source objective.tcl
--- 14,17 ----
***************
*** 51,78 ****
class_new observable {}
! 
! def* observable init {} {
    set @subscribers {}
  }
! 
! def* observable subscribe {observer} {
    set i [lsearch $@subscribers $observer]
    if {$i<0} {lappend @subscribers $observer}
  }
! 
! def* observable unsubscribe {observer} {
    set i [lsearch $@subscribers $observer]
    if {$i>=0} {set @subscribers [lreplace $@subscribers $i $i]}
  }
! 
! def* observable changed {args} {
! 	puts "____ subscribers:$@subscribers ____"
    foreach x $@subscribers {eval [concat [list $x notice $self] $args]}
  }
! 
! def* observable child_changed {origin args} {
! 	#puts "==== [concat [list $x notice $origin] $args] ===="
    foreach x $@subscribers {eval [concat [list $x notice $origin] $args]}
  }
#-----------------------------------------------------------------------------------#
--- 48,69 ----
class_new observable {}
! def observable init {} {
    set @subscribers {}
  }
! def observable subscribe {observer} {
    set i [lsearch $@subscribers $observer]
    if {$i<0} {lappend @subscribers $observer}
  }
! def observable unsubscribe {observer} {
    set i [lsearch $@subscribers $observer]
    if {$i>=0} {set @subscribers [lreplace $@subscribers $i $i]}
  }
! def observable changed {args} {
    foreach x $@subscribers {eval [concat [list $x notice $self] $args]}
  }
! def observable child_changed {origin args} {
    foreach x $@subscribers {eval [concat [list $x notice $origin] $args]}
  }
+ def observable subscribers {} {return $@subscribers}
#-----------------------------------------------------------------------------------#
***************
*** 302,309 ****
proc pdtk_pd_meters {indb outdb inclip outclip} {
!     .controls.in.1.mtr coords m 0 0 $indb 0
!     .controls.out.1.mtr coords m 0 0 $outdb 0
!     foreach {z clip} [list in $inclip out $outclip] {
! 	.controls.$z.1.clip configure -background [if {$clip==1} {list red} {list black}]
      }
  }
--- 293,299 ----
proc pdtk_pd_meters {indb outdb inclip outclip} {
!     foreach {z clip db} [list in $inclip $indb out $outclip $outdb] {
! 	.controls.$z.1.mtr coords m 0 0 $db 0
! 	.controls.$z.1.clip configure -background [if {$clip==1} {concat red} {concat black}]
      }
  }
***************
*** 849,853 ****
      toplevel $name -menu $name.m
      wm geometry $name $geometry
!     pack [make_button_bar $name.bbar $name] -side top -fill x -expand no
      set @statusbar [statusbar_new $self]
      pack [$@statusbar widget] -side bottom -fill x
--- 839,843 ----
      toplevel $name -menu $name.m
      wm geometry $name $geometry
!     pack [[button_bar_new $self] widget] -side top -fill x -expand no
      set @statusbar [statusbar_new $self]
      pack [$@statusbar widget] -side bottom -fill x
***************
*** 1014,1029 ****
  }
- # wow. what is this for?
- # to switch between edit/run mode with ctrl+e -chun
  def canvas editmodeswitch {args} {
!     set name .$self
!     if {$@editmode} {
!     set @editmode 0;
!     } else {
!     set @editmode 1; 
!     }
!     
!     pd $name editmode $@editmode
! 
  }
--- 1004,1010 ----
  }
def canvas editmodeswitch {args} {
!     set @editmode [expr !$@editmode]
!     pd .$self editmode $@editmode
  }
***************
*** 2585,2589 ****
#-----------------------------------------------------------------------------------#
- #class_new bang {view}
  class_new bang {bluebox}
  def* bang init {args} {
--- 2566,2569 ----
***************
*** 2612,2619 ****
  }
! def bang click {x y b f} {
! 	pd $self click $x $y 0 0 0
! 	$self bang
! }
def bang bang {} {
--- 2592,2596 ----
  }
! def bang click {x y b f} {pd $self user_bang; $self bang}
def bang bang {} {
***************
*** 2929,2933 ****
set butt {
! 	{object  {obj_create $focus(canvas) butt}}
    {message {pd %W msg 0}}
    {number  {pd %W floatatom 0}}
--- 2906,2910 ----
set butt {
! 	{object  {obj_create %W butt}}
    {message {pd %W msg 0}}
    {number  {pd %W floatatom 0}}
***************
*** 2954,2959 ****
proc load_button_bar {} {
! 	global butt
! 	global cmdline
    set icons {mode_edit mode_run}
    set dir $cmdline(icons)
--- 2931,2935 ----
proc load_button_bar {} {
! 	global butt cmdline
    set icons {mode_edit mode_run}
    set dir $cmdline(icons)
***************
*** 2972,3002 ****
set buttons_loaded 0
! proc make_button_bar {self doc} {
    global buttons_loaded butt focus
! 	set focus(canvas) $doc
    if {!$buttons_loaded} {load_button_bar}
! 	frame $self
! 	button $self.edit -image icon_mode_edit -border 1 \
! 		-command "menu_editmode $doc"
! 	pack $self.edit -side left 
! 	foreach b $butt {
! 	  catch {
! 		button "$self.[lindex $b 0]" -image "icon_[lindex $b 0]" -border 1 \
! 			-command [regsub -all -- %W [lindex $b 1] $doc]
! 		pack $self.[lindex $b 0] -side left
! 	  }
    }
! 	entry $self.name -font {courier 9} -width 10 -border 0
! 	$self.name insert 0 ".[lindex [split $self .] 1]"
! 	#$self.name configure -state disabled
! 	pack $self.name -side right
! 	return $self
  }
! proc obj_create {doc flag} {
    global _ focus
    set focus(createdby) $flag
! 	#puts " ||| $doc :: $_($doc:createdby)"
! 	pd $doc obj 0
  }
--- 2948,2975 ----
set buttons_loaded 0
! class_new button_bar {thing}
! 
! def button_bar init {canvas} {
    global buttons_loaded butt focus
! 	set @canvas $canvas
! 	set bb .$@canvas.bbar
! 	set focus(canvas) .$canvas
    if {!$buttons_loaded} {load_button_bar}
! 	frame $bb
! 	pack [button $bb.edit -image icon_mode_edit -border 1 -command "$@canvas editmode= 1"] -side left
! 	foreach e $butt {
! 	  mset {icon cmd} $e
! 	  catch {pack [button $bb.$icon -image icon_$icon -border 1 -command [regsub -all -- %W $cmd .$@canvas]] -side left}
    }
! 	pack [entry $bb.name -font {courier 9} -width 10 -border 0] -side right
! 	$bb.name insert 0 .$self.c
  }
! def button_bar widget {} {return .$@canvas.bbar}
! 
! proc obj_create {c flag} {
    global _ focus
    set focus(createdby) $flag
! 	pd $c obj 0
  }