#!/usr/bin/env wish # povmm.tk - POV-Ray matrix maker. set cfg(self) [file rootname [file tail $argv0]] set cfg(vers) 0.1.0 # matrix variable names, see POV 3.3.1.12.4. set cfg(mlbl) [list v00 v01 v02 v10 v11 v12 v20 v21 v22 v30 v31 v32] # matrix variables (spinbox) limits: from to increment. set cfg(mlim) [list -10 10 .5] # banner font. set cfg(font) [font create -family Utopia -size 16 -weight bold] # ----------------------------------------------------------------------------- proc buildUI {} { global cfg rt wm protocol . WM_DELETE_WINDOW cmdClose wm resizable . 0 0 wm title . [format {%s (%s)} $cfg(self) $cfg(vers)] label .banner -font $cfg(font) -text {POV-Ray matrix maker} \ -padx 1m -pady 2m # coords. frame .vects -borderwidth 4 -relief groove label .vects.lin -anchor e -text {ref. [x, y, z]:} label .vects.lout -anchor e -text {transformed:} entry .vects.ein -width 30 -validate all -vcmd [list eValid %W %V %d %P] entry .vects.eout -width 30 -textvariable rt(eout) \ -readonlybackground [.vects.lout cget -background] \ -relief flat -state readonly -takefocus 0 grid .vects.lin .vects.ein -sticky nesw grid .vects.lout .vects.eout -sticky nesw grid columnconfigure .vects 0 -weight 1 # matrix controls. frame .mctl -borderwidth 4 -relief groove \ -padx 5m -pady 2m foreach lbl $cfg(mlbl) { set rt($lbl) 0 spinbox .mctl.$lbl -width 5 \ -from [lindex $cfg(mlim) 0] \ -to [lindex $cfg(mlim) 1] \ -increment [lindex $cfg(mlim) 2] \ -validate all -vcmd [list vValid %W %V %d %P] } foreach i [list 0 3 6 9] { label .mctl.lbl$i -anchor e \ -text [format {%s: } [lrange $cfg(mlbl) $i $i+2]] } grid .mctl.lbl0 .mctl.v00 .mctl.v01 .mctl.v02 grid .mctl.lbl3 .mctl.v10 .mctl.v11 .mctl.v12 grid .mctl.lbl6 .mctl.v20 .mctl.v21 .mctl.v22 grid .mctl.lbl9 .mctl.v30 .mctl.v31 .mctl.v32 # sdl format. frame .sdl -borderwidth 4 -relief groove label .sdl.lsdl -text SDL: text .sdl.tsdl -height 5 -width 40 -state disabled \ -background [.sdl.lsdl cget -background] \ -relief flat -takefocus 0 grid configure .sdl.lsdl -row 0 -column 0 -sticky ne grid configure .sdl.tsdl -row 0 -column 1 -sticky nesw grid columnconfigure .sdl 10 -weight 1 -minsize 24 # controls. frame .btns -borderwidth 4 -relief groove button .btns.copy -text copy -command cmdCopy button .btns.close -text close -command cmdClose button .btns.reset -text reset -command cmdReset pack .btns.reset .btns.copy .btns.close \ -expand 1 -fill both -side left # tada.. pack .banner .vects .mctl .sdl .btns -side top -fill both bind . q cmdClose return } proc sdlUpdate {x} { global cfg rt set fmt {matrix <%g,%g,%g,%s%g,%g,%g,%s%g,%g,%g,%s%g,%g,%g>} if {$x} { set s "" set lbl clip } \ else { set s "\n" append s [string repeat " " 8] set lbl sdl } set rt($lbl) [format $fmt $rt(v00) $rt(v01) $rt(v02) \ $s $rt(v10) $rt(v11) $rt(v12) \ $s $rt(v20) $rt(v21) $rt(v22) \ $s $rt(v30) $rt(v31) $rt(v32)] if {!$x} { .sdl.tsdl configure -state normal .sdl.tsdl delete 1.0 5.end .sdl.tsdl insert 1.0 $rt($lbl) .sdl.tsdl configure -state disabled } return } proc recalc {} { global rt lassign $rt(ein) px py pz set qx [expr {$rt(v00) * $px + $rt(v10) * $py + $rt(v20) * $pz + $rt(v30)}] set qy [expr {$rt(v01) * $px + $rt(v11) * $py + $rt(v21) * $pz + $rt(v31)}] set qz [expr {$rt(v02) * $px + $rt(v12) * $py + $rt(v22) * $pz + $rt(v32)}] set rt(eout) [list $qx $qy $qz] return } proc validCoord {rVar arg} { set tmp [split [regsub -all {[ ,]+} $arg ,] ,] if {3 != [llength $tmp]} {return 0} for {set i 0} {3 != $i} {incr i} { if {![string is double -strict [lindex $tmp $i]]} {return 0} } upvar $rVar r set r $tmp return 1 } proc eValid {w ev act v} { global rt set flag 0 switch $ev { focusout { set nv [list] if {![validCoord nv $v]} {focus $w} \ else { set flag 1 if {![string equal $nv $rt(ein)]} { set rt(ein) $nv recalc } } } key { if {1 == $act} {set flag [regexp {^[[:digit:],. +-]+$} $v]} \ else {set flag 1} } default {set flag 1} } return $flag } proc validMval {arg} { global cfg if {![string is double -strict $arg]} {return 0} \ elseif {[lindex $cfg(mlim) 0] > $arg} {return 0} \ elseif {[lindex $cfg(mlim) 1] < $arg} {return 0} return 1 } proc vValid {w ev act v} { global rt set flag 0 switch $ev { focusout { if {![validMval $v]} {focus $w} \ else { set flag 1 set x [string range $w end-2 end] if {$v != $rt($x)} { set rt($x) $v recalc after idle [list sdlUpdate 0] } } } key { if {1 != $act} {set flag 1} \ else { set flag [expr {[string is double -strict $v] || [string match {+-} $v]}] } } default {set flag 1} } return $flag } proc cmdClose {} { destroy . exit 0 } proc cmdCopy {} { global rt sdlUpdate 1 clipboard clear clipboard append -type STRING $rt(clip) return } proc cmdReset {} { global cfg rt set rt(ein) "1 1 1" set rt(eout) "0 0 0" .vects.ein delete 0 end .vects.ein insert 0 $rt(ein) foreach lbl $cfg(mlbl) { set rt($lbl) 0 .mctl.$lbl set $rt($lbl) } sdlUpdate 0 return } # -------------------------------------------------------------------- buildUI cmdReset