From c80ad601728139c16c4903f5ed08680f7e5f203c Mon Sep 17 00:00:00 2001 From: mescalinum Date: Sun, 13 Nov 2011 22:52:33 +0000 Subject: 0.3.0 - typemaps support complete svn path=/trunk/externals/loaders/tclpd/; revision=15738 --- examples/binbuf-test.tcl | 4 ++-- examples/bitmap.tcl | 27 ++++++++++++--------------- examples/dynreceive.tcl | 14 +++++++------- examples/dynroute.tcl | 4 ++-- examples/list_change.tcl | 4 ++-- examples/properties.tcl | 8 +++++--- examples/slider2.tcl | 36 ++++++++++++++++-------------------- examples/tclpd-console.tcl | 9 +++++---- 8 files changed, 51 insertions(+), 55 deletions(-) (limited to 'examples') diff --git a/examples/binbuf-test.tcl b/examples/binbuf-test.tcl index 62fc8c1..f31c198 100644 --- a/examples/binbuf-test.tcl +++ b/examples/binbuf-test.tcl @@ -1,5 +1,5 @@ -package require Tclpd 0.2.3 -package require TclpdLib 0.19 +package require Tclpd 0.3.0 +package require TclpdLib 0.20 proc binbuf-test::constructor {self args} { pd::add_outlet $self list diff --git a/examples/bitmap.tcl b/examples/bitmap.tcl index 97b9491..64d2b92 100644 --- a/examples/bitmap.tcl +++ b/examples/bitmap.tcl @@ -1,5 +1,5 @@ -package require Tclpd 0.2.3 -package require TclpdLib 0.19 +package require Tclpd 0.3.0 +package require TclpdLib 0.20 set ::script_path [file dirname [info script]] @@ -28,6 +28,8 @@ pd::guiproc bitmap_draw_new {self c x y config data} { } proc+ bitmap::constructor {self args} { + set @canvas [canvas_getcurrent] + set s [file join $::script_path properties.tcl] sys_gui "source {$s}\n" @@ -58,17 +60,16 @@ proc+ bitmap::constructor {self args} { 0_config $self {*}$args set @rcvLoadData {#bitmap} - pd_bind [tclpd_get_instance_pd $self] [gensym $@rcvLoadData] + pd_bind $self $@rcvLoadData } proc+ bitmap::destructor {self} { - set pdself [tclpd_get_instance_pd $self] if {$@rcvLoadData != {}} { #should not happen! - pd_unbind $pdself [gensym $@rcvLoadData] + pd_unbind $self $@rcvLoadData } if {[dict get $@config -receivesymbol] != {}} { - pd_unbind $pdself $@recv + pd_unbind $self $@recv } } @@ -116,14 +117,12 @@ proc+ bitmap::0_config {self args} { set new [dict get $newconf -$opt] if {$old != $new} { if {$opt == "receivesymbol"} { - set selfpd [tclpd_get_instance_pd $self] if {$old != {}} { - pd_unbind $selfpd $@recv + pd_unbind $self $@recv } if {$new != {}} { - set @recv [canvas_realizedollar \ - [tclpd_get_glist $self] [gensym $new]] - pd_bind $selfpd $@recv + set @recv [canvas_realizedollar $@canvas $new] + pd_bind $self $@recv } else { set @recv {} } @@ -250,7 +249,7 @@ proc+ bitmap::0_setdata {self args} { set @data [list] foreach i $d {lappend @data [expr {int($i)}]} if {$@rcvLoadData != {}} { - pd_unbind [tclpd_get_instance_pd $self] [gensym $@rcvLoadData] + pd_unbind $self $@rcvLoadData set @rcvLoadData {} } } @@ -262,10 +261,8 @@ proc+ bitmap::save {self args} { proc+ bitmap::properties {self args} { set title "\[bitmap\] properties" - set x_xobj_obpd [tclpd_get_object_pd $self] - set x [tclpd_get_instance $self] set buf [list propertieswindow %s $@config $title]\n - gfxstub_new $x_xobj_obpd $x $buf + gfxstub_new $self $self $buf } proc+ bitmap::widgetbehavior_getrect {self args} { diff --git a/examples/dynreceive.tcl b/examples/dynreceive.tcl index 6903da9..ceef7a8 100644 --- a/examples/dynreceive.tcl +++ b/examples/dynreceive.tcl @@ -1,11 +1,11 @@ -package require Tclpd 0.2.3 -package require TclpdLib 0.19 +package require Tclpd 0.3.0 +package require TclpdLib 0.20 proc+ dynreceive::constructor {self args} { set @sym {} if {[pd::args] > 0} { set @sym [pd::arg 0 symbol] - pd_bind [tclpd_get_instance_pd $self] [gensym $@sym] + pd_bind $self $@sym } pd::add_outlet $self } @@ -14,7 +14,7 @@ proc+ dynreceive::destructor {self} { # don't forget to call pd_unbind, or sending things to a symbol # bound to dead object will crash pd! if {$@sym != {}} { - pd_unbind [tclpd_get_instance_pd $self] [gensym $@sym] + pd_unbind $self $@sym } } @@ -22,13 +22,13 @@ proc+ dynreceive::0_set {self args} { # send [set empty( to clear the receive symbol set s [pd::arg 0 symbol] if {$@sym != {}} { - pd_unbind [tclpd_get_instance_pd $self] [gensym $@sym] + pd_unbind $self $@sym } if {$s == {empty}} { set @sym {} } else { set @sym $s - pd_bind [tclpd_get_instance_pd $self] [gensym $@sym] + pd_bind $self $@sym } } @@ -41,7 +41,7 @@ proc+ dynreceive::0_float {self args} { } proc+ dynreceive::0_symbol {self args} { - pd::outlet $self 0 symbol [gensym [pd::arg 0 symbol]] + pd::outlet $self 0 symbol [pd::arg 0 symbol] } proc+ dynreceive::0_anything {self args} { diff --git a/examples/dynroute.tcl b/examples/dynroute.tcl index 04cb3c9..286087c 100644 --- a/examples/dynroute.tcl +++ b/examples/dynroute.tcl @@ -1,5 +1,5 @@ -package require Tclpd 0.2.3 -package require TclpdLib 0.19 +package require Tclpd 0.3.0 +package require TclpdLib 0.20 # dynroute: dynamically route messages based on first element # non-matching arguments are sent to last inlet diff --git a/examples/list_change.tcl b/examples/list_change.tcl index 26190e4..82c751d 100644 --- a/examples/list_change.tcl +++ b/examples/list_change.tcl @@ -1,5 +1,5 @@ -package require Tclpd 0.2.3 -package require TclpdLib 0.19 +package require Tclpd 0.3.0 +package require TclpdLib 0.20 proc+ list_change::constructor {self args} { # add second inlet (first created by default) diff --git a/examples/properties.tcl b/examples/properties.tcl index dc199de..cdbfc1d 100644 --- a/examples/properties.tcl +++ b/examples/properties.tcl @@ -8,9 +8,10 @@ proc propertieswindow {gfxstub_id {options {}} {title {}}} { set win $gfxstub_id set ::id($win.p) $gfxstub_id set ::optkeys($win.p) [list] + set options [string map {@ $} $options] foreach {k v} $options { if {$v eq "empty"} {set v {}} - set v [string map {\\$ $} $v] + #set v [string map {\\$ $} $v] set ::config($win.p:$k) $v lappend ::optkeys($win.p) $k } @@ -416,8 +417,9 @@ proc propertiespanel_apply {w} { if {$v == ""} {set v "empty"} lappend newconf $key $v } - set newconf [string map {$ \\$} $newconf] - pdsend "$::id($w) config $newconf" + #set newconf [string map {$ \\$} $newconf] + set newconf [string map {$ @} $newconf] + pdsend "$::id($w) config2 $newconf" } proc propertiespanel_close {w} { diff --git a/examples/slider2.tcl b/examples/slider2.tcl index 197be29..1cf1335 100644 --- a/examples/slider2.tcl +++ b/examples/slider2.tcl @@ -1,5 +1,5 @@ -package require Tclpd 0.2.3 -package require TclpdLib 0.19 +package require Tclpd 0.3.0 +package require TclpdLib 0.20 set ::script_path [file dirname [info script]] @@ -60,6 +60,7 @@ pd::guiproc slider2_update {self c x y config state} { } proc+ slider2::constructor {self args} { + set @canvas [canvas_getcurrent] pd::add_outlet $self float sys_gui "source {[file join $::script_path properties.tcl]}\n" # set defaults: @@ -78,7 +79,7 @@ proc+ slider2::constructor {self args} { proc+ slider2::destructor {self} { if {[dict get $@config -receivesymbol] != {}} { - pd_unbind [tclpd_get_instance_pd $self] $@recv + pd_unbind $self $@recv } } @@ -93,6 +94,10 @@ proc+ slider2::0_printconfig {self args} { } } +proc+ slider2::0_config2 {self args} { + uplevel "0_config $self [string map {$ @} $args]" +} + proc+ slider2::0_config {self args} { pd::post [info level 0] set newconf [list] @@ -119,21 +124,18 @@ proc+ slider2::0_config {self args} { # process -{send,receive}symbol if {[dict exists $newconf -receivesymbol]} { set new_recv [dict get $newconf -receivesymbol] - set selfpd [tclpd_get_instance_pd $self] if {[dict get $@config -receivesymbol] != {}} { - pd_unbind $selfpd $@recv + pd_unbind $self $@recv } if {$new_recv != {}} { - set @recv [canvas_realizedollar \ - [tclpd_get_glist $self] [gensym $new_recv]] - pd_bind $selfpd $@recv + set @recv [canvas_realizedollar $@canvas $new_recv] + pd_bind $self $@recv } else {set @recv {}} } if {[dict exists $newconf -sendsymbol]} { set new_send [dict get $newconf -sendsymbol] if {$new_send != {}} { - set @send [canvas_realizedollar \ - [tclpd_get_glist $self] [gensym $new_send]] + set @send [canvas_realizedollar $@canvas $new_send] } else {set @send {}} } # changing orient -> swap sizes @@ -168,8 +170,7 @@ proc+ slider2::0_config {self args} { sys_gui [list slider2_update $self $@c $@x $@y $@config $@state]\n } if {[dict exists $newconf -width] || [dict exists $newconf -height]} { - canvas_fixlinesfor \ - [tclpd_get_glist $self] [tclpd_get_instance_text $self] + canvas_fixlinesfor $@canvas $self } } @@ -221,12 +222,8 @@ proc+ slider2::properties {self} { dict set c $opt [dict get $c2 $opt] } - lappend c -foo - lappend c \$foo - - pd::post gfxstub_new [tclpd_get_object_pd $self] [tclpd_get_instance $self] \ - [list propertieswindow %s $c "\[slider2\] properties"] - gfxstub_new [tclpd_get_object_pd $self] [tclpd_get_instance $self] \ + set c [string map {$ @} $c] + gfxstub_new $self $self \ [list propertieswindow %s $c "\[slider2\] properties"]\n } @@ -278,8 +275,7 @@ proc+ slider2::widgetbehavior_click {self args} { } } set @motion_start_v [dict get $@config -initvalue] - tclpd_guiclass_grab [tclpd_get_instance $self] \ - [tclpd_get_glist $self] $x $y + tclpd_guiclass_grab $self $@canvas $x $y } } diff --git a/examples/tclpd-console.tcl b/examples/tclpd-console.tcl index 0c37904..56053cd 100644 --- a/examples/tclpd-console.tcl +++ b/examples/tclpd-console.tcl @@ -1,5 +1,5 @@ -package require Tclpd 0.2.3 -package require TclpdLib 0.19 +package require Tclpd 0.3.0 +package require TclpdLib 0.20 package require base64 @@ -49,7 +49,8 @@ proc tclpd-console::constructor {self} { set ::tclpd-console::loaded 1 set ::${self}_loaded 1 - pd_bind [tclpd_get_instance_pd $self] [gensym $self] + # beware: typemap magic (1st arg get cast to a t_pd, second to a t_symbol) + pd_bind $self $self sys_gui "set ::tclpd_console $self" sys_gui { @@ -92,7 +93,7 @@ proc tclpd-console::destructor {self} { if {[set ::${self}_loaded]} { sys_gui { destroy .pdwindow.tcl.tclpd ; unset ::tclpd_console } - pd_unbind [tclpd_get_instance_pd $self] [gensym $self] + pd_unbind $self $self # restore original puts if {[info procs puts_tclpd_console] ne {}} { -- cgit v1.2.1