aboutsummaryrefslogtreecommitdiff
path: root/test/toxy/default.wid
blob: abe9a5a531828a5382f89db51eedcc342a9b74dd (plain)
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
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
# first the setup stuff (is this the right place for it?)

# LATER ask for adding something of the sort to pd.tk:
bind Canvas <1> {+focus %W}

proc ::toxy::itemleave {path target varname} {
    if {[catch {$path get} ::toxy::itemvalue] == 0} {
	set $varname $::toxy::itemvalue
# LATER try sending only if changed
	pd $target.rp _value $::toxy::itemvalue \;
    }
}

proc ::toxy::itemvis {tkclass path target name varname cvpath px py} {
    set ::toxy::itemfailure [catch {$tkclass $path} ::toxy::itemerrmess]
    if {$::toxy::itemfailure} {
	pd $target.rp _failure $::toxy::itemerrmess \;
    } else {

	if {[info exists ::toxy::itemoptions]} {
	    catch {eval $path config $::toxy::itemoptions}
	    unset ::toxy::itemoptions
	}

	$cvpath create window $px $py \
	    -anchor nw -window $path -tags [concat toxy$name $target]

	if {[info exists ::toxy::masterinits]} {
	    catch {eval $::toxy::masterinits}
	    unset ::toxy::masterinits
	}
	if {[info exists ::toxy::typeinits]} {
	    catch {eval $::toxy::typeinits}
	    unset ::toxy::typeinits
	}
	if {[info exists ::toxy::iteminits]} {
	    catch {eval $::toxy::iteminits}
	    unset ::toxy::iteminits
	}

	pd $target.rp _config $target.rp [$path cget -bg] \
	    [winfo reqwidth $path] [winfo reqheight $path] \
	    [catch {$path config -state normal}]\;

# LATER think where to plug this in
	bind $path <Leave> [concat ::toxy::itemleave $path $target $varname]
	if {[info exists $varname]} {
	    catch {eval $path set $$varname}
	    unset $varname
	}
    }
}

proc ::toxy::popup {path target remote entries args} {
    eval {menu $path.pop} $args
    set i 1
    foreach e $entries {
	$path.pop add command -label [lindex $e 0] \
	    -command [concat ::toxy::callback $target \
		-text [lindex $e [expr {[llength $e] > 1}]] \; \
		::toxy::callback $remote $i]
	incr i
    }
}

proc ::toxy::kb {path target remote noctaves size} {
    set lft [expr {round(5 * $size)}]
    set top [expr {5 * $size}]
    set bot [expr {100 * $size}]
    set dx [expr {round(17 * $size)}]
    set wid [expr {$dx - $size * .5}]
    set blbot [expr {$bot * .65}]

    $path config -height [expr {$bot + $top}] \
	-width [expr {$dx * ($noctaves * 7 + 1) + $lft * 2 - 1}]

    for {set octave 0} {$octave <= $noctaves} {incr octave} {
	set prevkey 0
	foreach key {0 2 4 5 7 9 11} {
	    set ndx [expr $octave * 12 + $key]
	    set id [$path create rect $lft $top \
		[expr {$lft + $wid}] $bot -fill white -tags $path.$ndx]
	    $path bind $id <1> [concat ::toxy::kbset \
		$path $target $remote $ndx]
	    if {$key - $prevkey > 1} {
		incr ndx -1
		set x [expr {$lft - $wid * .22}]
		set id [$path create rect $x $top [expr {$x + $wid * .44}] \
		    $blbot -fill black -tags $path.$ndx]
		$path bind $id <1> [concat ::toxy::kbset \
		    $path $target $remote $ndx]
	    }
	    set prevkey $key
	    incr lft $dx
	    if {$octave == $noctaves && $key == 0} break
	}
    }
    set ::toxy::kbval($target) 0
    set ::toxy::kbcol($target) white
    $path itemconfig $path.0 -fill grey
}

proc ::toxy::kbout {path target remote} {
    ::toxy::callback $target _cb $::toxy::kbval($target)
    if {$remote != "."} {::toxy::callback $remote $::toxy::kbval($target)}
}

proc ::toxy::kbset {path target remote value} {
    $path itemconfig $path.$::toxy::kbval($target) \
	-fill $::toxy::kbcol($target)
    set ::toxy::kbval($target) $value
    set ::toxy::kbcol($target) [lindex [$path itemconfig $path.$value -fill] 4]
    $path itemconfig $path.$value -fill grey
    ::toxy::kbout $path $target $remote
}

# the default initializer
#> default

# pdtk_canvas_mouseup is a hack, which we must call anyway
bind .- <ButtonRelease> {
 eval .<|_inout 1.>
 pdtk_canvas_mouseup .^.c [expr %x + [winfo x %W]] [expr %y + [winfo y %W]] %b
}

bind .- <1> .<|_click %x %y %b 0.>
bind .- <3> .<|_click %x %y %b 8.>
bind .- <Motion> .<|_motion %x %y.>
bind .- <Enter> .<|_inout 1.>
bind .- <Leave> .<|_inout 0.>

#> bang button
#. -image ::toxy::img::empty -command .<.>
#. -bg pink -activebackground red -width 50 -height 50
#. @bang .- flash .: .- invoke

#> float scale
#. -command .<.> -bg pink -activebackground red -length 200
#. @float .- set .#1

#> symbol entry
#. -bg pink -font .(helvetica 24.) -width 16
#. @symbol .- delete 0 end .: .- insert 0 .#1

bind .- <Return> {eval .<[.- get].>; focus .^.c}

#> kb canvas
#. -bg yellow -cursor hand1
#. #oct 4 #size .75
#. @bang ::toxy::kbout .- .| .
#. @float ::toxy::kbset .- .| . .#1

::toxy::kb .- .| . .#oct .#size

# undo the "bind Canvas <1> {+focus %W}" in the setup part above
bind .- <FocusIn> {focus .^.c}