diff options
| -rw-r--r-- | cursor.c | 138 | ||||
| -rw-r--r-- | cursor.tcl | 73 |
2 files changed, 84 insertions, 127 deletions
@@ -5,6 +5,7 @@ pd.tk, or cursor reset method could be done in help patch */ #include <stdlib.h> #include <string.h> #include <m_pd.h> +#include <m_imp.h> #include "g_canvas.h" #define POLLTIME 10 @@ -30,117 +31,15 @@ typedef struct _cursor // t_outlet *status_outlet; // not used (yet?) } t_cursor; -static void create_namespace(void) -{ - sys_gui("if { [namespace exists ::hcs_cursor_class]} {\n"); - sys_gui(" puts stderr {WARNING: ::hcs_cursor_class namespace exists!}\n"); - sys_gui("} else {\n"); - sys_gui(" namespace eval ::hcs_cursor_class {\n"); - sys_gui(" variable continue_pollmotion 0\n"); - sys_gui(" variable last_x 0\n"); - sys_gui(" variable last_y 0\n"); - sys_gui(" }\n"); - sys_gui("}\n"); -} - -static void create_proc_test(void) -{ - sys_gui ("if {[info commands ::hcs_cursor_class::proc_test] eq {::hcs_cursor_class::proc_test}} {"); - sys_gui(" puts stderr {WARNING: ::hcs_cursor_class::proc_test exists!}\n"); - sys_gui("} else {\n"); - sys_gui(" proc ::hcs_cursor_class::proc_test {proc_name} {\n"); - sys_gui(" if {[info commands ::hcs_cursor_class::$proc_name] eq $proc_name} {\n"); - sys_gui(" puts stderr {WARNING: ::hcs_cursor_class::$proc_name exists!}\n"); - sys_gui(" return 1\n"); - sys_gui(" } else {\n"); - sys_gui(" return 0\n"); - sys_gui(" }\n"); - sys_gui(" }\n"); - sys_gui("}\n"); -} - -/* in Pd 0.43, the internal proc changed from 'pd' to 'pdsend' */ -static void create_legacy_pd (void) -{ - post("creating legacy 'pdsend' using legacy 'pd' proc"); - sys_gui("if {[info commands pdsend] ne {pdsend}} {\n"); - sys_gui(" proc pdsend {message} {pd $message}\n"); - sys_gui("}\n"); -} - -/* idea from #tcl for a Tcl unbind */ -static void create_unbind (void) -{ - sys_gui("if { ! [::hcs_cursor_class::proc_test unbind]} {"); - sys_gui(" proc ::hcs_cursor_class::unbind {tag event script} {\n"); - sys_gui(" set bind {}\n"); - sys_gui(" foreach x [split [bind $tag $event] \"\n\"] {\n"); - sys_gui(" if {$x != $script} {\n"); - sys_gui(" lappend bind $x\n"); - sys_gui(" }\n"); - sys_gui(" }\n"); - sys_gui(" bind $tag $event {}\n"); - sys_gui(" foreach x $bind {bind $tag $event $x}\n"); - sys_gui(" }\n"); - sys_gui("}\n"); -} - -static void create_button_proc(void) -{ - sys_gui ("if { ! [::hcs_cursor_class::proc_test button]} {"); - sys_gui (" proc ::hcs_cursor_class::button {button state} {\n"); - sys_vgui(" pd [concat %s button $button $state \\;]\n", - cursor_receive_symbol->s_name); - sys_gui (" }\n"); - sys_gui ("}\n"); -} - -static void create_mousewheel_proc(void) -{ - sys_gui ("if { ! [::hcs_cursor_class::proc_test mousewheel]} {"); - sys_gui (" proc ::hcs_cursor_class::mousewheel {delta} {\n"); - sys_vgui(" pd [concat %s mousewheel $delta \\;]\n", - cursor_receive_symbol->s_name); - sys_gui (" }\n"); - sys_gui ("}\n"); -} - -static void create_motion_proc(void) -{ - sys_gui("if { ![::hcs_cursor_class::proc_test motion]} {\n"); - sys_gui (" proc ::hcs_cursor_class::motion {x y} {\n"); - sys_gui (" if { $x != $::hcs_cursor_class::last_x \\\n"); - sys_gui (" || $y != $::hcs_cursor_class::last_y} {\n"); - sys_vgui(" pd [concat %s motion $x $y \\;]\n", - cursor_receive_symbol->s_name); - sys_gui (" set ::hcs_cursor_class::last_x $x\n"); - sys_gui (" set ::hcs_cursor_class::last_y $y\n"); - sys_gui (" }\n"); - sys_gui (" }\n"); - sys_gui ("}\n"); -} - -static void create_pollmotion_proc(void) -{ - sys_gui ("if { ![::hcs_cursor_class::proc_test pollmotion]} {\n"); - sys_gui (" proc ::hcs_cursor_class::pollmotion {} {\n"); - sys_vgui(" ::hcs_cursor_class::motion [winfo pointerx .] [winfo pointery .]\n"); - sys_gui (" if {$::hcs_cursor_class::continue_pollmotion != 0} { \n"); - sys_gui (" after 10 ::hcs_cursor_class::pollmotion\n"); - sys_gui (" }\n"); - sys_gui (" }\n"); - sys_gui ("}\n"); -} - static void cursor_setmethod(t_cursor *x, t_symbol *s, int argc, t_atom *argv) { - sys_vgui("set cursor_%s \"%s\"\n", s->s_name, atom_getsymbol(argv)->s_name); + sys_vgui("set ::cursor_%s \"%s\"\n", s->s_name, atom_getsymbol(argv)->s_name); canvas_setcursor(x->parent_canvas, 0); /* hack to refresh the cursor */ } static void cursor_bang(t_cursor *x) { - sys_vgui("pd [concat %s motion [winfo pointerxy .] \\;]\n", + sys_vgui("pdsend \"%s motion [winfo pointerxy .]\"", x->receive_symbol->s_name); } @@ -153,12 +52,8 @@ static void cursor_float(t_cursor *x, t_float f) x->am_polling = 0; cursor_instances_polling--; /* if no more objects are listening, stop sending the events */ - if (cursor_instances_polling == 0) { - sys_gui("set ::hcs_cursor_class::continue_pollmotion 0 \n"); - sys_gui("::hcs_cursor_class::unbind all <ButtonPress> {::hcs_cursor_class::button %b 1}\n"); - sys_gui("::hcs_cursor_class::unbind all <ButtonRelease> {::hcs_cursor_class::button %b 0}\n"); - sys_gui("::hcs_cursor_class::unbind all <MouseWheel> {::hcs_cursor_class::mousewheel %D}\n"); - } + if (cursor_instances_polling == 0) + sys_gui("::hcs::cursor::stoppolling \n"); pd_unbind(&x->x_obj.ob_pd, cursor_receive_symbol); } } else { @@ -167,13 +62,8 @@ static void cursor_float(t_cursor *x, t_float f) pd_bind(&x->x_obj.ob_pd, cursor_receive_symbol); cursor_instances_polling++; /* if this is the first instance to start, set up Tcl binding and polling */ - if (cursor_instances_polling == 1) { - sys_gui("set ::hcs_cursor_class::continue_pollmotion 1 \n"); - sys_gui("::hcs_cursor_class::pollmotion \n"); - sys_gui("bind all <ButtonPress> {+::hcs_cursor_class::button %b 1}\n"); - sys_gui("bind all <ButtonRelease> {+::hcs_cursor_class::button %b 0}\n"); - sys_gui("bind all <MouseWheel> {+::hcs_cursor_class::mousewheel %D}\n"); - } + if (cursor_instances_polling == 1) + sys_gui("::hcs::cursor::startpolling\n"); } } } @@ -271,14 +161,8 @@ void cursor_setup(void) class_addmethod(cursor_class, (t_method)cursor_setmethod, gensym("editmode_disconnect"), A_GIMME, 0); - create_namespace(); - create_proc_test(); -/* TODO figure this out once 0.43 is released */ -/* if(PD_MAJOR_VERSION == 0 && PD_MINOR_VERSION < 43) - create_legacy_pd();*/ - create_unbind(); - create_motion_proc(); - create_pollmotion_proc(); - create_mousewheel_proc(); - create_button_proc(); + /* TODO should this use t_class->c_name? */ + sys_vgui("eval [read [open %s/cursor.tcl]]\n", + cursor_class->c_externdir->s_name); + sys_vgui("::hcs::cursor::setup %s\n", cursor_receive_symbol->s_name); } diff --git a/cursor.tcl b/cursor.tcl new file mode 100644 index 0000000..9c0a0d5 --- /dev/null +++ b/cursor.tcl @@ -0,0 +1,73 @@ + +namespace eval ::hcs::cursor:: { + variable continue_pollmotion 0 + variable last_x 0 + variable last_y 0 + variable receive_symbol +} + +# idea from #tcl for a Tcl unbind +proc ::hcs::cursor::unbind {tag event script} { + set bind {} + foreach x [split [bind $tag $event] \"\n\"] { + if {$x != $script} { + lappend bind $x + } + } + bind $tag $event {} + foreach x $bind {bind $tag $event $x} +} + +proc ::hcs::cursor::button {button state} { + variable receive_symbol + pdsend "$receive_symbol button $button $state" +} + +proc ::hcs::cursor::mousewheel {delta} { + variable receive_symbol + pdsend "$receive_symbol mousewheel $delta" +} + +proc ::hcs::cursor::motion {x y} { + variable last_x + variable last_y + variable receive_symbol + if { $x != $last_x || $y != $last_y} { + pdsend "$receive_symbol motion $x $y" + set last_x $x + set last_y $y + } +} + +proc ::hcs::cursor::pollmotion {} { + variable continue_pollmotion + motion [winfo pointerx .] [winfo pointery .] + if {$continue_pollmotion != 0} { + after 10 ::hcs::cursor::pollmotion + } +} + +proc ::hcs::cursor::startpolling {} { + variable continue_pollmotion 1 + pollmotion + bind all <ButtonPress> {+::hcs::cursor::button %b 1} + bind all <ButtonRelease> {+::hcs::cursor::button %b 0} + bind all <MouseWheel> {+::hcs::cursor::mousewheel %D} +} + +proc ::hcs::cursor::stoppolling {} { + variable continue_pollmotion 0 + unbind all <ButtonPress> {::hcs::cursor::button %b 1} + unbind all <ButtonRelease> {::hcs::cursor::button %b 0} + unbind all <MouseWheel> {::hcs::cursor::mousewheel %D} +} + +# in Pd 0.43, the internal proc changed from 'pd' to 'pdsend' +proc ::hcs::cursor::setup {symbol} { + variable receive_symbol $symbol + # check if we are Pd < 0.43, which has no 'pdsend', but a 'pd' coded in C + if {[llength [info procs "::pdsend"]] == 0} { + pdtk_post "creating 0.43+ 'pdsend' using legacy 'pd' proc" + proc ::pdsend {args} {pd "[join $args { }] ;"} + } +} |