Update of /cvsroot/pure-data/extensions/gui/ix In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv11955
Modified Files: mat.wid Log Message: now, to fix pd so this works without hacks...
Index: mat.wid =================================================================== RCS file: /cvsroot/pure-data/extensions/gui/ix/mat.wid,v retrieving revision 1.20 retrieving revision 1.21 diff -C2 -d -r1.20 -r1.21 *** mat.wid 16 Jul 2005 23:45:55 -0000 1.20 --- mat.wid 21 Jul 2005 05:02:21 -0000 1.21 *************** *** 18,29 **** }
- 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 _ --- 18,21 ---- *************** *** 34,42 **** $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} motion { ! if {$_($t:hover) != 1} { ! 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)} --- 26,32 ---- $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} motion { ! 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)} *************** *** 46,71 **** $p.m itemconfigure sel -stroke $_($t:sc)}}}
! proc mat_item_new {p t 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 } ! 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) } } - 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} }
--- 36,94 ---- $p.m itemconfigure sel -stroke $_($t:sc)}}}
! proc mat_item_new {p t id d} { variable _ ! 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}} } ! } ! 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 } }
proc mat_item_delete {p t} { variable _ ! 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 ;] ! } }
*************** *** 80,100 ****
proc mat_item_pos {p t item r x y xx yy} { ! 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} ! }
proc mat_draw {p t a x y} { --- 103,117 ----
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 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} { *************** *** 102,150 **** 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]}}}
! 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_redraw {p t items} { variable _ 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]]] 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] } sound { ! $p.m coords [$p.m find withtag i$id] $x $y } } } } ! proc mat_item_v {p t a x y} { variable _ --- 119,183 ---- switch $a { motion { ! 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} {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 $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 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 $qsy -rx $ro -ry $ro] ! $p.m itemconfigure $q -fillopacity [dict get $_($t) $id v] -fill $color } sound { ! 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 _ *************** *** 155,168 **** }
! 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_object {p t a x y} { --- 188,192 ---- }
! 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} { *************** *** 170,174 **** 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} mat_item_info $p $t $_($t:sel) } --- 194,202 ---- set mx [mat_tr $p $t x d [expr {$x - $_($t:cx)}]] set my [mat_tr $p $t y d [expr {$y - $_($t:cy)}]] ! 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) } *************** *** 185,189 **** proc mat_resize_object {p t e x y} { variable _ ! 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} --- 213,221 ---- proc mat_resize_object {p t e x y} { variable _ ! 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} *************** *** 196,244 **** set clean [lsort -integer -unique $clean] return $clean ! }
proc mat_hover {p t x y} { variable _ ! mat_loc $p $t $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 } - 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_item_info {p t clicked} { variable _ --- 228,293 ---- 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 1 $x $y if {[$p.m find withtag sel] ne ""} { mat_sel $p $t motion $x $y } else { ! 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 } } }
+ 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 _ *************** *** 252,265 **** }}
! proc mat_updatesel {p t clicked} { 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) } ! mat_item_info $p $t $clicked ! set _($t:sel) $clicked }
--- 301,320 ---- }}
! proc mat_togglesel {p t d} { variable _ ! 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_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 }
*************** *** 275,280 **** 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 } elseif {[$p.m find withtag sel] ne ""} { mat_sel $p $t release $x $y --- 330,339 ---- mat_mode $p $t draw; mat_draw $p $t $action $x $y } elseif {$m eq "double" || $m eq "shift"} { ! 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 *************** *** 300,307 **** 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 "add group" -command "::ix::mat_group_new $p $t -" $m add cascade -label "sel to group" -menu [menu $p.rmenu.seltogroup -tearoff no] } else { # $p.rmenu entryconfigure 0 -label $x --- 359,367 ---- if {[winfo exists $p.rmenu] != 1} { set m [menu $p.rmenu -tearoff no] ! $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 *************** *** 311,317 **** $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 } --- 371,374 ---- *************** *** 326,332 **** id {return [expr {$v / ($_($t:${d}b) - $_($t:${d}a) + 0.0) * [winfo $dm($d) $p.m]}]}}}
! proc mat_zoom {p t a} { variable _ ! switch $a { fit { set i 0 --- 383,389 ---- id {return [expr {$v / ($_($t:${d}b) - $_($t:${d}a) + 0.0) * [winfo $dm($d) $p.m]}]}}}
! proc mat_viewpoint {p t opts} { variable _ ! switch [dict get $opts action] { fit { set i 0 *************** *** 358,366 **** --- 415,504 ---- 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} *************** *** 368,374 **** $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} { --- 506,509 ---- *************** *** 391,394 **** --- 526,530 ---- set _($t:cg) $n mat_groups_view $p $t + mat_group_active $p $t $n } } *************** *** 400,407 **** 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 <Enter> "::ix::mat_group_active $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) }
--- 536,543 ---- 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 <Enter> "::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] } }
*************** *** 420,437 ****
proc mat_key {p t k b} { ! # puts $k switch $b { 1 { switch $k { - 37 {mat_mode $p $t draw} 22 {mat_item_delete $p $t} 107 {mat_item_delete $p $t} } } ! 0 { ! switch $k { ! 37 {mat_mode $p $t {move_canvas}} ! } ! } } } --- 556,580 ----
proc mat_key {p t k b} { ! puts $k switch $b { 1 { switch $k { 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 { ! # } ! # } } } *************** *** 442,454 **** 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 "/"]] } }
! proc mat_new {p t w h bg ln xa xb ya yb qx qy mx my} { variable _ ! set sc white 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]} if {[winfo exists $p.m] != 1} { canvas $p.m -bg $bg -width $w -height $h --- 585,597 ---- 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 $x yy $y filename [regsub -- {^file:[/]+} $d "/"]] } }
! proc mat_new {p t w h bg ln xa xb ya yb qx qy mx my samplerate} { variable _ ! 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 samplerate} {set _($t:$a) [set $a]} if {[winfo exists $p.m] != 1} { canvas $p.m -bg $bg -width $w -height $h *************** *** 459,466 **** dnd bindtarget $p.m text/plain <Drop> "::ix::mat_drop $p $t %D %x %y" bind $p.m <Motion> "::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 <Shift-4> "::ix::mat_scroll $p $t -1 y" ! bind $p.m <Shift-5> "::ix::mat_scroll $p $t 1 y" foreach m {"Control-" "" "Shift-" "Double-"} { foreach bn {1 2 3} { --- 602,615 ---- dnd bindtarget $p.m text/plain <Drop> "::ix::mat_drop $p $t %D %x %y" bind $p.m <Motion> "::ix::mat_hover $p $t %x %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 <Control-4> "::ix::mat_viewpoint $p $t {action zoom dir in axe x x %x y %y}" ! bind $p.m <Control-5> "::ix::mat_viewpoint $p $t {action zoom dir out axe x x %x y %y}" ! bind $p.m <Alt-4> "::ix::mat_viewpoint $p $t {action zoom dir in axe {x y} x %x y %y}" ! bind $p.m <Alt-5> "::ix::mat_viewpoint $p $t {action zoom dir out axe {x y} x %x y %y}" ! bind $p.m <Control-Shift-4> "::ix::mat_viewpoint $p $t {action zoom dir in axe y x %x y %y}" ! bind $p.m <Control-Shift-5> "::ix::mat_viewpoint $p $t {action zoom dir out axe y x %x y %y}" ! bind $p.m <Shift-4> "::ix::mat_viewpoint $p $t {action scroll units -1 axis y}" ! bind $p.m <Shift-5> "::ix::mat_viewpoint $p $t {action scroll units 1 axis y}" foreach m {"Control-" "" "Shift-" "Double-"} { foreach bn {1 2 3} { *************** *** 469,487 **** 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}] $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 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 } } mat_gridlines $p $t ! mat_redraw $p $t all mat_groups_view $p $t } --- 618,639 ---- 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 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_item_draw $p $t all mat_groups_view $p $t } *************** *** 508,513 **** set invgeo [winfo $igx($xy) $w] switch $xy { ! y {set coords [concat M [expr {int(rand()*32)}] $og L $invgeo $og]} x {set coords [concat M $og [expr {int(rand()*16)}] 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] --- 660,667 ---- set invgeo [winfo $igx($xy) $w] switch $xy { ! 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] *************** *** 516,524 **** #> mat frame #. -bd 3 #w 384 #h 144 #bg gray86 #ln white #. #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 puts "mat .- .|" ! ::ix::mat_new .- .| .#w .#h .#bg .#ln .#Xa .#Xb .#Ya .#Yb .#qx .#qy .#mx .#my ! #bind .- <Enter> {focus .-} ! #bind .- <Leave> {focus .^.c} --- 670,682 ---- #> 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 ! #. @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 .#samplerate ! #bind .-.m <Enter> {focus .-.m} ! bind .-.m <Leave> {focus .^.c}