aboutsummaryrefslogtreecommitdiff
path: root/test/toxy/kb.wid
blob: 8a081d7bfca33e43af5dc112c74fb0aecd014956 (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
proc ::toxy::kb {path target remote noctaves size} {
# guard against BadAlloc crashes
    if {$size > 10} {set size 10}
    set lft [expr {round(5 * $size)}]
    set top [expr {round(5 * $size)}]
    set bot [expr {round(100 * $size)}]
    set dx [expr {round(17 * $size)}]
    set wid [expr {round($dx - $size * .5)}]
    set blbot [expr {round($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} {
    pd [concat $target _cb $::toxy::kbval($target) \;]
    if {$remote != "."} {
	pd [concat $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
}

#> 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}" from the setup.wid
bind .- <FocusIn> {focus .^.c}