From 0de9794de546ce0199d36936fe84bbd2f9cc1e17 Mon Sep 17 00:00:00 2001 From: carmen rocco Date: Thu, 21 Jul 2005 05:02:21 +0000 Subject: now, to fix pd so this works without hacks... svn path=/trunk/; revision=3366 --- extensions/gui/ix/mat.wid | 486 ++++++++++++++++++++++++++++++---------------- 1 file changed, 322 insertions(+), 164 deletions(-) (limited to 'extensions/gui') diff --git a/extensions/gui/ix/mat.wid b/extensions/gui/ix/mat.wid index 0fc3ce58..09e74ce6 100755 --- a/extensions/gui/ix/mat.wid +++ b/extensions/gui/ix/mat.wid @@ -17,14 +17,6 @@ namespace eval ::ix { return $text } - proc mat_scroll {p t d axis} { - variable _ - foreach xy $axis { - set mv [expr {($_($t:${xy}b) - $_($t:${xy}a)) / 4.0}] - foreach ab {a b} {set _($t:${xy}$ab) [expr {$d > 0 ? $_($t:${xy}$ab) + $mv : $_($t:${xy}$ab) - $mv }]}} - mat_redraw $p $t all - mat_gridlines $p $t} - proc mat_sel {p t a x y} { variable _ set _($t:sc) [rc] @@ -33,11 +25,9 @@ namespace eval ::ix { foreach xy {x y} {set _($t:c$xy) [set $xy];set _($t:f$xy) [set $xy]} $p.m create path [::tkpath::coords rect $_($t:cx) $_($t:cy) 0 0 -rx 12 -ry 12] \ -tags sel -stroke $_($t:sc) -strokewidth 12 -strokeopacity 0.3} - release {$p.m delete sel; set _($t:hover) 0} + release {$p.m delete sel} motion { - if {$_($t:hover) != 1} { - mat_updatesel $p $t [mat_cleansel $p $t [$p.m find overlapping $_($t:fx) $_($t:fy) $x $y]] - } + mat_updatesel $p $t [mat_cleansel $p $t [$p.m find overlapping $_($t:fx) $_($t:fy) $x $y]] if {$x >= $_($t:cx)} {set xa $_($t:fx);set xb $x} else {set xa $x;set xb $_($t:fx)} if {$y >= $_($t:cy)} {set ya $_($t:fy);set yb $y} else {set ya $y;set yb $_($t:fy)} set w [expr {abs($xb - $xa)}] @@ -45,28 +35,61 @@ namespace eval ::ix { $p.m coords sel [::tkpath::coords rect $xa $ya $w $h -rx 12 -ry 12] $p.m itemconfigure sel -stroke $_($t:sc)}}} - proc mat_item_new {p t d} { + proc mat_item_new {p t id d} { variable _ - incr _($t:i) - set tags [list item i$_($t:i) $_($t:i)] - switch [dict get $d type] { - note { - set color [dict get $_($t:g) $_($t:cg) color] - $p.m create path [::tkpath::coords rect 0 0 0 0 -rx 3 -ry 3] -tags [concat $tags r] -stroke [color [lighten $color 0.4]] -strokeopacity 1.0 -fill [color $color] -fillopacity 0.08 - $p.m create path [::tkpath::coords rect 0 0 0 0 -rx 3 -ry 3] -tags [concat $tags q] -fill [color $color] -strokewidth 0 -fillopacity 0.8 + if {$id eq "-"} { + if {[dict keys $_($t)] eq ""} {set id 0} else { + set id -1 + while true {if {[lsearch -integer [dict keys $_($t)] [incr id]] == -1} {break}} } - sound { - snack:::sound s$_($t:i) - s$_($t:i) read [dict get $d filename] - $p.m create waveform 0 0 -tags $tags -sound s$_($t:i) + } + set _($t:ci) $id + mat_item_ua $p $t $id abs {x 0 xx 0 y 0 yy 0 g 0 v 1} 0 + mat_item_ua $p $t $id abs $d 0 + mat_item_draw $p $t $id + } + + proc mat_item_draw {p t is} { + variable _ + if {$is eq "all"} {set is [dict keys $_($t)]} + foreach id $is { + set tags [list item i$id $id] + switch [dict get $_($t) $id type] { + note { + set color [dict get $_($t:g) $_($t:cg) color] + $p.m create path [::tkpath::coords rect 0 0 0 0 -rx 3 -ry 3] -tags [concat $tags r] -stroke [color [lighten $color 0.4]] -strokeopacity 1.0 -fill [color $color] -fillopacity 0.08 + $p.m create path [::tkpath::coords rect 0 0 0 0 -rx 3 -ry 3] -tags [concat $tags q] -fill [color $color] -strokewidth 0 -fillopacity 0.8 + } + sound { + snack:::sound s$id + set filename [dict get $_($t) $id filename] + s$id read $filename + $p.m create waveform 0 0 -tags [concat $tags w] -sound s$id + set length [expr [s$id length] / ($_($t:samplerate) + 0.0) * 1000] + mat_item_ua $p $t $id abs [dict create xx [expr [dict get $_($t) $id x] + $length]] 0 + $p.m create text 0 0 -tags [concat $tags tl] -font {{bitstream vera sans} 8} -fill HotPink -anchor nw -justify left -text "[string range $length 0 10] s" + $p.m create rectangle 0 0 0 0 -tags [concat $tags tlr] -fill LightGreen -width 0 + $p.m raise [$p.m find withtag "i$id && tl"] + $p.m create text 0 0 -tags [concat $tags tf] -font {{bitstream vera sans} 8} -fill NavyBlue -anchor ne -justify right -text $filename + $p.m create rectangle 0 0 0 0 -tags [concat $tags tfr] -fill gray90 -width 0 + $p.m raise [$p.m find withtag "i$id && tf"] + } } + mat_redraw $p $t $id } - mat_item_ua $p $t $_($t:i) abs $d 1 } proc mat_item_delete {p t} { variable _ - foreach item $_($t:sel) {$p.m delete $item} + foreach item $_($t:sel) { + foreach i [$p.m find withtag i$item] { + $p.m delete $i + } + dict unset _($t) $item + set _($t:sel) {} + mat_item_info $p $t "" + pd [concat $t.rp _cb delete $item \;] + } } proc mat_quant {p t y v} { @@ -79,73 +102,83 @@ namespace eval ::ix { } proc mat_item_pos {p t item r x y xx yy} { + mat_item_ua $p $t $item $r [dict create x $x y $y xx $xx yy $yy] 1} + + proc mat_item_ua {p t item r u redraw} { variable _ - foreach v {x xx y yy} { - if {[set $v] ne "-"} { - switch $r { - abs {dict set _($t) $item $v [set $v]} - rel {dict set _($t) $item $v [expr {[dict get $_($t) $item $v] + [set $v]}]}}}} - mat_redraw $p $t $item} - - proc mat_item_ua {p t item r u redraw} { - variable _ - foreach a [dict keys $u] { - switch $r { - abs {dict set _($t) $item $a [dict get $u $a] - } - rel {dict set _($t) $item $a [expr {[dict get $_($t) $item $a] + [dict get $u $a]}]}}} - if {$redraw == 1} {mat_redraw $p $t $item} - } + foreach a [dict keys $u] { + switch $r {abs {dict set _($t) $item $a [dict get $u $a]} + rel {dict set _($t) $item $a [expr {[dict get $_($t) $item $a] + [dict get $u $a]}]}} + pd [concat $t.rp _cb update $item $a [pdtk_enquote [dict get $_($t) $item $a]] \;] + } + if {$redraw == 1} {mat_redraw $p $t $item} + } proc mat_draw {p t a x y} { variable _ switch $a { motion { - if {$x >= $_($t:cx)} {set xa $_($t:fx);set xb $x} else {set xa $x;set xb $_($t:fx)} - mat_item_pos $p $t $_($t:i) abs [mat_tr $p $t x i $xa] [mat_tr $p $t y i $y] [mat_tr $p $t x i $xb] [mat_tr $p $t y i $y]} - first {mat_item_new $p $t [dict create type note g $_($t:cg) x 0 y 0 xx 0 yy 0 v 1]}}} + if {$_($t:af) == 1} { + mat_item_pos $p $t $_($t:ci) abs [mat_tr $p $t y i $y] [mat_tr $p $t x i $x] [mat_tr $p $t y i $_($t:fy)] [mat_tr $p $t x i $x] + } else { + mat_item_pos $p $t $_($t:ci) abs [mat_tr $p $t x i $x] [mat_tr $p $t y i $y] [mat_tr $p $t x i $_($t:fx)] [mat_tr $p $t y i $y] + } + } + first {mat_item_new $p $t - [dict create type note g $_($t:cg) x 0 y 0 xx 0 yy 0 v 1]}}} - proc mat_resize_canvas {p t a x y} { - variable _ - set mx [expr {$x - $_($t:cx)}] - set my [expr {$y - $_($t:cy)}] - foreach xy {x y} { - set pos [set $xy] - set mvt [mat_tr $p $t $xy d [expr {$pos - $_($t:c$xy)}]] - set _($t:${xy}a) [expr {$_($t:${xy}a) - $mvt}] - set _($t:${xy}b) [expr {$_($t:${xy}b) + $mvt}]} - mat_redraw $p $t all - mat_gridlines $p $t} + proc mat_resize_canvas {p t a x y} {mat_viewpoint $p $t [dict create action resize x $x y $y]} proc mat_redraw {p t items} { variable _ + if {$_($t:af) == 1} { + array set a {x y y x xx yy yy xx} + } else { + array set a {x x y y xx xx yy yy} + } switch $items { all {set items [dict keys $_($t)]} default {}} foreach id $items { - set x [mat_tr $p $t x t [dict get $_($t) $id x]] - set y [mat_tr $p $t y t [dict get $_($t) $id y]] - set qx [mat_tr $p $t x t [mat_quant $p $t x [dict get $_($t) $id x]]] - set qy [mat_tr $p $t y t [mat_quant $p $t y [dict get $_($t) $id y]]] + set x [mat_tr $p $t x t [dict get $_($t) $id $a(x)]] + set y [mat_tr $p $t y t [dict get $_($t) $id $a(y)]] + set qx [mat_tr $p $t x t [mat_quant $p $t x [dict get $_($t) $id $a(x)]]] + set qy [mat_tr $p $t y t [mat_quant $p $t y [dict get $_($t) $id $a(y)]]] + set wx [expr {[dict get $_($t) $id $a(xx)] - [dict get $_($t) $id $a(x)]}] + if {$wx == 0} {set wx 1} + set sx [expr abs([mat_tr $p $t x id $wx])] + set qsx [expr int(abs([mat_tr $p $t x id [expr {[mat_quant $p $t x [dict get $_($t) $id $a(xx)]] - [mat_quant $p $t x [dict get $_($t) $id $a(x)]]}]]))] + set wy [expr {[dict get $_($t) $id $a(yy)] - [dict get $_($t) $id $a(y)]}] + if {$wy == 0} {set wy 1} + set sy [expr abs([mat_tr $p $t y id $wy])] + set qsy [expr int(abs([mat_tr $p $t y id [expr {[mat_quant $p $t y [dict get $_($t) $id $a(yy)]] - [mat_quant $p $t y [dict get $_($t) $id $a(y)]]}]]))] + set ro [expr {int( [set s$a(y)] / 2.0 )}] + if {[lsearch -integer $_($t:sel) $id] >= 0} { + set color $_($t:sc) + } else { + set color [color [dict get $_($t:g) [dict get $_($t) $id g] color]] + } switch [dict get $_($t) $id type] { note { - set sx [expr abs([mat_tr $p $t x id [expr {[dict get $_($t) $id xx] - [dict get $_($t) $id x]}]])] - set qsx [expr abs([mat_tr $p $t x id [expr {[mat_quant $p $t x [dict get $_($t) $id xx]] - [mat_quant $p $t x [dict get $_($t) $id x]]}]])] - set sy [expr abs([mat_tr $p $t y id 1])] - set ro [expr {int( $sy / 2.0 )}] set r [$p.m find withtag "i$id && r"] set q [$p.m find withtag "i$id && q"] $p.m coords $r [::tkpath::coords rect $x $y $sx $sy -rx $ro -ry $ro] - $p.m coords $q [::tkpath::coords rect $qx $qy $qsx $sy -rx $ro -ry $ro] - $p.m itemconfigure $q -fillopacity [dict get $_($t) $id v] + $p.m coords $q [::tkpath::coords rect $qx $qy $qsx $qsy -rx $ro -ry $ro] + $p.m itemconfigure $q -fillopacity [dict get $_($t) $id v] -fill $color } sound { - $p.m coords [$p.m find withtag i$id] $x $y + set waveform [$p.m find withtag "i$id && w"] + $p.m coords $waveform $x $y +# $p.m itemconfigure $waveform -width $sx -height $sy + $p.m itemconfigure $waveform -width $sx + $p.m coords [$p.m find withtag "i$id && tl"] [expr $x + 4] [expr $y + 4] + $p.m coords [$p.m find withtag "i$id && tlr"] [$p.m bbox [$p.m find withtag "i$id && tl"] ] + $p.m coords [$p.m find withtag "i$id && tf"] [expr $x + $sx] [expr $y + 4] + $p.m coords [$p.m find withtag "i$id && tfr"] [$p.m bbox [$p.m find withtag "i$id && tf"] ] } } } } - + proc mat_item_v {p t a x y} { variable _ foreach item $_($t:sel) { @@ -154,22 +187,17 @@ namespace eval ::ix { mat_item_info $p $t $_($t:sel) } - proc mat_move_canvas {p t a x y} { - variable _ - set mx [expr {$x - $_($t:cx)}] - set my [expr {$y - $_($t:cy)}] - foreach xy {x y} { - set pos [set $xy] - set mvt [mat_tr $p $t $xy d [expr {$pos - $_($t:c$xy)}]] - foreach ab {a b} {set _($t:${xy}$ab) [expr {$_($t:${xy}$ab) - $mvt}]}} - mat_redraw $p $t all - mat_gridlines $p $t} + proc mat_move_canvas {p t a x y} {mat_viewpoint $p $t [dict create action move x $x y $y]} proc mat_move_object {p t a x y} { variable _ set mx [mat_tr $p $t x d [expr {$x - $_($t:cx)}]] set my [mat_tr $p $t y d [expr {$y - $_($t:cy)}]] - foreach item $_($t:sel) {mat_item_pos $p $t $item rel $mx $my $mx $my} + if {$_($t:af) == 1} { + foreach item $_($t:sel) {mat_item_pos $p $t $item rel $my $mx $my $mx} + } else { + foreach item $_($t:sel) {mat_item_pos $p $t $item rel $mx $my $mx $my} + } mat_item_info $p $t $_($t:sel) } @@ -184,7 +212,11 @@ namespace eval ::ix { proc mat_resize_object {p t e x y} { variable _ - array set ax {x x xx x y y yy y} + if {$_($t:af) == 1} { + array set ax {x y xx y y x yy x} + } else { + array set ax {x x xx x y y yy y} + } set m [mat_tr $p $t $ax($e) d [expr $$ax($e) - $_($t:c$ax($e))]] foreach item $_($t:sel) {mat_item_ua $p $t $item rel [dict create $e $m] 1} mat_item_info $p $t $_($t:sel) @@ -195,51 +227,68 @@ namespace eval ::ix { foreach item $sel {if {[lindex [$p.m itemcget $item -tags] 0] eq "item"} {lappend clean [lindex [$p.m itemcget $item -tags] 2]}} set clean [lsort -integer -unique $clean] return $clean -} + } + + proc mat_loc {p t si x y} { + variable _ + if {$si == 1} { + set sy $y + set sx $x + set x [mat_tr $p $t x i $x] + set y [mat_tr $p $t y i $y] + } else { + set sy [mat_tr $p $t y t $y] + set sx [mat_tr $p $t x t $x] + } + $p.m coords lY [concat M 0 $sy L [winfo width $p.m] $sy] + $p.m coords lX [concat M $sx 0 L $sx [winfo height $p.m]] + $p.m itemconfigure loc -text [list $x $y] + } proc mat_hover {p t x y} { variable _ - mat_loc $p $t $x $y +# mat_loc $p $t 1 $x $y if {[$p.m find withtag sel] ne ""} { - set _($t:hover) 1 - set clicked [mat_cleansel $p $t [$p.m find overlapping $_($t:fx) $_($t:fy) $x $y]] mat_sel $p $t motion $x $y } else { - set clicked [mat_cleansel $p $t [$p.m find overlapping $x $y $x $y]] - } - if {$clicked ne ""} { - mat_mode $p $t move_object - set id [lindex $clicked 0] - set d 3 - set dx [expr {abs([mat_tr $p $t x t [dict get $_($t) $id x]] - $x)}] - set dxx [expr {abs([mat_tr $p $t x t [dict get $_($t) $id xx]] - $x)}] - set dy [expr {abs([mat_tr $p $t y t [dict get $_($t) $id y]] - $y)}] - set dyy [expr {abs([mat_tr $p $t y t [dict get $_($t) $id yy]] - $y)}] - puts "d: x $dx y $dy xx $dxx yy $dyy" - if {$dx < $d && $dy < $d} { - mat_mode $p $t resize_tl - } elseif {$dxx < $d && $dy < $d} { - mat_mode $p $t resize_tr - } elseif {$dx < $d && $dyy < $d} { - mat_mode $p $t resize_bl - } elseif {$dxx < $d && $dyy < $d} { - mat_mode $p $t resize_br - } elseif {$dx < $d} { - mat_mode $p $t resize_left - } elseif {$dxx < $d} { - mat_mode $p $t resize_right - } elseif {$dy < $d} { - mat_mode $p $t resize_top - } elseif {$dyy < $d} { - mat_mode $p $t resize_bottom + set clicked [mat_cleansel $p $t [$p.m find overlapping [expr $x - 2] [expr $y - 2] [expr $x + 2] [expr $y + 2]]] + if {$clicked ne ""} { + mat_resize_modes $p $t $x $y [lindex $clicked 0] + if {[llength $_($t:sel)] <= 1} {mat_updatesel $p $t [lindex $clicked 0]} + } else { + mat_mode $p $t move_canvas } - if {[$p.m find withtag sel] eq "" && [llength $_($t:sel)] > 1} {return} - mat_updatesel $p $t $clicked - } else { - mat_mode $p $t move_canvas } } + proc mat_resize_modes {p t x y id} { + variable _ + set d 3 + set dx [expr {abs([mat_tr $p $t x t [dict get $_($t) $id x]] - $x)}] + set dxx [expr {abs([mat_tr $p $t x t [dict get $_($t) $id xx]] - $x)}] + set dy [expr {abs([mat_tr $p $t y t [dict get $_($t) $id y]] - $y)}] + set dyy [expr {abs([mat_tr $p $t y t [dict get $_($t) $id yy]] - $y)}] + if {$dx < $d && $dy < $d} { + mat_mode $p $t resize_tl + } elseif {$dxx < $d && $dy < $d} { + mat_mode $p $t resize_tr + } elseif {$dx < $d && $dyy < $d} { + mat_mode $p $t resize_bl + } elseif {$dxx < $d && $dyy < $d} { + mat_mode $p $t resize_br + } elseif {$dx < 5} { + mat_mode $p $t resize_left + } elseif {$dxx < 5} { + mat_mode $p $t resize_right + } elseif {$dy < 1} { + mat_mode $p $t resize_top + } elseif {$dyy < 1} { + mat_mode $p $t resize_bottom + } else { + mat_mode $p $t move_object + } + } + proc mat_item_info {p t clicked} { variable _ set n 0;$p.m delete hover @@ -251,16 +300,22 @@ namespace eval ::ix { incr n }} - proc mat_updatesel {p t clicked} { + proc mat_togglesel {p t d} { variable _ - foreach item $_($t:sel) { - if {[lsearch -integer $clicked $item] < 0 && $item >= 0} { - $p.m itemconfigure [$p.m find withtag i$item] -fill [color [dict get $_($t:g) [dict get $_($t) $item g] color]]}} - foreach item $clicked { - $p.m itemconfigure [$p.m find withtag i$item] -fill $_($t:sc) + if {[lsearch -integer $_($t:sel) $d] < 0} { + set _($t:sel) [concat $_($t:sel) $d] + } else { + set _($t:sel) [lsearch -inline -not -all -integer $_($t:sel) $d] } - mat_item_info $p $t $clicked - set _($t:sel) $clicked + mat_redraw $p $t $d + } + + proc mat_updatesel {p t ns} { + variable _ + set os $_($t:sel) + set _($t:sel) $ns + mat_redraw $p $t [lsort -unique -integer [concat $os $ns]] + mat_item_info $p $t $ns } proc mat_click {m button action p t x y X Y} { @@ -274,8 +329,12 @@ namespace eval ::ix { 1 {if {$m eq "control"} { mat_mode $p $t draw; mat_draw $p $t $action $x $y } elseif {$m eq "double" || $m eq "shift"} { - mat_sel $p $t first $x $y - mat_mode $p $t sel + if {[llength $clicked] > 0} { + mat_togglesel $p $t $clicked + } else { + mat_sel $p $t first $x $y + mat_mode $p $t sel + } } elseif {[$p.m find withtag sel] ne ""} { mat_sel $p $t release $x $y } elseif {[llength $_($t:sel)] > 1 && [llength $clicked] > 0 && [lsearch $_($t:sel) $clicked] == -1} { @@ -299,10 +358,11 @@ namespace eval ::ix { variable _ if {[winfo exists $p.rmenu] != 1} { set m [menu $p.rmenu -tearoff no] - $m add command -label "zoom to fit" -command "::ix::mat_zoom $p $t fit" - $m add command -label "reset zoom" -command "::ix::mat_zoom $p $t reset" + $m add command -label "zoom to fit" -command "::ix::mat_viewpoint $p $t {action fit}" + $m add command -label "reset zoom" -command "::ix::mat_viewpoint $p $t {action reset}" $m add command -label "add group" -command "::ix::mat_group_new $p $t -" $m add cascade -label "sel to group" -menu [menu $p.rmenu.seltogroup -tearoff no] + $m add command -label "flip axes" -command "::ix::mat_flipaxe $p $t" } else { # $p.rmenu entryconfigure 0 -label $x } @@ -310,9 +370,6 @@ namespace eval ::ix { foreach group [dict keys $_($t:g)] { $p.rmenu.seltogroup add command -label [dict get $_($t:g) $group name] -command "::ix::mat_group_assign $p $t $group" } - - - tk_popup $p.rmenu $x $y } @@ -325,9 +382,9 @@ namespace eval ::ix { 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]}]}}} - proc mat_zoom {p t a} { + proc mat_viewpoint {p t opts} { variable _ - switch $a { + switch [dict get $opts action] { fit { set i 0 dict for {s xy} $_($t) { @@ -357,19 +414,97 @@ namespace eval ::ix { reset { set _($t:ya) $_($t:yao);set _($t:yb) $_($t:ybo);set _($t:xa) $_($t:xao);set _($t:xb) $_($t:xbo) } + move { + foreach xy {x y} { + set mvt [mat_tr $p $t $xy d [expr {[dict get $opts $xy] - $_($t:c$xy)}]] + foreach ab {a b} {set _($t:${xy}$ab) [expr {$_($t:${xy}$ab) - $mvt}]}} + } + zoom { + array set dir {in 0.5 out 1.5} + foreach xy [dict get $opts axe] { + set radius [expr {($_($t:${xy}b) - $_($t:${xy}a)) / 2. * $dir([dict get $opts dir])}] + set center [mat_tr $p $t $xy i [dict get $opts $xy]] + set _($t:${xy}a) [expr {$center - $radius}] + set _($t:${xy}b) [expr {$center + $radius}] + } + } + resize { + foreach xy {x y} { + set mvt [mat_tr $p $t $xy d [expr {[dict get $opts $xy] - $_($t:c$xy)}]] + set _($t:${xy}a) [expr {$_($t:${xy}a) - $mvt}] + set _($t:${xy}b) [expr {$_($t:${xy}b) + $mvt}]} + } + scroll { + set xy [dict get $opts axis] + set mv [expr {($_($t:${xy}b) - $_($t:${xy}a)) / 4.0}] + foreach ab {a b} {set _($t:${xy}$ab) [expr {[dict get $opts units] > 0 ? $_($t:${xy}$ab) + $mv : $_($t:${xy}$ab) - $mv }]} + } } mat_redraw $p $t all mat_gridlines $p $t } + proc mat_flipaxe {p t} { + variable _ + set _($t:af) [expr $_($t:af) == 1 ? 0 : 1] + + set ya $_($t:ya) + set xa $_($t:xa) + set xb $_($t:xb) + set yb $_($t:yb) + set qx $_($t:qx) + set qy $_($t:qy) + set mx $_($t:mx) + set my $_($t:my) + set _($t:ya) $xa + set _($t:xa) $ya + set _($t:yb) $xb + set _($t:xb) $yb + set _($t:qx) $qy + set _($t:qy) $qx + set _($t:mx) $my + set _($t:my) $mx + + mat_gridlines $p $t + mat_redraw $p $t all + } + proc mat_clip {p t action} { + variable _ + switch $action { + selecta { + mat_updatesel $p $t [dict keys $_($t)] + } + cut { + set _($t:c) [dict create] + set i 0 + foreach item $_($t:sel) { + dict set _($t:c) $i [dict get $_($t) $item] + incr i + } + mat_item_delete $p $t + } + copy { + set _($t:c) [dict create] + set i 0 + foreach item $_($t:sel) { + dict set _($t:c) $i [dict get $_($t) $item] + incr i + } + } + paste { + set pasted {} + foreach item [dict keys $_($t:c)] { + mat_item_new $p $t - [dict get $_($t:c) $item] + } + } + } + } + proc mat_mode {p t m} { array set cursor {draw pencil move_canvas fleur move_object dotbox item_v box_spiral resize_canvas bogosity sel cross_reverse resize_left left_side resize_right right_side resize_top top_side resize_bottom bottom_side resize_tl top_left_corner resize_tr top_right_corner resize_bl bottom_left_corner resize_br bottom_right_corner} $p.m itemconfigure mode -text $m $p.m configure -cursor $cursor($m) } - proc mat_loc {p t x y} { - $p.m itemconfigure loc -text [list [mat_tr $p $t x i $x] [mat_tr $p $t y i $y]] - } proc mat_group_assign {p t group} { variable _ @@ -390,6 +525,7 @@ namespace eval ::ix { dict set _($t:g) $n color [rgb] set _($t:cg) $n mat_groups_view $p $t + mat_group_active $p $t $n } } @@ -399,10 +535,10 @@ namespace eval ::ix { foreach i [dict keys $_($t:g)] { set id [$p.m create text [concat 68.0 [expr {38.0 + 11 * $i}]] -fill [color [dict get $_($t:g) $i color]] -justify right -anchor e -font {{bitstream vera sans mono} 10} -tags [concat group $i lb] -text [dict get $_($t:g) $i name]] $p.m bind $id "::ix::mat_group_active $p $t $i" + $p.m bind $id <1> "::ix::mat_group_assign $p $t $i" set bx [$p.m bbox $id] $p.m lower [$p.m create path [::tkpath::coords rect [lindex $bx 0] [lindex $bx 1] [expr [lindex $bx 2] - [lindex $bx 0]] [expr [lindex $bx 3] - [lindex $bx 1]] -rx 6 -ry 6] -tags [concat group $i bg] -strokewidth 1 -stroke white -fill white -fillopacity 0.5] } - mat_group_active $p $t $_($t:cg) } proc mat_group_active {p t g} { @@ -419,20 +555,27 @@ namespace eval ::ix { } proc mat_key {p t k b} { -# puts $k + puts $k switch $b { 1 { switch $k { - 37 {mat_mode $p $t draw} 22 {mat_item_delete $p $t} + 38 {mat_clip $p $t selecta} + 53 {mat_clip $p $t cut} + 54 {mat_clip $p $t copy} + 55 {mat_clip $p $t paste} + 97 {mat_viewpoint $p $t {action reset}} + 98 {mat_viewpoint $p $t {action scroll units -1 axis y}} + 100 {mat_viewpoint $p $t {action scroll units -1 axis x}} + 102 {mat_viewpoint $p $t {action scroll units 1 axis x}} + 104 {mat_viewpoint $p $t {action scroll units 1 axis y}} 107 {mat_item_delete $p $t} } } - 0 { - switch $k { - 37 {mat_mode $p $t {move_canvas}} - } - } +# 0 { +# switch $k { +# } +# } } } @@ -441,15 +584,15 @@ namespace eval ::ix { foreach d [split $dropped "\n"] { set x [mat_tr $p $t x i $x] set y [mat_tr $p $t y i $y] - mat_item_new $p $t [dict create type sound g 1 v 1 x $x y $y xx [expr $x + 10] yy [expr $y + 10] filename [regsub -- {^file:[/]+} $d "/"]] + mat_item_new $p $t - [dict create type sound g 1 v 1 x $x y $y xx $x yy $y filename [regsub -- {^file:[/]+} $d "/"]] } } - proc mat_new {p t w h bg ln xa xb ya yb qx qy mx my} { + proc mat_new {p t w h bg ln xa xb ya yb qx qy mx my samplerate} { variable _ - set sc white + set sc orange foreach xy {x y} {foreach ab {a b} {set ${xy}${ab}o [set ${xy}${ab}]}} - foreach a {sc ln xa xb ya yb xao xbo yao ybo qx qy mx my} {set _($t:$a) [set $a]} + foreach a {sc ln xa xb ya yb xao xbo yao ybo qx qy mx my samplerate} {set _($t:$a) [set $a]} if {[winfo exists $p.m] != 1} { canvas $p.m -bg $bg -width $w -height $h pack $p.m -side left @@ -458,31 +601,40 @@ namespace eval ::ix { # dnd bindtarget $p.m text/uri-list "::ix::mat_drop $p $t %D %x %y" dnd bindtarget $p.m text/plain "::ix::mat_drop $p $t %D %x %y" bind $p.m "::ix::mat_hover $p $t %x %y" - bind $p.m <4> "::ix::mat_scroll $p $t 1 x" - bind $p.m <5> "::ix::mat_scroll $p $t -1 x" - bind $p.m "::ix::mat_scroll $p $t -1 y" - bind $p.m "::ix::mat_scroll $p $t 1 y" + bind $p.m <4> "::ix::mat_viewpoint $p $t {action scroll units 1 axis x}" + bind $p.m <5> "::ix::mat_viewpoint $p $t {action scroll units -1 axis x}" + bind $p.m "::ix::mat_viewpoint $p $t {action zoom dir in axe x x %x y %y}" + bind $p.m "::ix::mat_viewpoint $p $t {action zoom dir out axe x x %x y %y}" + bind $p.m "::ix::mat_viewpoint $p $t {action zoom dir in axe {x y} x %x y %y}" + bind $p.m "::ix::mat_viewpoint $p $t {action zoom dir out axe {x y} x %x y %y}" + bind $p.m "::ix::mat_viewpoint $p $t {action zoom dir in axe y x %x y %y}" + bind $p.m "::ix::mat_viewpoint $p $t {action zoom dir out axe y x %x y %y}" + bind $p.m "::ix::mat_viewpoint $p $t {action scroll units -1 axis y}" + bind $p.m "::ix::mat_viewpoint $p $t {action scroll units 1 axis y}" foreach m {"Control-" "" "Shift-" "Double-"} { 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 $p.m <$m[lindex [lindex $b $ba] 0]> "::ix::mat_click [list [string tolower [string trimright $m -1]]] $bn [lindex [lindex $b $ba] 1] $p $t %x %y %X %Y"}}} set bd [expr {[$p cget -bd] * 2}] +# update $p configure -bg gray -width [expr {[winfo width $p.m] + $bd}] -height [expr {[winfo height $p.m] + $bd}] $p.m create text {20 20} -fill blue -justify left -anchor w -font {{bitstream vera sans} 18} -tags mode -text move_canvas $p.m create text [list [expr {$w / 2.}] 5] -fill red -justify center -anchor n -font {{bitstream vera sans} 14} -tags q -text q + $p.m create path "M 0 0" -tags lX -stroke black -strokeopacity 0.5 + $p.m create path "M 0 0" -tags lY -stroke black -strokeopacity 0.5 $p.m create text "10 $h" -fill red -justify left -anchor sw -font {{bitstream vera sans} 12 bold} -fill purple -tags loc -text "" if {[info exists _($t)] != 1} { - set _($t) {} - set _($t:g) {} - set sel -1; set i -1; set hover 0; - foreach a {i sel hover} {set _($t:$a) [set $a]} - mat_group_new $p $t default - mat_group_new $p $t wavs + set _($t) {} + set _($t:g) {} + set af 0; set i -1; set sel {} + foreach a {af i sel} {set _($t:$a) [set $a]} + mat_group_new $p $t default + mat_group_new $p $t wavs } } mat_gridlines $p $t - mat_redraw $p $t all + mat_item_draw $p $t all mat_groups_view $p $t } @@ -507,18 +659,24 @@ namespace eval ::ix { set og [mat_tr $p $t $xy t $x] set invgeo [winfo $igx($xy) $w] switch $xy { - y {set coords [concat M [expr {int(rand()*32)}] $og L $invgeo $og]} + y {set coords [concat M [expr {int(rand()*23)}] $og L $invgeo $og]} x {set coords [concat M $og [expr {int(rand()*16)}] L $og $invgeo]}} +# y {set coords [concat M 0 $og L $invgeo $og]} +# x {set coords [concat M $og 0 L $og $invgeo]}} $w lower [$w create text [lrange $coords 1 2] -font {{Bitstream Vera Sans} 8} -fill [rc] -anchor $ta($xy) -text [string range $x 0 7] -justify $tj($xy) -tags gridline] $w lower [$w create path $coords -stroke $_($t:ln) -strokedasharray [expr {int(rand()*42 + 1)}] -tags gridline -strokewidth 1] }}}} #> mat frame #. -bd 3 #w 384 #h 144 #bg gray86 #ln white +#. #samplerate 44100 #. #Xa 123 #Xb 2000 #Ya 127 #Yb 0 #qx 50 #qy 1 #mx 12 #my 64 -#. @list ::ix::mat_add .- .| {.#1} .#2 .#3 .#4 -#. @add ::ix::mat_add .- .| {.#1} .#2 .#3 .#4 +#. @add ::ix::mat_item_new .- .| .#1 {type .#2} +#. @update ::ix::mat_item_ua .- .| .#1 abs {.#2 .#3} 1 +#. @updaterel ::ix::mat_item_ua .- .| .#1 rel {.#2 .#3} 1 +#. @up ::ix::mat_item_ua .- .| .#1 abs {.#2 .#3} 0 +#. @uprel ::ix::mat_item_ua .- .| .#1 rel {.#2 .#3} 0 puts "mat .- .|" -::ix::mat_new .- .| .#w .#h .#bg .#ln .#Xa .#Xb .#Ya .#Yb .#qx .#qy .#mx .#my -#bind .- {focus .-} -#bind .- {focus .^.c} +::ix::mat_new .- .| .#w .#h .#bg .#ln .#Xa .#Xb .#Ya .#Yb .#qx .#qy .#mx .#my .#samplerate +#bind .-.m {focus .-.m} +bind .-.m {focus .^.c} -- cgit v1.2.1