diff options
Diffstat (limited to 'extensions/gui/ix/mat.wid')
| -rwxr-xr-x | extensions/gui/ix/mat.wid | 238 |
1 files changed, 103 insertions, 135 deletions
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
|