Mercurial > forge
view extra/tk_octave/tk_matrix.tcl @ 0:6b33357c7561 octave-forge
Initial revision
author | pkienzle |
---|---|
date | Wed, 10 Oct 2001 19:54:49 +0000 |
parents | |
children | 323220136b06 |
line wrap: on
line source
package require BLT namespace import blt::* wm deiconify . set HaveTable [expr [ catch { package require Tktable } ] == 0 ] set HaveVTK [expr [ string equal [ info commands oct_mtovtk ] {} ] && \ [ catch {load ./vtktcl} ] == 0 ] set Matrix {} proc undefinedMatrix {} { global Matrix if { $Matrix != {} && [ oct_matrix $Matrix exists ] } { return 0 } else { return 1 } } # ****************** Create graphs ****************************** grid [graph .matrix -height 350 -width 350] -row 0 -col 0 -sticky news grid [graph .yslice -width 150] -row 0 -col 1 -sticky news grid [graph .xslice -height 150] -row 1 -col 0 -sticky news grid rowconfigure . 0 -weight 1 -minsize 150 grid columnconfigure . 0 -weight 1 -minsize 150 grid rowconfigure . 1 -weight 0 grid columnconfigure . 1 -weight 0 .xslice element create XSlice -label {} -pix 2 -fill "" .yslice element create YSlice -label {} -pix 2 -fill "" -mapx x2 -mapy y2 Blt_ZoomStack .matrix Blt_Crosshairs .matrix Blt_ClosestPoint .matrix # Use x2-y for the image, x2-y2 for the Y slice and x-y for the X slice # Fix margin sizes so that scales are commensurate between the graphs .matrix xaxis configure -hide yes .matrix x2axis configure -hide no .yslice yaxis configure -hide yes .yslice y2axis configure -hide no .yslice xaxis configure -hide yes .yslice x2axis configure -hide no .matrix configure -leftmargin 50 -topmargin 50 -rightmargin 0 -bottommargin 0 .yslice configure -rightmargin 50 -topmargin 50 -leftmargin 0 -bottommargin 0 .xslice configure -leftmargin 50 -bottommargin 50 -rightmargin 0 -topmargin 0 # Turn on grid marks .matrix grid configure -hide no -dashes { 2 2 } .xslice grid configure -hide no -dashes { 2 2 } .yslice grid configure -hide no -dashes { 2 2 } # Define image for matrix rendering image create photo matrix # ************** Define configurion control frame ***************** grid [frame .options] -row 0 -col 2 -rowspan 2 -sticky ns grid columnconfigure . 2 -weight 0 # Add colormap bar image create photo colorbar grid [graph .options.colorbar -height 150 -width 80] \ -row 0 -col 0 -rowspan 10 -sticky ns .options.colorbar xaxis configure -hide yes # Add slice locator grid [label .options.slicelabel -text "Slice Coordinates:"] \ -col 1 -row 0 -sticky w grid [label .options.xvalue -text "X = 0"] -col 1 -row 1 -sticky w grid [label .options.yvalue -text "Y = 0"] -col 1 -row 2 -sticky w # Add colormap chooser set colormapChoice {} radiobutton .options.ocean \ -variable colormapChoice -text Ocean -value "-colormap tk_ocean" radiobutton .options.rainbow \ -variable colormapChoice -text Rainbow -value "-colormap tk_hsv" radiobutton .options.custom \ -variable colormapChoice -text Default -value {} label .options.colormaplabel -text "Colormap Options:" grid .options.colormaplabel -col 1 -row 3 -sticky w grid .options.ocean -col 1 -row 4 -sticky w grid .options.rainbow -col 1 -row 5 -sticky w grid .options.custom -col 1 -row 6 -sticky w bind .options.ocean <ButtonPress-1> { oct_cmd "tk_ocean = ocean(64);" set colormapChoice "-colormap tk_ocean" redraw_matrix } bind .options.rainbow <ButtonPress-1> { oct_cmd "tk_hsv = rainbow(64);" set colormapChoice "-colormap tk_hsv" redraw_matrix } bind .options.custom <ButtonPress-1> { set colormapChoice {} redraw_matrix } # Add matrix chooser label .options.lmatrix -text "Octave Matrix Name :" -anchor w entry .options.ematrix -textvariable Matrix -relief sunken grid .options.lmatrix .options.ematrix bind .options.ematrix <Return> { # Update the table with the new matrix dimensions redraw_matrix updateTable } # ************************* Graph interactions *********************** # Record mouse coordinates when middle mouse button is pressed set startX 0 set startY 0 proc record_mouse { X Y } { if { [undefinedMatrix] } { return } global Matrix global startX global startY set startX \ [expr round([.matrix axis invtransform x2 [expr $X - [winfo rootx .]]])] if {$startX < 0} { set startX 0 } if {$startX >= [oct_matrix $Matrix cols]} { set startX [expr [oct_matrix $Matrix cols] - 1] } set startY \ [expr round([.matrix axis invtransform y [expr $Y - [winfo rooty .]]])] if {$startY < 0} { set startY 0 } if {$startY >= [oct_matrix $Matrix rows]} { set startY [expr [oct_matrix $Matrix rows] - 1] } .options.xvalue configure -text "X = $startX" .options.yvalue configure -text "Y = $startY" draw_slices } bind . <ButtonPress-2> { record_mouse %X %Y } bind . <B2-Motion> { record_mouse %X %Y } # We need to redraw our slices whenever zooming in/out. bind .matrix <ButtonPress-3> { draw_slices } bind .matrix <ButtonPress-1> { draw_slices } # Graph drawing routines vector x1 y1 x2 y2 proc draw_slices { } { if { [undefinedMatrix] } { return } global Matrix global startX global startY set minX [lindex [.matrix x2axis limits] 0] set maxX [lindex [.matrix x2axis limits] 1] set minY [lindex [.matrix yaxis limits] 0] set maxY [lindex [.matrix yaxis limits] 1] if { $startX >= [oct_matrix $Matrix cols]} { set startX [expr [oct_matrix $Matrix cols] - 1] .options.xvalue configure -text "X = $startX" } if { $startY >= [oct_matrix $Matrix rows]} { set startY [expr [oct_matrix $Matrix rows] - 1] .options.yvalue configure -text "Y = $startY" } x1 seq 0 [oct_matrix $Matrix cols] x2 seq 0 [oct_matrix $Matrix rows] oct_mtov $Matrix y1 0 $startY [oct_matrix $Matrix cols] 1 oct_mtov $Matrix y2 $startX 0 1 [oct_matrix $Matrix rows] .xslice element configure XSlice -xdata x1 -ydata y1 .yslice element configure YSlice -xdata y2 -ydata x2 .xslice xaxis configure -min $minX -max $maxX .yslice y2axis configure -min $minY -max $maxY } proc redraw_matrix { } { if {[undefinedMatrix]} { if [ .matrix marker exists matrix ] { .matrix marker delete } return } global Matrix global colormapChoice # Find limits for the matrix value set MatrixRows [oct_matrix $Matrix rows] set MatrixCols [oct_matrix $Matrix cols] set MatrixMin [oct_matrix $Matrix min] set MatrixMax [oct_matrix $Matrix max] # Convert the matrix into an image and paste it into the graph matrix configure -data "$Matrix $colormapChoice" .matrix x2axis configure -min 0 -max $MatrixCols .matrix yaxis configure -min 0 -max $MatrixRows .matrix marker create image -name matrix -image matrix \ -coords "0 0 $MatrixCols $MatrixRows" -mapx x2 -under 1 # Fix the limits on the X/Y slices so that they will work for any slice # Draw the current slice .xslice yaxis configure -min $MatrixMin -max $MatrixMax .yslice x2axis configure -min $MatrixMin -max $MatrixMax draw_slices # Draw the new colorbar for the given colormap choice # This converts the simple range stored in the octave variable # "colorbar" into an image and pastes it into the colorbar graph. colorbar configure -data "colorbar $colormapChoice" .options.colorbar yaxis configure -min $MatrixMin -max $MatrixMax .options.colorbar marker create image -name colorbar \ -image colorbar -coords \ "0 $MatrixMin 1 $MatrixMax" } # ******************* Table commands ************************** proc updateTable {} { global Matrix if [ winfo exists .table.t ] { if { [undefinedMatrix] } { .table.t config -rows 1 -cols 1 } else { .table.t config -rows [oct_matrix $Matrix rows] \ -cols [oct_matrix $Matrix cols] } } } proc toggleTable {} { if [ winfo exists .table ] { destroy .table } else { createTable } } proc tableCommand { Row Col Set Value } { global Matrix if {$Set} { oct_cmd "$Matrix\($Row,$Col\)=$Value;" redraw_matrix } else { if { $Row == 0 && $Col == 0 } { if { $Matrix == "" } { return "<none>" } else { return $Matrix } } elseif { $Row == 0 } { return $Col } elseif { $Col == 0 } { return $Row } else { return [oct_matrix $Matrix elem [expr $Row-1] [expr $Col-1] ] } } } proc createTable {} { # ********************* Create data display table ****************** toplevel .table wm title .table "TK Octave Data" table .table.t \ -xscrollcommand {.table.x set} -yscrollcommand {.table.y set} \ -height 10 -width 6 -titlerows 1 -titlecols 1 -rows 1 -cols 1 \ -command { tableCommand %r %c %i %s } -usecommand true scrollbar .table.y -orient v -command [list .table.t yview] scrollbar .table.x -orient h -command [list .table.t xview] grid .table.t -row 0 -col 0 -sticky news grid .table.y -row 0 -col 1 -sticky ns grid .table.x -row 1 -col -0 -sticky ew grid rowconfig .table 0 -weight 1 grid columnconfig .table 0 -weight 1 grid rowconfig .table 1 -weight 0 grid columnconfigure .table 1 -weight 0 updateTable } bind . <Destroy> { catch { if {%W = "."} { oct_quit } } } # ******************* Create Octave Interactor ********************* catch {unset octInteract.bold} catch {unset octInteract.normal} catch {unset octInteract.tagcount} set octInteractBold "-background #43ce80 -foreground #221133 -relief raised -borderwidth 1" set octInteractNormal "-background #dddddd -foreground #221133 -relief flat" set octInteractTagcount 1 set octInteractCommandList "" set octInteractCommandIndex 0 proc do_oct {s w} { global octInteractBold octInteractNormal octInteractTagcount global octInteractCommandList octInteractCommandIndex set c "oct_cmd \{$s\}" set tag [append tagnum $octInteractTagcount] set octInteractCommandIndex $octInteractTagcount incr octInteractTagcount 1 .octInteract.display.text configure -state normal .octInteract.display.text insert end $s $tag set octInteractCommandList [linsert $octInteractCommandList end $s] eval .octInteract.display.text tag configure $tag $octInteractNormal .octInteract.display.text tag bind $tag <Any-Enter> \ ".octInteract.display.text tag configure $tag $octInteractBold" .octInteract.display.text tag bind $tag <Any-Leave> \ ".octInteract.display.text tag configure $tag $octInteractNormal" .octInteract.display.text tag bind $tag <1> "do_oct [list $s] .octInteract" .octInteract.display.text insert end \n; .octInteract.display.text insert end [uplevel 1 $c] .octInteract.display.text insert end \n\n .octInteract.display.text configure -state disabled .octInteract.display.text yview end } catch {destroy .octInteract} #toplevel .octInteract -bg #bbbbbb #wm title .octInteract "tk_octave interactor" grid [frame .octInteract -bg #bbbbbb] -row 2 -column 0 \ -columnspan 3 -sticky news grid columnconfigure .octInteract 0 -weight 1 grid rowconfigure .octInteract 3 -weight 1 # Command input frame .octInteract.file -bg #bbbbbb grid columnconfigure .octInteract.file 1 -weight 1 label .octInteract.file.label -text "Command:" -width 10 -anchor w \ -bg #bbbbbb -fg #221133 entry .octInteract.file.entry -width 40 \ -bg #dddddd -fg #221133 -highlightthickness 1 -highlightcolor #221133 bind .octInteract.file.entry <Return> { do_oct [%W get] .octInteract; %W delete 0 end} grid .octInteract.file.label -row 0 -column 0 -sticky w grid .octInteract.file.entry -row 0 -column 1 -sticky news grid .octInteract.file -row 0 -column 0 -sticky news # Command output frame .octInteract.display -bg #bbbbbb grid columnconfigure .octInteract.display 0 -weight 1 text .octInteract.display.text -yscrollcommand \ ".octInteract.display.scroll set" \ -setgrid true -width 60 -height 8 -wrap word -bg #dddddd -fg #331144 \ -state disabled scrollbar .octInteract.display.scroll \ -command ".octInteract.display.text yview" -bg #bbbbbb \ -troughcolor #bbbbbb -activebackground #cccccc -highlightthickness 0 grid .octInteract.display.text -row 0 -column 0 -sticky news grid .octInteract.display.scroll -row 0 -column 1 -sticky ns grid .octInteract.display -row 1 -column 0 -sticky news -columnspan 2 # Keyboard control for command history bind [winfo toplevel .octInteract] <Down> { if { $octInteractCommandIndex < [expr $octInteractTagcount - 1] } { incr octInteractCommandIndex set command_string \ [lindex $octInteractCommandList $octInteractCommandIndex] .octInteract.file.entry delete 0 end .octInteract.file.entry insert end $command_string } elseif { $octInteractCommandIndex == [expr $octInteractTagcount - 1] } { .octInteract.file.entry delete 0 end } } bind [winfo toplevel .octInteract] <Up> { if { $octInteractCommandIndex > 0 } { set octInteractCommandIndex [expr $octInteractCommandIndex - 1] set command_string \ [lindex $octInteractCommandList $octInteractCommandIndex] .octInteract.file.entry delete 0 end .octInteract.file.entry insert end $command_string } } # Control buttons frame .octInteract.buttons button .octInteract.buttons.quit -text Quit -command oct_quit \ -bg #bbbbbb -fg #221133 -activebackground #cccccc -activeforeground #221133 pack .octInteract.buttons.quit -side left -expand true -fill x if { $HaveTable } { button .octInteract.buttons.table -text Table -command toggleTable \ -bg #bbbbbb -fg #221133 \ -activebackground #cccccc -activeforeground #221133 pack .octInteract.buttons.table -side left -expand true -fill x } if { $HaveVTK } { button .octInteract.buttons.render -text Render -command vtk_render \ -bg #bbbbbb -fg #221133 -activebackground #cccccc -activeforeground #221133 pack .octInteract.buttons.render -side left -expand true -fill x } grid .octInteract.buttons -row 2 -column 0 -sticky ew -columnspan 2 # ************************ VTK test stuff ****************************** proc vtk_render { } { if {[undefinedMatrix]} { return } global Matrix catch { iren Disable } catch { ren RemoveActor carpet } catch { surface Delete } catch { warp Delete } catch { mapper Delete } catch { carpet Delete } catch { ren Delete } catch { iren Delete } catch { vtkTkRenderWidget .octInteract.window } grid .octInteract.window -row 3 -column 0 -columnspan 2 -sticky news oct_mtovtk $Matrix surface vtkWarpScalar warp warp SetInput surface warp XYPlaneOn warp SetScaleFactor 0.5 vtkDataSetMapper mapper mapper SetInput [warp GetOutput] mapper SetScalarRange \ [lindex [surface GetScalarRange] 0] [lindex [surface GetScalarRange] 1] vtkActor carpet carpet SetMapper mapper vtkRenderer ren ren AddActor carpet ren SetBackground 1 1 1 set renWin [.octInteract.window GetRenderWindow] $renWin AddRenderer ren $renWin SetSize 300 300 vtkRenderWindowInteractor iren iren SetRenderWindow $renWin $renWin Render iren Initialize iren Enable iren Start }