From 8303218509a59630ec4c3a31aed0b5264e977500 Mon Sep 17 00:00:00 2001
From: mescalinum <mescalinum@users.sourceforge.net>
Date: Thu, 13 Oct 2011 23:35:44 +0000
Subject: some binbuf support. dollar-args still not working properly

svn path=/trunk/externals/loaders/tclpd/; revision=15592
---
 pdlib.tcl     | 18 ++++++++++++++++++
 tcl_extras.h  |  3 +++
 tcl_typemap.c | 17 +++++++++++++++++
 3 files changed, 38 insertions(+)

diff --git a/pdlib.tcl b/pdlib.tcl
index f490289..4c45cb5 100644
--- a/pdlib.tcl
+++ b/pdlib.tcl
@@ -256,5 +256,23 @@ namespace eval ::pd {
         # upload proc
         sys_gui "guiproc $name $argz $body\n"
     }
+
+    proc get_binbuf {self} {
+        set binbuf [tclpd_get_object_binbuf $self]
+        set len [binbuf_getnatom $binbuf]
+        set result {}
+        for {set i 0} {$i < $len} {incr i} {
+            set atom [tclpd_binbuf_get_atom $binbuf $i]
+            set selector [atom_type_string $atom]
+            set value {?}
+            if {$selector == "float"} {
+                set value [atom_float_value $atom]
+            } elseif {$selector == "symbol"} {
+                set value [atom_symbol_value $atom]
+            }
+            lappend result [list $selector $value]
+        }
+        return $result
+    }
 }
 
diff --git a/tcl_extras.h b/tcl_extras.h
index e2406b9..2ae0116 100644
--- a/tcl_extras.h
+++ b/tcl_extras.h
@@ -47,6 +47,9 @@ extern int Tclpd_SafeInit(Tcl_Interp *interp);
 /* tcl_typemap.cxx */
 int pd_to_tcl(t_atom* input, Tcl_Obj** output);
 int tcl_to_pd(Tcl_Obj* input, t_atom* output);
+const char* atom_type_string(t_atom* a);
+const char* atom_symbol_value(t_atom* a);
+float atom_float_value(t_atom* a);
 
 /* tcl_setup.cxx */
 extern Tcl_Interp* tcl_for_pd;
diff --git a/tcl_typemap.c b/tcl_typemap.c
index 4044afb..94c3aa0 100644
--- a/tcl_typemap.c
+++ b/tcl_typemap.c
@@ -28,6 +28,23 @@ int tcl_to_pd(Tcl_Obj *input, t_atom *output) {
     return TCL_OK;
 }
 
+const char* atom_type_string(t_atom* a) {
+    switch(a->a_type) {
+    case A_FLOAT: return "float";
+    case A_SYMBOL: return "symbol";
+    case A_POINTER: return "pointer";
+    default: return "???";
+    }
+}
+
+const char* atom_symbol_value(t_atom* a) {
+    return a->a_w.w_symbol->s_name;
+}
+
+float atom_float_value(t_atom* a) {
+    return a->a_w.w_float;
+}
+
 int pd_to_tcl(t_atom *input, Tcl_Obj **output) {
     Tcl_Obj* tcl_t_atom[2];
 #ifdef DEBUG
-- 
cgit v1.2.1