adding chords to kbd

svn path=/trunk/; revision=3081

5 files changed, 202 insertions, 308 deletions

diff --git a/extensions/gui/ix/kbd-demo.pd b/extensions/gui/ix/kbd-demo.pd
index 896c3aa5..82765a8d 100755
--- a/extensions/gui/ix/kbd-demo.pd
+++ b/extensions/gui/ix/kbd-demo.pd
@@ -20,7 +20,7 @@
 #X floatatom 115 14 5 0 1 0 - - -;
 #X floatatom 149 21 5 0 12 0 - - -;
 #X msg 148 38 #octaves \$1;
-#X obj 165 140 widget kbd2 k2 #octaves 3 #bg purple #fg pink -height
+#X obj 165 140 widget kbd k2 #octaves 3 #bg purple #fg pink -height
 32;
 #X obj 56 174 + 36;
 #X connect 0 0 1 0;
diff --git a/extensions/gui/ix/kbd.wid b/extensions/gui/ix/kbd.wid
index 2131562f..ab5f6a7f 100755
--- a/extensions/gui/ix/kbd.wid
+++ b/extensions/gui/ix/kbd.wid
@@ -1,95 +1,39 @@
 namespace eval ::ix {

-variable kbd_lastplayed

+    proc kbd_play {t m b x y} {

+	variable _

+	foreach a {{rs {0 sunken 1 raised}} {sr {0 raised 1 sunken}} {v {0 0 1 {($y - [winfo rooty $w]) / ([winfo height $w] + 0.0)}}}} {array set [lindex $a 0] [lindex $a 1]}

+	set w [winfo containing $x $y]; set tp $t.rp

+	if {$m != 1 && $_($t:lp) != -1 && $_($t:lp) ne $w} {

+	    $_($t:lp) config -relief raised;pd "$tp _cb [winfo name $_($t:lp)] 0 \;"}

+	if {[$w cget -relief] eq $rs($b)} {

+	    eval $w config -relief $sr($b); pd "$tp _cb [winfo name $w] [eval expr $v($b)] \;"}

+	set _($t:lp) $w}

 

-proc kbd_click {target w h} {

-    set height [winfo height $w]

-    set vel [expr $h.0 / $height.0]

-    variable kbd_lastplayed

-    set kbd_lastplayed $w

-    kbd_down $target $w $vel

-}

-proc kbd_down {target w vel} {

-    pd "$target.rp _cb [winfo name $w] $vel;"

-    $w conf -relief sunken

-}

-proc kbd_up {target w} {

-    pd "$target.rp _cb [winfo name $w] 0;"

-    $w conf -relief raised

-}

-proc kbd_release {target} {

-    variable kbd_lastplayed

-    if {$kbd_lastplayed != {}} {kbd_up $target $kbd_lastplayed}

-}

-proc kbd_key {path target count vel key} {

-    set w $path.f[expr $key / 12].$key

-    if {$vel > 0} {kbd_down $target $w $vel}

-    if {$vel == 0} {kbd_up $target $w}

-}

-proc kbd_fkey {path target count key} {

-    set w $path.f[expr $key / 12].$key

-    kbd_down $target $w 1

-    kbd_up $target $w

-}

+    proc kbd_off {p t octaves} {

+	for {set o 0} {$o < $octaves} {incr o} {	

+	    for {set on 0} {$on < 12} {incr on} {

+		set no [expr $o * 12 + $on]

+	        if {[$p.f$o.$no cget -relief] eq "sunken"} {

+		    $p.f$o.$no config -relief raised

+		    pd "$t.rp _cb $no 0 \;"}}}}

 

-proc kbd_drag {target x y} {

-    variable kbd_lastplayed

-    set w [winfo containing $x $y]

-    if { $w == "" } { kbd_release $target; set kbd_lastplayed {}; return }

-    if { $w == $kbd_lastplayed } return

-    if {[lsearch -exact [bindtags $w] key ] == -1 } {

-	kbd_release $target

-	set kbd_lastplayed {}; return

-    } 

-    kbd_release $target

-    set h [expr $y - [winfo rooty $w]]

-    kbd_click $target $w $h

-}

-proc kbd_white {w t p} { set t {}

-    label $w -text $t -background white -foreground black \

-				     -borderwidth 1 -relief raised 

-    place $w -relx $p -y 0 -relwidth 0.142857 -relheight 1

-    bindtags $w {key}

-    lower $w

-}

-proc kbd_black {w t p} { set t {}

-    label $w -text $t -background black -foreground white \

-			     -borderwidth 1 -relief raised 

-    place $w -relx $p -y 0 -relwidth 0.1 -relheight 0.6 -anchor n

-    bindtags $w {key}

-}

-proc kbd {path target octaves} {

-    if {[winfo exists $path.f0] != 1} {

-#    foreach oct [winfo children $path] {destroy $oct}

-	$path config -width [expr $octaves * 66]

-	for {set o 0} {$o < $octaves} {incr o} {

-	    set w $path.f$o

-	    frame $w -bd 0 -height 66 -width 66

-	    kbd_white $w.[expr $o * 12]  C  0.0

-	    kbd_black $w.[expr $o * 12 + 1]  C# 0.142857

-	    kbd_white $w.[expr $o * 12 + 2]  D  0.142857

-	    kbd_black $w.[expr $o * 12 + 3]  D# 0.285714

-	    kbd_white $w.[expr $o * 12 + 4]  E  0.285714

-	    kbd_white $w.[expr $o * 12 + 5]  F  0.428571

-	    kbd_black $w.[expr $o * 12 + 6]  F# 0.571428

-	    kbd_white $w.[expr $o * 12 + 7]  G  0.571428

-	    kbd_black $w.[expr $o * 12 + 8]  G# 0.714285

-	    kbd_white $w.[expr $o * 12 + 9]  A  0.714285

-	    kbd_black $w.[expr $o * 12 + 10] A# 0.857142

-	    kbd_white $w.[expr $o * 12 + 11] H  0.857142

-	    place $w -y 0 -relheight 1.0 -relx [expr $o / $octaves.0] -relwidth [expr 1 / $octaves.0]

-	}

-    }

-}

+    proc kbd {path t octaves b f} {

+	if {![winfo exists $path.f0]} {

+	    variable _

+	    set _($t:lp) -1

+	    $path config -width [expr $octaves * 66]

+	    set bw {0 1 0 1 0 0 1 0 1 0 1 0} ; set npl {0 1 1 2 2 3 4 4 5 5 6 6}

+	    foreach a {{bg "0 $b 1 $f"} {fg "1 $b 0 $f"} {an {0 ";lower $wk" 1 "-anchor n"}} {rw {0 {[expr 1 / 7.]} 1 {[expr 1 / 10.]}}} {rh {0 {[expr 1.]} 1 {[expr 6 / 10.]}}}} {array set [lindex $a 0] [lindex $a 1]}

+	    for {set o 0} {$o < $octaves} {incr o} {

+		set w $path.f$o ; frame $w -bd 0 -height 66 -width 66

+		for {set on 0} {$on < 12} {incr on} {

+		    set wk $w.[expr $o * 12 + $on] ; set n [lindex $bw $on]

+		    eval "label $wk -bg $bg($n) -fg $fg($n) -bd 1 -relief raised;place $wk -relx [expr [lindex $npl $on] / 7.] -y 0 -relwidth $rw($n) -relheight $rh($n) $an($n)"

+		    bind $wk <1> "::ix::kbd_play $t 0 1 %X %Y"; bind $wk <B1-Motion> [bind $wk <1>];bind $wk <ButtonRelease-1> "::ix::kbd_play $t 0 0 %X %Y"; bind $wk <Enter> "::ix::kbd_play $t 1 0 %X %Y"; bind $wk <3> "::ix::kbd_play $t 1 1 %X %Y"; bind $wk <B3-Motion> [bind $wk <3>]; bind $wk <2> "::ix::kbd_off $path $t $octaves"}

+		place $w -y 0 -relheight 1.0 -relx [expr $o / $octaves.0] -relwidth [expr 1 / $octaves.0]}}}}

 

-}

 #> kbd frame

 #. -height 100 -width 60

-#. #octaves 6

-#. @list ::ix::kbd_key .- .| .#n .#2 .#1

-#. @float ::ix::kbd_fkey .- .| .#n .#1

-puts "kbd .- .|"

-::ix::kbd .- .| .#octaves

+#. #octaves 6 #bg black #fg white

 

-bind key <1> {::ix::kbd_click .| %W %y}

-bind key <B1-Motion> {::ix::kbd_drag .| %X %Y}

-bind key <ButtonRelease-1> {::ix::kbd_release .|}

+::ix::kbd .- .| .#octaves .#bg .#fg

diff --git a/extensions/gui/ix/kbd2.wid b/extensions/gui/ix/kbd2.wid
deleted file mode 100755
index 59d22ec8..00000000
--- a/extensions/gui/ix/kbd2.wid
+++ /dev/null
@@ -1,36 +0,0 @@
-namespace eval ::ix {

-    proc kbd2_play {b x y} {

-	array set rs {0 sunken 1 raised} ; array set sr {0 $rs(1) 1 $rs(0)}

-	array set v {0 0 1 {($y - [winfo rooty $w]) / ([winfo height $w] + 0.0)}}

-	set w [winfo containing $x $y]

-	if {[$w cget -relief] eq $rs($b)} {

-	    eval $w config -relief $sr($b)

-	    pd "[winfo name [winfo parent [winfo parent $w]]].rp _cb  [winfo name $w] [eval expr $v($b)] \;"}}

-

-    proc kbd2 {path target octaves b f} {

-	if {![winfo exists $path.f0]} {

-	    $path config -width [expr $octaves * 66]

-	    set bw {0 1 0 1 0 0 1 0 1 0 1 0} ; set npl {0 1 1 2 2 3 4 4 5 5 6 6}

-	    array set bg "0 $b 1 $f"

-	    array set fg {1 $bg(0) 0 $bg(1)}

-	    array set rw {0 {[expr 1 / 7.]} 1 {[expr 1 / 10.]}}

-	    array set rh {0 {[expr 1.]} 1 {[expr 6 / 10.]}}

-	    array set an {0 ";lower $wk" 1 "-anchor n"}

-	    for {set o 0} {$o < $octaves} {incr o} {

-		set w $path.f$o

-		frame $w -bd 0 -height 66 -width 66

-		for {set on 0} {$on < 12} {incr on} {

-		    set wk $w.[expr $o * 12 + $on]

-		    set n [lindex $bw $on]

-		    eval label $wk -bg $bg($n) -fg $fg($n) -bd 1 -relief raised 

-		    eval place $wk -relx [expr [lindex $npl $on] / 7.] -y 0 -relwidth $rw($n) -relheight $rh($n) $an($n)

-		    bind $wk <1> {::ix::kbd2_play 1 %X %Y}; bind $wk <B1-Motion> [bind $wk <1>]

-		    bind $wk <ButtonRelease-1> {::ix::kbd2_play 0 %X %Y}; bind $wk <Leave> [bind $wk <ButtonRelease-1>]}

-		place $w -y 0 -relheight 1.0 -relx [expr $o / $octaves.0] -relwidth [expr 1 / $octaves.0]}}}}

-

-#> kbd2 frame

-#. -height 100 -width 60

-#. #octaves 6 #bg black #fg white

-

-#@ new

-::ix::kbd2 .- .| .#octaves .#bg .#fg

diff --git a/extensions/gui/ix/mat-demo.pd b/extensions/gui/ix/mat-demo.pd
index 389c2340..9ca22010 100755
--- a/extensions/gui/ix/mat-demo.pd
+++ b/extensions/gui/ix/mat-demo.pd
@@ -1,55 +1,73 @@
-#N canvas 25 146 920 1008 12;
-#X obj 17 12 widget mat n1 #w 881 #bg white #divX 8 #divY 5 #h 740
+#N canvas 25 0 920 1029 12;
+#X obj 17 22 widget mat n1 #w 881 #bg white #divX 8 #divY 5 #h 740
 #Yb 1 #Ya 88 #qYv 2 #qYa 8;
-#X msg 1080 -23 -height 26 -width 26 -bg gray95;
-#X msg 19 -10 redefine;
-#X msg 229 -9 #w \$1;
-#X msg 193 -10 #h \$1;
-#X floatatom 159 -11 5 0 0 0 - - -;
-#X floatatom 127 -9 5 0 0 0 - - -;
-#X obj 84 767 widget kbd k1 #octaves 7 -width 483 -height 76;
-#X obj 85 846 unpack 0 0;
-#X obj 134 868 * 127;
-#X obj 85 892 pack 0 0;
-#X msg 447 679 #w \$1 \, #h \$1;
-#X floatatom 453 662 5 0 0 0 - - -;
-#X obj 85 867 + 36;
-#X obj 574 858 rp ss s1;
-#X obj 632 787 rr ss;
-#X obj 632 768 rg;
-#X obj 17 761 route note;
-#X msg 317 -8 #Ya 1 \, #Yb 128 \, #qYv 8;
-#X msg 460 -9 #Ya 88 \, Yb 24 \, #qYv 2;
-#X obj 9 826 unpack f f f;
-#X obj 37 861 * 127;
-#X obj 16 891 pack f f f;
-#X obj 18 948 print note;
-#X obj 73 917 makenote 99 250;
-#X obj 88 948 noteout;
-#X connect 0 0 17 0;
+#X msg 1080 -13 -height 26 -width 26 -bg gray95;
+#X msg 19 0 redefine;
+#X msg 229 1 #w \$1;
+#X msg 193 0 #h \$1;
+#X floatatom 159 -1 5 0 0 0 - - -;
+#X floatatom 127 1 5 0 0 0 - - -;
+#X obj 121 879 * 127;
+#X msg 447 689 #w \$1 \, #h \$1;
+#X floatatom 453 672 5 0 0 0 - - -;
+#X obj 85 877 + 36;
+#X obj 577 798 rr ss;
+#X obj 577 779 rg;
+#X obj 17 771 route note;
+#X msg 460 1 #Ya 88 \, Yb 24 \, #qYv 2;
+#X obj 9 836 unpack f f f;
+#X obj 37 871 * 127;
+#X obj 16 901 pack f f f;
+#X obj 18 958 print note;
+#X obj 73 927 makenote 99 250;
+#X obj 92 961 noteout;
+#X msg 317 2 #Ya 1 \, #Yb 128 \, #qYv 8;
+#X obj 535 833 rp ss kbd;
+#X obj 591 833 rp ss kb2;
+#X obj 109 775 widget kbd k1 #bg blue #fg green -height 32;
+#X obj 207 823 widget kbd k2 #bg blue #fg green -height 32;
+#X obj 97 854 unpack 0 0;
+#X obj 98 897 pack 0 0 1;
+#X obj 211 894 * 127;
+#X obj 175 892 + 36;
+#X obj 187 869 unpack 0 0;
+#X obj 188 912 pack 0 0 2;
+#X msg 283 874 redefine;
+#X msg 414 885 #bg blue \, #fg green;
+#X obj 115 818 print a;
+#X connect 0 0 13 0;
 #X connect 2 0 0 0;
 #X connect 3 0 0 0;
 #X connect 4 0 0 0;
 #X connect 5 0 3 0;
 #X connect 6 0 4 0;
-#X connect 7 0 8 0;
-#X connect 7 0 14 0;
-#X connect 8 0 13 0;
-#X connect 8 1 9 0;
-#X connect 9 0 10 1;
-#X connect 10 0 25 0;
+#X connect 7 0 27 1;
+#X connect 9 0 8 0;
+#X connect 10 0 27 0;
 #X connect 12 0 11 0;
-#X connect 13 0 10 0;
-#X connect 14 0 7 0;
-#X connect 16 0 15 0;
-#X connect 17 0 20 0;
-#X connect 18 0 0 0;
-#X connect 19 0 0 0;
-#X connect 20 0 22 0;
-#X connect 20 1 21 0;
-#X connect 20 2 22 2;
-#X connect 21 0 22 1;
-#X connect 22 0 23 0;
-#X connect 22 0 24 0;
-#X connect 24 0 25 0;
-#X connect 24 1 25 1;
+#X connect 13 0 15 0;
+#X connect 14 0 0 0;
+#X connect 15 0 17 0;
+#X connect 15 1 16 0;
+#X connect 15 2 17 2;
+#X connect 16 0 17 1;
+#X connect 17 0 18 0;
+#X connect 17 0 19 0;
+#X connect 19 0 20 0;
+#X connect 19 1 20 1;
+#X connect 21 0 0 0;
+#X connect 24 0 26 0;
+#X connect 24 0 34 0;
+#X connect 25 0 30 0;
+#X connect 26 0 10 0;
+#X connect 26 1 7 0;
+#X connect 27 0 20 0;
+#X connect 28 0 31 1;
+#X connect 29 0 31 0;
+#X connect 30 0 29 0;
+#X connect 30 1 28 0;
+#X connect 31 0 20 0;
+#X connect 32 0 24 0;
+#X connect 32 0 25 0;
+#X connect 33 0 25 0;
+#X connect 33 0 24 0;
diff --git a/extensions/gui/ix/mat.wid b/extensions/gui/ix/mat.wid
index 79c0594b..a4e743fa 100755
--- a/extensions/gui/ix/mat.wid
+++ b/extensions/gui/ix/mat.wid
@@ -1,118 +1,111 @@
 package require tkpath

 namespace eval ::ix {

     proc random_int {} {return [expr "int(floor(rand()*16))"]}

-    proc random_clr {} {

-        return [format "\#%1X%1X%1X%1X%1X%1X" [random_int] [random_int] [random_int] [random_int] [random_int] [random_int]]

-    }

-    variable _

+    proc random_clr {} {return [format "\#%1X%1X%1X%1X%1X%1X" [random_int] [random_int] [random_int] [random_int] [random_int] [random_int]]}

+

     proc mat_note {p t item} {

+	variable _

 	set id [lindex [$p.m itemcget $item -tags] 1]

 	set len [expr [lindex $_($t:items:$id) 2] - [lindex $_($t:items:$id) 0]]

 	set vel [$p.m itemcget $item -fillopacity]

-	pd [concat $t.rp _cb note [lindex $_($t:items:$id) 1] $vel $len \;]

-    }

-    proc mat_click {button action p t x y} {

+	pd [concat $t.rp _cb note [lindex $_($t:items:$id) 1] $vel $len \;]}

+

+    proc mat_click {m button action p t x y} {

 	variable _

-	set clicked [$p.m find overlapping $x $y $x $y]

-	switch $action {

-	    hover {

-		foreach item $clicked {

-		    if {[lindex [$p.m itemcget $item -tags] 0] eq "item"} {

-			mat_note $p $t $item

-		    }

-		}

-	    }

-	    first {

-#		if {$clicked ne ""} {

-		    set _($t:cl) $clicked

-#		}

-		foreach xy {x y}  {set _($t:f$xy) [set $xy]}

-	    }

-	    motion {

-		set mx [expr $x - $_($t:cx)]

-		set my [expr $y - $_($t:cy)]

-		foreach xy {x y} {

-		    set mvt [mat_tr $p $t $xy d [expr $$xy - $_($t:c$xy)]]

-		    switch $button {

-			1 {

-			    foreach ab {a b} {

-				set _($t:${xy}$ab) [expr $_($t:${xy}$ab) - $mvt]   

+	switch $m {

+	    control {mat_draw $action $p $t $x $y}	    

+	    "" {

+		set clicked [$p.m find overlapping $x $y $x $y]

+		switch $action {

+		    hover {

+			foreach item $clicked {

+			    if {[lindex [$p.m itemcget $item -tags] 0] eq "item"} {

+				mat_note $p $t $item

 			    }

 			}

-			2 {

-			    set _($t:${xy}a) [expr $_($t:${xy}a) - $mvt]

-			    set _($t:${xy}b) [expr $_($t:${xy}b) + $mvt]

-			}

 		    }

-		}

-		switch $button {

-		    1 {			    

-			if {$clicked ne ""} {

-			    set items $clicked

-			} else {

-			    set items [$p.m find withtag item] 			   

-			    mat_gridlines $p $t

-			}

-			foreach item $items {

-			    set m [$p.m itemcget $item -matrix]

-			    set m [list [lindex $m 0] [lindex $m 1] [list [expr [lindex [lindex $m 2] 0] + $mx] [expr [lindex [lindex $m 2] 1] + $my]]]

-			    $p.m itemconfigure $item -matrix $m

-			}

-		    }

-		    2 {

-			foreach item [$p.m find withtag item] {

-			    set id [lindex [$p.m itemcget $item -tags] 1]

-			    set px [mat_tr $p $t x t [lindex $_($t:items:$id) 0]]

-			    set py [mat_tr $p $t y t [lindex $_($t:items:$id) 1]]

-			    set sx [mat_tr $p $t x id [expr [lindex $_($t:items:$id) 2] - [lindex $_($t:items:$id) 0]]]

-#			    set sy [mat_tr $p $t y id [expr [lindex $_($t:items:$id) 3] - [lindex $_($t:items:$id) 1]]]

-			    set sy [mat_tr $p $t y id 1]

-			    $p.m coords $item [::tkpath::coords rect $px $py $sx $sy -rx 3 -ry 3]

-			}

-			mat_gridlines $p $t

+		    first {

+			#		if {$clicked ne ""} {

+			set _($t:cl) $clicked

+			#		}

+			foreach xy {x y}  {set _($t:f$xy) [set $xy]}

 		    }

-		    3 {

-			set velo [expr ($x - $_($t:cx)) / 100.0]

-			foreach item $_($t:cl) {

-			    set vel [expr $velo + [$p.m itemcget $item -fillopacity]]

-			    if {$vel > 1} {set vel 1}

-			    if {$vel < 0} {set vel 0}

-			    $p.m itemconfigure $item -fillopacity $vel

+		    motion {

+			set mx [expr $x - $_($t:cx)]

+			set my [expr $y - $_($t:cy)]

+			foreach xy {x y} {

+			    set mvt [mat_tr $p $t $xy d [expr $$xy - $_($t:c$xy)]]

+			    switch $button {

+				1 {

+				    foreach ab {a b} {

+					set _($t:${xy}$ab) [expr $_($t:${xy}$ab) - $mvt]   

+				    }

+				}

+				2 {

+				    set _($t:${xy}a) [expr $_($t:${xy}a) - $mvt]

+				    set _($t:${xy}b) [expr $_($t:${xy}b) + $mvt]

+				}

+			    }

 			}

+			switch $button {

+			    1 {			    

+				if {$clicked ne ""} {

+				    set items $clicked

+				} else {

+				    set items [$p.m find withtag item] 			   

+				    mat_gridlines $p $t

+				}

+				foreach item $items {

+				    set m [$p.m itemcget $item -matrix]

+				    set m [list [lindex $m 0] [lindex $m 1] [list [expr [lindex [lindex $m 2] 0] + $mx] [expr [lindex [lindex $m 2] 1] + $my]]]

+				    $p.m itemconfigure $item -matrix $m

+				}

+			    }

+			    2 {

+				foreach item [$p.m find withtag item] {

+				    set id [lindex [$p.m itemcget $item -tags] 1]

+				    set px [mat_tr $p $t x t [lindex $_($t:items:$id) 0]]

+				    set py [mat_tr $p $t y t [lindex $_($t:items:$id) 1]]

+				    set sx [mat_tr $p $t x id [expr [lindex $_($t:items:$id) 2] - [lindex $_($t:items:$id) 0]]]

+				    #			    set sy [mat_tr $p $t y id [expr [lindex $_($t:items:$id) 3] - [lindex $_($t:items:$id) 1]]]

+				    set sy [mat_tr $p $t y id 1]

+				    $p.m coords $item [::tkpath::coords rect $px $py $sx $sy -rx 3 -ry 3]

+				}

+				mat_gridlines $p $t

+			    }

+			    3 {

+				set velo [expr ($x - $_($t:cx)) / 100.0]

+				foreach item $_($t:cl) {

+				    set vel [expr $velo + [$p.m itemcget $item -fillopacity]]

+				    if {$vel > 1} {set vel 1}

+				    if {$vel < 0} {set vel 0}

+				    $p.m itemconfigure $item -fillopacity $vel

+				}

+			    }

+			}			

 		    }

-		}			

+		}

+		foreach xy {x y}  {set _($t:c$xy) [set $xy]}

 	    }

 	}

-	foreach xy {x y}  {set _($t:c$xy) [set $xy]}

     }

     

     proc mat_draw {action p t x y} {

 	variable _

 	switch $action {

 	    motion {

-		if {$x >= $_($t:cx)} {

-		    set xa $_($t:cx)

-		    set xb $x

-		} else {

-		    set xa $x

-		    set xb $_($t:cx)

-		}

+		if {$x >= $_($t:cx)} {set xa $_($t:cx);set xb $x} else {set xa $x;set xb $_($t:cx)}

 		$p.m coords drawing [::tkpath::coords rect $xa $y [expr $xb - $xa] [mat_tr $p $t y id 1] -rx 3 -ry 3]

 		set yi [mat_tr $p $t y i $y]

 		set _($t:items:$_($t:i)) [list [mat_tr $p $t x i $xa] $yi [mat_tr $p $t x i $xb] $yi]

-#		pd [concat $t.rp _cb note $yi \;]

-	    }

+		pd [concat $t.rp _cb note $yi 0.8 \;]}

 	    first {

 		foreach xy {x y}  {set _($t:c$xy) [set $xy]}

-		$p.m create path [::tkpath::coords rect $_($t:cx) $_($t:cy) 0 0 -rx 3 -ry 3] -tags drawing -fill green -fillopacity 0.8

-	    }

+		$p.m create path [::tkpath::coords rect $_($t:cx) $_($t:cy) 0 0 -rx 3 -ry 3] -tags drawing -fill green -fillopacity 0.8}

 	    release {

 		$p.m itemconfigure drawing -tags [list item $_($t:i)] -matrix {{1.0 0.0} {0.0 1.0} {0.0 0.0}}

-		incr _($t:i) 2

-	    }

-	}

+		incr _($t:i) 2}}}

 

-    }

     proc mat_tr {p t d inv v} {

 	variable _

 	array set dm {x width y height}

@@ -120,55 +113,31 @@ namespace eval ::ix {
 	    t {return [expr ($v - $_($t:${d}a)) / ($_($t:${d}b) - $_($t:${d}a) + 0.0) * [winfo $dm($d) $p.m]]}

 	    i {return [expr ($_($t:${d}b) - $_($t:${d}a)) * $v /([winfo $dm($d) $p.m] + 0.0) + $_($t:${d}a)]}

 	    d {return [expr ($_($t:${d}b) - $_($t:${d}a)) * $v /([winfo $dm($d) $p.m] + 0.0)]}

-#	    id {return [expr $v / ($_($t:${d}b) - $_($t:${d}a) + 0.0) * [winfo $dm($d) $p.m]]}

-	    id {return [expr abs($v / ($_($t:${d}b) - $_($t:${d}a) + 0.0) * [winfo $dm($d) $p.m])]}

-	}

-    }

+	    #	    id {return [expr $v / ($_($t:${d}b) - $_($t:${d}a) + 0.0) * [winfo $dm($d) $p.m]]}

+	    id {return [expr abs($v / ($_($t:${d}b) - $_($t:${d}a) + 0.0) * [winfo $dm($d) $p.m])]}}}

+

     proc mat_zoomReset {p t} {

 	variable _

-	set _($t:ya) $_($t:yao)

-	set _($t:yb) $_($t:ybo)

-	set _($t:xa) $_($t:xao)

-	set _($t:xb) $_($t:xbo)

-	mat_gridlines $p $t

-    }

-    proc mat_new {path target w h bg ln Xa Xb Ya Yb qXv qYv} {

+	set _($t:ya) $_($t:yao);set _($t:yb) $_($t:ybo);set _($t:xa) $_($t:xao);set _($t:xb) $_($t:xbo)

+	mat_gridlines $p $t}

+

+    proc mat_new {path target w h bg ln xa xb ya yb qx qy} {

 	variable _

-	set _($target:i) 0

-	set _($target:ln) $ln

-	set _($target:qxv) $qXv

-	set _($target:qyv) $qYv

-	set _($target:ya) $Ya

-	set _($target:xa) $Xa

-	set _($target:yb) $Yb

-	set _($target:xb) $Xb

-	set _($target:yao) $Ya

-	set _($target:xao) $Xa

-	set _($target:ybo) $Yb

-	set _($target:xbo) $Xb

+	set i 0

+	foreach xy {x y} {foreach ab {a b} {set ${xy}${ab}o [set ${xy}${ab}]}}

+	foreach a {i ln xa xb ya yb xao xbo yao ybo qx qy} {set _($target:$a) [set $a]}

 	if {[winfo exists $path.m] != 1} {

 	    canvas $path.m -bg $bg -width $w -height $h

 	    pack $path.m -side left

-	    bind $path.m <Motion> "::ix::mat_click 0 hover $path $target %x %y"

-	    bind $path.m <1> "::ix::mat_click 1 first $path $target %x %y"

-	    bind $path.m <B1-Motion> "::ix::mat_click 1 motion $path $target %x %y"

-	    bind $path.m <ButtonRelease-1> "::ix::mat_click 1 release $path $target %x %y"

-	    bind $path.m <2> "::ix::mat_click 2 first $path $target %x %y"

-	    bind $path.m <Double-2> "::ix::mat_zoomReset $path $target" 

-	    bind $path.m <B2-Motion> "::ix::mat_click 2 motion $path $target %x %y"

-	    bind $path.m <ButtonRelease-2> "::ix::mat_click 2 release $path $target %x %y"

-	    bind $path.m <3> "::ix::mat_click 3 first $path $target %x %y"

-	    bind $path.m <B3-Motion> "::ix::mat_click 3 motion $path $target %x %y"

-	    bind $path.m <ButtonRelease-3> "::ix::mat_click 3 release $path $target %x %y"

-	    bind $path.m <Control-1> "::ix::mat_draw first $path $target %x %y"

-	    bind $path.m <Control-B1-Motion> "::ix::mat_draw motion $path $target %x %y"

-	    bind $path.m <Control-ButtonRelease-1> "::ix::mat_draw release $path $target %x %y"

+	    bind $path.m <Motion> "::ix::mat_click {} 0 hover $path $target %x %y"

+	    foreach m {"Control-" "" "Shift-"} {

+		foreach bn {1 2 3} {

+		    set b [list [concat $bn first] [concat B${bn}-Motion motion] [concat ButtonRelease-$bn release]]

+		    foreach ba {0 1 2} {

+			bind $path.m <$m[lindex [lindex $b $ba] 0]> "::ix::mat_click [list [string tolower [string trimright $m -1]]] $bn [lindex [lindex $b $ba] 1] $path $target %x %y"}}}

 	    set bd [expr {[$path cget -bd] * 2}]

-            $path configure -bg gray -width [expr [winfo width $path.m] + $bd] \

-		-height [expr [winfo height $path.m] + $bd]

-	    update

-	    mat_gridlines $path $target

-	}}

+            $path configure -bg gray -width [expr [winfo width $path.m] + $bd] -height [expr [winfo height $path.m] + $bd]

+	    mat_gridlines $path $target}}

     

     proc mat_gridlines {path target} {

 	variable _

@@ -177,26 +146,25 @@ namespace eval ::ix {
 	$w delete gridlines

 	set gh [winfo height $w]

 	set gw [winfo width $w]

-	foreach item [$path.m find withtag gridline] {$path.m delete $item}

+	foreach item [$w find withtag gridline] {$w delete $item}

 	foreach xy {x y} {

 	    array set ta {x n y w}

 	    array set tj {x center y left}

 	    array set igx {y width x height}

 	    if {$_($target:${xy}a) > $_($target:${xy}b)} {set oa ">=";set ob "-"} {set oa "<=";set ob "+"}

-	    for {set x [expr int($_($target:${xy}a) / ($_($target:q${xy}v) + 0.0) + 1)*($_($target:q${xy}v) + 0.0)]} {[expr $x $oa $_($target:${xy}b)]} {set x [expr $x $ob $_($target:q${xy}v)]} {

+	    for {set x [expr int($_($target:${xy}a) / ($_($target:q${xy}) + 0.0) + 1)*($_($target:q${xy}) + 0.0)]} {[expr $x $oa $_($target:${xy}b)]} {set x [expr $x $ob $_($target:q${xy})]} {

 		set og [mat_tr $path $target $xy t $x]

-		set invgeo [winfo $igx($xy) $path.m]

+		set invgeo [winfo $igx($xy) $w]

 		switch $xy {y {set coords [concat M 0 $og L $invgeo $og]}

 		    x {set coords [concat M $og 0 L $og $invgeo]}}

 		$w lower [$w create path $coords -stroke $_($target:ln) -strokedasharray 2 -tags gridline -strokewidth 1]

 		$w lower [$w create text [lrange $coords 1 2] -font {{Bitstream Vera Sans} 8} \

-			      -fill green -anchor $ta($xy) -text $x -justify $tj($xy) -tags gridline]}}

-    }

-}

+			      -fill green -anchor $ta($xy) -text $x -justify $tj($xy) -tags gridline]}}}}

+

 #> mat frame

 #. -bd 3 #w 384 #h 144 #bg white #ln purple

-#. #Xa 123 #Xb 2000 #Ya 0 #Yb 127 #qXv 125 #qYv 1

+#. #Xa 123 #Xb 2000 #Ya 0 #Yb 127 #qx 125 #qy 1

 #. @list  ::ix::mat_add .- .| {.#1} .#2 .#3 .#4

 #. @add  ::ix::mat_add .- .| {.#1} .#2 .#3 .#4

 puts "mat .- .|"

-::ix::mat_new .- .| .#w .#h .#bg .#ln .#Xa .#Xb .#Ya .#Yb .#qXv .#qYv

+::ix::mat_new .- .| .#w .#h .#bg .#ln .#Xa .#Xb .#Ya .#Yb .#qx .#qy