1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
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 { }] ;"}
}
}
|
