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

package require tkpath
namespace eval ::ix {
    proc rc {} {return [format "\#%06x" [expr "int(floor(rand() * 16777216))"]]}

    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_action {p t a x y} {
    }

    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 $_($t:${xy}$ab) $d $mv]}}
	mat_redraw $p $t all
	mat_gridlines $p $t
    }

    proc mat_sel {a p t x y} {
	variable _
	switch $a {
	    start {
		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 [rc] -strokewidth 12 -strokeopacity 0.3

	    }
	    close {
		$p.m delete sel
	    }
	    motion {
		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]
	    }
	}
   }

    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)}
		set w [expr abs($xb - $xa)]
		set h [mat_tr $p $t y id 1]
		$p.m coords drawing [::tkpath::coords rect $xa $y $w $h -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)}}}

    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 mvt [mat_tr $p $t $xy d [expr $$xy - $_($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 [$p.m find withtag item]}
	    default {}
	}
	foreach item $items {
	    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]
	}
    }

    proc mat_object_trans {p t a x y} {
	variable _
	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
	}
    }

    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 mvt [mat_tr $p $t $xy d [expr $$xy - $_($t:c$xy)]]
	    foreach ab {a b} {set _($t:${xy}$ab) [expr $_($t:${xy}$ab) - $mvt]}}	
	foreach item [$p.m find withtag item] {
	    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
	}
	mat_gridlines $p $t
    }

    proc mat_move_object {p t a x y} {
	variable _
	set mx [expr $x - $_($t:cx)]
	set my [expr $y - $_($t:cy)]
	foreach item $_($t:cl) {
	    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
	}
    }

    proc mat_hover {p t x y} {
	variable _
	if {[$p.m find withtag sel] ne ""} {
	    set clicked [$p.m find overlapping $x $y $_($t:fx) $_($t:fy)] 
	    mat_sel motion $p $t $x $y
	} else {
	    set clicked [$p.m find overlapping $x $y $x $y]
	}
	set n 0
	$p.m delete hover
	foreach item $clicked {
	    if {[lindex [$p.m itemcget $item -tags] 0] eq "item"} {
		set id [lindex [$p.m itemcget $item -tags] 1]
#		mat_note $p $t $item
		$p.m create text "[expr [winfo width $p.m] - 8.0 ] [expr [winfo height $p.m] - 8.0 - 11 * $n.0]" -fill "#ff0022" -justify right -anchor se -font {{bitstream vera sans} 10} -tags hover -text [dict get $_($t) $id] 
		incr n
	    }
	}
	mat_loc $p $t $x $y
    }

    proc mat_click {m button action p t x y X Y} {
	variable _
	set clicked [$p.m find overlapping $x $y $x $y]
	set a [$p.m itemcget mode -text]
	switch $action {
	    first {
		set _($t:cl) $clicked
		foreach xy {x y}  {set _($t:f$xy) [set $xy]}
		switch $button {
		    1 {
			if {$a eq "draw"} {mat_draw $p $t $action $x $y} elseif {$m eq "double"} {
			    mat_sel start $p $t $x $y
			} elseif {[$p.m find withtag sel] ne ""} {
			    mat_sel close $p $t $x $y
			} else {
			    if {$clicked ne "" && [lindex [$p.m itemcget [lindex $clicked 0] -tags] 0] eq "item"} {
				mat_mode $p $t move_object
			    } else {
				mat_mode $p $t move_canvas
			    }
			}
		    }
		    2 {mat_mode $p $t resize_canvas}
		    3 {
			if {$clicked ne "" && [lindex [$p.m itemcget [lindex $clicked 0] -tags] 0] eq "item"} {
			    mat_mode $p $t object_trans
			} else {
			    mat_rmenu $p $t $X $Y
			}
		    }
		}
	    }
	    motion {eval mat_$a $p $t $action $x $y}
	    release {
		switch $button {
		    1 {
			if {$a eq "draw"} {mat_draw $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} {
	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 "jupas" -command {}  -state disabled
	    $m add command -label "frukas" -command {}  -state disabled
	} else {
#	    $p.rmenu entryconfigure 0 -label $x
	}
	tk_popup $p.rmenu $x $y
    }

    proc mat_tr {p t d inv v} {
	variable _
	array set dm {x width y height}
	switch $inv {
	    #value->pixels
	    t {return [expr ($v - $_($t:${d}a)) / ($_($t:${d}b) - $_($t:${d}a) + 0.0) * [winfo $dm($d) $p.m]]}

	    #pixels->value
	    i {return [expr ($_($t:${d}b) - $_($t:${d}a)) * $v /([winfo $dm($d) $p.m] + 0.0) + $_($t:${d}a)]}

	    #pixels->value (distance)
	    d {return [expr ($_($t:${d}b) - $_($t:${d}a)) * $v /([winfo $dm($d) $p.m] + 0.0)]}

	    #values->pixel (distance)
	    #	   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_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
		puts "new: $_($t:xa) $_($t:xb) $_($t:ya) $_($t: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_key {p t k b} {
#	puts $k
	switch $b {
	    1 {
		switch $k {
		    37 {mat_mode  $p $t draw}
		}
	    }
	    0 {
		switch $k {
		    37 {mat_mode  $p $t {move_canvas}}
		}
	    }
	}
    }
    proc mat_mode {p t m} {
	$p.m itemconfigure mode -text $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_new {p t w h bg ln xa xb ya yb qx qy} {
	variable _
	set i 0
	set _($t) {}
	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 _($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"
	    bind $p.m <Motion> "::ix::mat_hover $p $t %x %y"
	    bind $p.m <4> "::ix::mat_scroll $p $t - x"
	    bind $p.m <5> "::ix::mat_scroll $p $t + x"
	    bind $p.m <Shift-4> "::ix::mat_scroll $p $t - y"
	    bind $p.m <Shift-5> "::ix::mat_scroll $p $t + 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 action
	    $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}}
    
    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}
	    if {$_($t:${xy}a) > $_($t:${xy}b)} {set oa ">=";set ob "-"} {set oa "<=";set ob "+"}
	    for {set x [expr int($_($t:${xy}a) / ($_($t:q${xy}) + 0.0) + 1)*($_($t:q${xy}) + 0.0)]} {[expr $x $oa $_($t:${xy}b)]} {set x [expr $x $ob $_($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]}}
		$w lower [$w create path $coords -stroke $_($t: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