From ee5e8d47ee04cde05e28b0f950220869b22da97f Mon Sep 17 00:00:00 2001 From: carmen rocco Date: Tue, 24 May 2005 22:28:08 +0000 Subject: adding chords to kbd svn path=/trunk/; revision=3081 --- extensions/gui/ix/kbd-demo.pd | 2 +- extensions/gui/ix/kbd.wid | 120 ++++++--------------- extensions/gui/ix/kbd2.wid | 36 ------- extensions/gui/ix/mat-demo.pd | 114 +++++++++++--------- extensions/gui/ix/mat.wid | 238 ++++++++++++++++++------------------------ 5 files changed, 202 insertions(+), 308 deletions(-) delete mode 100755 extensions/gui/ix/kbd2.wid (limited to 'extensions') 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 [bind $wk <1>];bind $wk "::ix::kbd_play $t 0 0 %X %Y"; bind $wk "::ix::kbd_play $t 1 0 %X %Y"; bind $wk <3> "::ix::kbd_play $t 1 1 %X %Y"; bind $wk [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 {::ix::kbd_drag .| %X %Y} -bind key {::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 [bind $wk <1>] - bind $wk {::ix::kbd2_play 0 %X %Y}; bind $wk [bind $wk ]} - 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 "::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 "::ix::mat_click 1 motion $path $target %x %y" - bind $path.m "::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 "::ix::mat_zoomReset $path $target" - bind $path.m "::ix::mat_click 2 motion $path $target %x %y" - bind $path.m "::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 "::ix::mat_click 3 motion $path $target %x %y" - bind $path.m "::ix::mat_click 3 release $path $target %x %y" - bind $path.m "::ix::mat_draw first $path $target %x %y" - bind $path.m "::ix::mat_draw motion $path $target %x %y" - bind $path.m "::ix::mat_draw release $path $target %x %y" + bind $path.m "::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 -- cgit v1.2.1