pd/src desire.tk,1.1.2.80,1.1.2.81 - Pd-cvs

25 Sep 2005


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1794
Modified Files:
      Tag: devel_0_39
    desire.tk 
Log Message:
added class observable.
added def canvas add,del,window_title.
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.80
retrieving revision 1.1.2.81
diff -C2 -d -r1.1.2.80 -r1.1.2.81
*** desire.tk	24 Sep 2005 13:31:40 -0000	1.1.2.80
--- desire.tk	24 Sep 2005 23:21:15 -0000	1.1.2.81
***************
*** 71,74 ****
--- 71,76 ----
rename unknown _original_unknown
+ # TODO: remove duplicates in lookup
+ # TODO: cache lookup for greater speed
  proc unknown {args} {
    global _
***************
*** 102,108 ****
  set _(thing:_super) {}
  # virtual destructor
! def* thing ~ {} {}
#-----------------------------------------------------------------------------------#
set OS $tcl_platform(platform)
--- 104,165 ----
  set _(thing:_super) {}
  # virtual destructor
! def* thing _delete {} {}
! 
! #-----------------------------------------------------------------------------------#
! # some list processing functions
! 
! proc mset {vars list} {uplevel 1 "foreach {$vars} {$list} {}"}
! proc l+   {   al bl} {set r {}; foreach a $al b $bl {lappend r [expr $a +   $b]}; return $r}
! proc l-   {   al bl} {set r {}; foreach a $al b $bl {lappend r [expr $a -   $b]}; return $r}
! proc lzip {op al bl} {set r {}; foreach a $al b $bl {lappend r [expr $a $op $b]}; return $r}
! proc lmap {op al   } {set r {}; foreach a $al b $bl {lappend r [expr $a $op   ]}; return $r}
! proc l/2  {   al   } {set r {}; foreach a $al       {lappend r [expr $a /    2]}; return $r}
! proc lsum  {al} {set r 0; foreach a $al {set r [expr $r+$a]}; return $r}
! proc lprod {al} {set r 1; foreach a $al {set r [expr $r*$a]}; return $r}
! proc lreverse {list} {
! 	set r {}
! 	for {set i [expr [llength $list]-1]} {$i>=0} {incr i -1} {lappend r [lindex $list $i]}
! 	return $r
! }
! 
! #-----------------------------------------------------------------------------------#
! # Observer pattern
! # there's no class for "observer".
! # it's anything that has def $myclass notice {args} {...} in which args indicate
! # attributes that have changed, or is an empty list if an unspecified number of
! # attributes (maybe all) have changed.
! 
! class_new observable {}
! 
! def observable init {observer} {
! 	set @subscribers {}
! 	set @dirty {}
! }
! 
! def observable subscribe {observer} {
! 	set i [lsearch $@subscribers $observer]
! 	if {!$i} {lappend @subscribers $observer}
! }
! 
! def observable unsubscribe {observer} {
! 	set i [lsearch $@subscribers $observer]
! 	if {$i} {set @subscribers [lreplace $@subscribers $i $i]}
! }
! 
! def observable changed {{k "(all)"}} {
! 	if {$k == "(all)" && $@dirty != "(all)"} {set @dirty $k} {lappend @dirty $k}
! }
! 
! def observable notify {} {
! 	set dirty [lsort -uniq $dirty]
! 	if {$dirty == "(all)"} {
! 		foreach x $@subscribers {$x notice $self}
! 	} {
! 		foreach x $@subscribers {foreach k $dirty {$x notice $self $k}}
! 	}
! }
#-----------------------------------------------------------------------------------#
+ # this is the beginning of the more application-dependent part.
set OS $tcl_platform(platform)
***************
*** 127,147 ****
  }
- proc l+   {   al bl} {set r {}; foreach a $al b $bl {lappend r [expr $a +   $b]}; return $r}
- proc l-   {   al bl} {set r {}; foreach a $al b $bl {lappend r [expr $a -   $b]}; return $r}
- proc lzip {op al bl} {set r {}; foreach a $al b $bl {lappend r [expr $a $op $b]}; return $r}
- proc lmap {op al   } {set r {}; foreach a $al b $bl {lappend r [expr $a $op   ]}; return $r}
- proc l/2  {   al   } {set r {}; foreach a $al       {lappend r [expr $a /    2]}; return $r}
- proc lsum  {al} {set r 0; foreach a $al {set r [expr $r+$a]}; return $r}
- proc lprod {al} {set r 1; foreach a $al {set r [expr $r*$a]}; return $r}
- 
- proc lreverse {list} {
- 	set r {}
- 	for {set i [expr [llength $list]-1]} {$i>=0} {incr i -1} {
- 		lappend r [lindex $list $i]
- 	}
- 	return $r
- }
- 
- proc mset {vars list} {uplevel 1 "foreach {$vars} {$list} {}"}
# there are two palettes of 30 colours used in Pd
--- 184,187 ----
***************
*** 1217,1221 ****
#-----------------------------------------------------------------------------------#
! def* canvas window_title {args} {}
def canvas delete_selection {} {
--- 1257,1263 ----
#-----------------------------------------------------------------------------------#
! def* canvas window_title {title} {wm title .x$self $title}
! def* canvas add {i obj} {lset @children $i $obj}
! def* canvas del {i}     {lset @children $i ""}
def canvas delete_selection {} {
***************
*** 1916,1920 ****
  ############ rendering
! class_new view {thing}
  def* view erase {canvas} {item_delete $self $canvas}
  def* view   click     {args} {}
--- 1958,1962 ----
  ############ rendering
! class_new view {observable thing}
  def* view erase {canvas} {item_delete $self $canvas}
  def* view   click     {args} {}