path: root/extensions/gui/ix/mat.wid

foreach package {snack tkdnd tkpath} {package require $package}
namespace eval ::ix {
    proc rc {} {return [format "\#%06x" [expr "int(floor(rand() * 16777216))"]]}
    proc rgb {} {return [list [expr "int(floor(rand() * 256))"]  [expr "int(floor(rand() * 256))"]  [expr "int(floor(rand() * 256))"]]}
    proc lighten {rgb r} {set l {}; foreach c $rgb {lappend l [expr {(256 - $c) * $r + $c}]}; return $l}
    proc darken {rgb r} {set l {}; foreach c $rgb {lappend l [expr {$c - ($c * $r)}]}; return $l}
    proc color {rgb} {return [format "\#%02x%02x%02x" [expr int([lindex $rgb 0])] [expr int([lindex $rgb 1])] [expr int([lindex $rgb 2])]]}
    proc random_txt {n} {
        set i 0
        set text ""
        while {$i < $n} {
            set int [expr "int(floor(rand()*62))"]
            if {$int < 10} {incr int 48} elseif {$int < 36} {incr int 55} else {incr int 61}
            set text "$text[format %c $int]"
            incr i
        }
        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]
	switch $a {
	    first {
		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}
	    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)}
		set w [expr {abs($xb - $xa)}]
		set h [expr {abs($yb - $ya)}]
		$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} {
	variable _
	incr _($t:i)
	set tags [list item i$_($t:i) $_($t:i)]
	switch [dict get $d type] {
	    note {
		$p.m create path [::tkpath::coords rect 0 0 0 0 -rx 3 -ry 3] -tags $tags -fill [color [dict get $_($t:g) 0 color]] -stroke [color [darken [dict get $_($t:g) 0 color] 0.5]] -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}
    }

    proc mat_quant {p t y v} {
	variable _
	if {$y eq "xx"} {set y x}; if {$y eq "yy"} {set y y}
	if {$y eq "x" || $y eq "y"} {
	    set v [expr {int( ($v + $_($t:q$y) / 2.0 ) / ($_($t:q$y) + 0.0))*$_($t:q$y)}]
	}
	return $v
    }
    
    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} {
	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 0 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 cid [$p.m find withtag i$id]
	    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 w [expr {[dict get $_($t) $id xx] - [dict get $_($t) $id x]}]
	    set h [expr {[dict get $_($t) $id yy] - [dict get $_($t) $id y]}]
	    switch [dict get $_($t) $id type] {
		note {
		    if {$h < 0.01} {set h 1}
		    set sx [expr {abs([mat_tr $p $t x id $w])}]
		    set sy [expr {abs([mat_tr $p $t y id $h])}]
		    $p.m coords $cid [::tkpath::coords rect $px $py $sx $sy -rx 3 -ry 3]
		    $p.m itemconfigure $cid -fillopacity [dict get $_($t) $id v]
		}
		sound {
		    $p.m coords $cid $px $py
		}
	    }    
	}
    }
    
    proc mat_item_v {p t a x y} {
	variable _
	foreach item $_($t:sel) {
	    mat_item_ua $p $t $item rel [dict create v [expr {($x - $_($t:cx)) / 100.0}]] 1
	}
    }

    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} {
	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}
	mat_item_info $p $t $_($t:sel)
    }

    proc mat_resize_left {p t a x y} {mat_resize_object $p $t x $x $y}
    proc mat_resize_right {p t a x y} {mat_resize_object $p $t xx $x $y}    
    proc mat_resize_top {p t a x y} {mat_resize_object $p $t y $x $y}
    proc mat_resize_bottom {p t a x y} {mat_resize_object $p $t yy $x $y}  

    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}
	mat_item_info $p $t $_($t:sel)
    }

    proc mat_cleansel {p t sel} {
	set clean {}
	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_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 eX [mat_tr $p $t x t [dict get $_($t) $id x]]
	    set eXX [mat_tr $p $t x t [dict get $_($t) $id xx]]
	    set eY [mat_tr $p $t y t [dict get $_($t) $id y]]
	    set eYY [mat_tr $p $t y t [dict get $_($t) $id yy]]
	    if {[expr {abs($eX - $x)}] < 5} {mat_mode $p $t resize_left}
	    if {[expr {abs($eXX - $x)}] < 5} {mat_mode $p $t resize_right} 
	    if {[expr {abs($eY - $y)}] < 1} {mat_mode $p $t resize_top}
	    if {[expr {abs($eYY - $y)}] < 1} {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 _
	set n 0;$p.m delete hover
	foreach item $clicked {
	    set info ""
	    set data  [dict get $_($t) $item] 
	    foreach d $data {lappend info [string range $d 0 7]}
	    $p.m create text [list [expr [winfo width $p.m] - 8.0] [expr [winfo height $p.m] - 8.0 - 11 * $n.0]] -fill $_($t:sc) -justify right -anchor se -font {{bitstream vera sans mono} 10} -tags hover -text $info
	    incr n		
	}}

    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
    }

    proc mat_click {m button action p t x y X Y} {
	variable _
	set clicked [mat_cleansel $p $t [$p.m find overlapping $x $y $x $y]]
	set a [$p.m itemcget mode -text]
	switch $action {
	    first {
		foreach xy {x y}  {set _($t:f$xy) [set $xy]}
		switch $button {
		    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
		    } 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} {
			mat_updatesel $p $t $clicked}}
		    2 {mat_mode $p $t resize_canvas}
		    3 {if {$clicked ne ""} {
			mat_mode $p $t item_v } else {mat_rmenu $p $t $X $Y}}}}
	    motion {eval mat_$a $p $t $action $x $y}
	    release {
		switch $button {
		    1 {if {$a eq "draw" || ($a eq "sel" && [expr {abs($_($t:fx) - $x)}] >13)} {eval mat_$a $p $t $action $x $y}}
		    2 {mat_mode $p $t move_canvas}
		    3 {mat_mode $p $t move_canvas}
		}
	    }
	}
	foreach xy {x y}  {set _($t:c$xy) [set $xy]}
    }
    
    proc mat_rmenu {p t x y} {
	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 "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
	}
	$p.rmenu.seltogroup delete 0 end
	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
    }

    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]}]}}}

    proc mat_zoom {p t a} {
	variable _
	switch $a {
	    fit {
		set i 0
		dict for {s xy} $_($t) {
		    dict with xy {
		        if {$i == 0} {
			    set xa $x
			    set xb $x
			    set ya $y
			    set yb $y
			}
			if {$x > $xb} {set xb $x}
			if {$x < $xa} {set xa $x}
			if {$y > $yb} {set yb $y}
			if {$y < $ya} {set ya $y}
			if {$xx > $xb} {set xb $xx}
			if {$xx < $xa} {set xa $xx}
			if {$yy > $yb} {set yb $yy}
			if {$yy < $ya} {set ya $yy}
			incr i
		    }
		}
		set _($t:xa) $xa
		set _($t:xb) $xb
		set _($t:ya) $ya
		set _($t:yb) $yb
	    }
	    reset {
		set _($t:ya) $_($t:yao);set _($t:yb) $_($t:ybo);set _($t:xa) $_($t:xao);set _($t:xb) $_($t:xbo)
	    }
	}
	mat_redraw $p $t all
	mat_gridlines $p $t
    }

    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}
	$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 _
	foreach item $_($t:sel) {
	    mat_item_ua $p $t $item abs [dict create g $group] 0
	}	
    }

    proc mat_group_new {p t grp} {
	variable _
	set color [rgb]
	if {$grp eq "-"} {set grp [random_txt [expr "int(floor(rand() * 10 + 2))"]]}
	dict set _($t:g) $_($t:gi) name $grp
	dict set _($t:g) $_($t:gi) color $color
	$p.m create text [list 8.0 [expr 38.0 + 11 * $_($t:gi).0]] -fill [color $color]  -justify left -anchor w -font {{bitstream vera sans mono} 10} -tags group -text $grp
	incr _($t:gi)
    }

    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}}
		}
	    }
	}
    }
    
    proc mat_drop {p t dropped x y} {
#	foreach d $dropped {
	    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 "/"]]
	}
    }

    proc mat_new {p t w h bg ln xa xb ya yb qx qy} {
	variable _
	set _($t) {}
	set _($t:g) {}
	set i -1;
	set sel -1;
	set gi 0;set hover 0
	set sc white
	foreach xy {x y} {foreach ab {a b} {set ${xy}${ab}o [set ${xy}${ab}]}}
	foreach a {i sel sc gi hover ln xa xb ya yb xao xbo yao ybo qx qy} {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
	    bind $p.m <Key> "::ix::mat_key $p $t %k 1"
	    bind $p.m <KeyRelease> "::ix::mat_key $p $t %k 0"
#	    dnd bindtarget $p.m text/uri-list <Drop> "::ix::mat_drop $p $t %D %x %y"
	    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} {
		    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}]
            $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 ""
	    mat_gridlines $p $t}
	mat_group_new $p $t default
	mat_group_new $p $t wavs
    }
    
    proc mat_gridlines {p t} {
	variable _
	set w $p.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}
	    for {set x [expr {int($_($t:${xy}a) / ($_($t:q${xy}) + 0.0) + 1)*($_($t:q${xy}) + 0.0)}]} {[expr {$_($t:${xy}a) > $_($t:${xy}b) ? $x >=  $_($t:${xy}b) : $x <=  $_($t:${xy}b)}]} {set x [expr {$_($t:${xy}a) > $_($t:${xy}b) ? $x - $_($t:q${xy}) : $x + $_($t:q${xy})}]} {
		set og [mat_tr $p $t $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]}}
		    y {set coords [concat 0 $og $invgeo $og]}
		    x {set coords [concat $og 0 $og $invgeo]}}
#		$w lower [$w create path $coords -stroke $_($t:ln) -strokedasharray 2 -tags gridline -strokewidth 1]
		$w lower [$w create line $coords -fill $_($t:ln) -tags gridline -width 1]
#		$w lower [$w create text [lrange $coords 1 2] -font {{Bitstream Vera Sans} 8} \
		$w lower [$w create text [lrange $coords 0 1] -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
#bind .- <Enter> {focus .-}
#bind .- <Leave> {focus .^.c}