package require tkpath namespace eval ::ix { proc rc {} {return [format "\#%06x" [expr "int(floor(rand() * 16))"]]} proc mat_note {p t item} { variable _ set id [lindex [$p.m itemcget $item -tags] 1] set len [expr [dict get $_($t) $id xx] - [dict get $_($t) $id x]] set vel [$p.m itemcget $item -fillopacity] pd [concat $t.rp _cb note [dict get $_($t) $id y] $vel $len \;]} proc mat_click {m button action p t x y} { variable _ 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 } } } 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] } } 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 [dict get $_($t) $id x]] set py [mat_tr $p $t y t [dict get $_($t) $id y]] set sx [mat_tr $p $t x id [expr [dict get $_($t) $id xx] - [dict get $_($t) $id x]]] 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]} } } } 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)} $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] dict set _($t) $_($t:i) x [mat_tr $p $t x i $xa] dict set _($t) $_($t:i) y $yi dict set _($t) $_($t:i) xx [mat_tr $p $t x i $xb] dict set _($t) $_($t:i) yy $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} 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}}} proc mat_tr {p t d inv v} { variable _ array set dm {x width y height} switch $inv { 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])]}}} 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 qx qy} { variable _ 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" 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] mat_gridlines $path $target}} proc mat_gridlines {path target} { variable _ # puts gridlines set w $path.m $w delete gridlines set gh [winfo height $w] set gw [winfo width $w] 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}) + 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) $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]}}}} #> mat frame #. -bd 3 #w 384 #h 144 #bg white #ln purple #. #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 .#qx .#qy