* SAOTk is a Tcl/Tk extension that provides additional item types for the Tk canvas; these item types are useful for data visualization and imaging applications.
SAOTk Implementation
SAOTk extends the Tk canvas with custom item types. It is built on top of Tk and BLT.
The new canvas item types are
When one of these items is added to a canvas, a new command is created for manipulating the item.
Screenshot
Does SAOTk require a custom version of Tcl/Tk?
Using SAOTk for images not in FITS format
Demo Application
# Copyright (C) 1999-2005 # Smithsonian Astrophysical Observatory, Cambridge, MA, USA # For conditions of distribution and use, see copyright notice in "copyright" # Obtained from the SAOTk docs and patched by KJN in 2007. # The conditions referred to above are the GPL v2. lappend auto_path . package require BLT load libsaotk.so package require saotk # Variables set simple(visual) [winfo visual .] set simple(depth) [winfo depth .] set current(zoom) 1 set current(orient) none set current(rotate) 0 set canvas(width) 518 set canvas(height) 518 set colorbar(width) 512 set colorbar(height) 15 set colorbar(map) Grey set colorbar(invert) 0 set scale(mode) minmax # Procedures proc OpenFile {} { set fileName [tk_getOpenFile -parent . -filetypes {{{FITS Files} {.fits} }}] if {$fileName != ""} { if [catch {frame1 load fits \"$fileName\" mmapincr}] { tk_messageBox -message "Unable to load Fits Image $fileName." \ -type ok -icon error } } } proc AdjustColormap {x y} { global canvas set cursorX [expr double($x-$canvas(width)/2+512/2) / 512 set cursorY [expr double($y)/512 * 10] colorbar adjust $cursorX $cursorY frame1 colormap [colorbar get colormap] } proc UpdateColorbarGeometry {} { global colorbar set colorbar(width) [expr [winfo width .simple.colorbar]-2] set colorbar(height) [expr [winfo height .simple.colorbar]-2] colorbar configure -width $colorbar(width) -height $colorbar(height) } proc UpdateCanvasGeometry {} { global canvas set canvas(width) [expr [winfo width .simple.image] - 4] set canvas(height) [expr [winfo height .simple.image] - 4] set w $canvas(width) set h $canvas(height) set x [expr int($canvas(width)/2.) + 2] set y [expr int($canvas(height)/2.) + 2] frame1 configure -x $x -y $y -width $w -height $h -anchor center } proc CreateColorMenu {} { global colorbar set id [colorbar list id] set count 0 foreach i $id { set name [colorbar get name $i] .menuBar.color insert $count radiobutton -label "$name" \ -command "ChangeColormap $i" -variable colorbar(map) incr count } } proc ChangeColormap {id} { global colorbar colorbar map $id frame1 colormap [colorbar get colormap] set colorbar(map) [colorbar get name] set colorbar(invert) [colorbar get invert] } proc ScaleMode {} { global scale frame1 clip mode $scale(mode) } # Set Application Behavior set tk_strictMotif 1 wm title . "Simple Image Display" . configure -menu .menuBar # Base Frame frame .simple # Create Colorbar canvas .simple.colorbar -width $colorbar(width) \ -height $colorbar(height) \ -bd 2 -relief groove -insertofftime 0 .simple.colorbar create colorbar$simple(visual)$simple(depth) \ -width $colorbar(width) -height $colorbar(height) -anchor nw colorbar set colormap window .simple # Create Image canvas .simple.image -width $canvas(width) -height $canvas(height) \ -bd 2 -relief groove -highlightthickness 0 -insertofftime 0 # Display the Widgets pack .simple.image -side top -expand true -fill both pack .simple.colorbar -side bottom -fill x pack .simple -expand true -fill both # Menu Bar menu .menuBar -tearoff 0 -selectcolor red .menuBar add cascade -label "File" -menu .menuBar.file .menuBar add cascade -label "Color" -menu .menuBar.color .menuBar add cascade -label "Zoom" -menu .menuBar.zoom .menuBar add cascade -label "Orient" -menu .menuBar.orient .menuBar add cascade -label "Scale" -menu .menuBar.scale menu .menuBar.file -tearoff 0 -selectcolor red .menuBar.file add command -label "Open..." -command OpenFile .menuBar.file add separator .menuBar.file add command -label "Exit" -command exit menu .menuBar.color -tearoff 0 -selectcolor red .menuBar.color add separator .menuBar.color add checkbutton -label "Invert Colormap" \ -variable colorbar(invert) -command {colorbar invert $colorbar(invert)} CreateColorMenu menu .menuBar.zoom -tearoff 0 -selectcolor red .menuBar.zoom add command -label "Zoom In" \ -command {frame1 zoom 2 2; set current(zoom) [frame1 get zoom]} .menuBar.zoom add command -label "Zoom Out" \ -command {frame1 zoom .5 .5; set current(zoom) [frame1 get zoom]} .menuBar.zoom add separator .menuBar.zoom add radiobutton -label "1/16" \ -variable current(zoom) -value {0.0625 0.0625} -command {frame1 zoom to $current(zoom)} .menuBar.zoom add radiobutton -label "1/8" \ -variable current(zoom) -value {0.125 0.125} -command {frame1 zoom to $current(zoom)} .menuBar.zoom add radiobutton -label "1/4" \ -variable current(zoom) -value {0.25 0.25} -command {frame1 zoom to $current(zoom)} .menuBar.zoom add radiobutton -label "1/2" \ -variable current(zoom) -value {0.5 0.5} -command {frame1 zoom to $current(zoom)} .menuBar.zoom add radiobutton -label "1" \ -variable current(zoom) -value {1 1} -command {frame1 zoom to $current(zoom)} .menuBar.zoom add radiobutton -label "2" \ -variable current(zoom) -value {2 2} -command {frame1 zoom to $current(zoom)} .menuBar.zoom add radiobutton -label "4" \ -variable current(zoom) -value {4 4} -command {frame1 zoom to $current(zoom)} .menuBar.zoom add radiobutton -label "8" \ -variable current(zoom) -value {8 8} -command {frame1 zoom to $current(zoom)} .menuBar.zoom add radiobutton -label "16" \ -variable current(zoom) -value {16 16} -command {frame1 zoom to $current(zoom)} menu .menuBar.orient -tearoff 0 -selectcolor red .menuBar.orient add radiobutton -label "None" \ -variable current(orient) -value none -command {frame1 orient $current(orient)} .menuBar.orient add radiobutton -label "Invert X" \ -variable current(orient) -value x -command {frame1 orient $current(orient)} .menuBar.orient add radiobutton -label "Invert Y" \ -variable current(orient) -value y -command {frame1 orient $current(orient)} .menuBar.orient add radiobutton -label "Invert X&Y" \ -variable current(orient) -value xy -command {frame1 orient $current(orient)} .menuBar.orient add separator .menuBar.orient add radiobutton -label "0 deg" \ -variable current(rotate) -value 0 -command {frame1 rotate to $current(rotate)} .menuBar.orient add radiobutton -label "90 deg" \ -variable current(rotate) -value 90 -command {frame1 rotate to $current(rotate)} .menuBar.orient add radiobutton -label "180 deg" \ -variable current(rotate) -value 180 -command {frame1 rotate to $current(rotate)} .menuBar.orient add radiobutton -label "270 deg" \ -variable current(rotate) -value 270 -command {frame1 rotate to $current(rotate)} # Scale Menu menu .menuBar.scale -tearoff 0 -selectcolor red .menuBar.scale add radiobutton -label "Min Max" \ -variable scale(mode) -command ScaleMode -value minmax .menuBar.scale add radiobutton -label "IRAF ZScale" \ -variable scale(mode) -command ScaleMode -value zscale # Make sure that the wm knows when to swap in the colormap (if needed) wm colormapwindows . ".simple .simple.image" # Init Colorbar bind .simple.colorbar <Configure> [list UpdateColorbarGeometry] colorbar map $colorbar(map) colorbar invert $colorbar(invert) # Init Frame bind .simple.image <Configure> [list UpdateCanvasGeometry] bind .simple.image <Button-3> {AdjustColormap %x %y} bind .simple.image <B3-Motion> {AdjustColormap %x %y} .simple.image create frame$simple(visual)$simple(depth) \ -x 0 -y 0 -anchor nw -command frame1 frame1 colormap [colorbar get colormap]
I'm confused by this code:
package require saotk pack [frame .pippo] canvas .pippo.ima -width 516 -height 516 -bd 1 -relief solid -insertofftime 0 pack .pippo.ima -side top -expand true -fill both .pippo.ima create frametruecolor24 -width 512 -height 512 \ -x 4 -y 4 -anchor nw -command frame1 # set magni [canvas .pippo.magni -width 200 -height 200 -bd 2 -relief groove \ -highlightthickness 0 -insertofftime 0 -takefocus 0] pack .pippo.magni -expand true -fill both $magni create magnifiertruecolor -width 204 -height 204 \ -x 2 -y 2 -anchor nw -command magnifier -tag magnifier # magnifier clear magnifier reset frame1 magnifier on frame1 magnifier zoom 4 frame1 magnifier graphics 1 frame1 magnifier cursor yes # bind .pippo.ima <Motion> { set id [.pippo.ima find closest \ [.pippo.ima canvasx %x] [.pippo.ima canvasy %y]] set x [expr {int([.pippo.ima canvasx %x])}] set y [expr {int([.pippo.ima canvasy %y])}] frame1 magnifier update $x $y update } # frame1 load fits HHPZ0094.fits mmapincr frame1 zoom to fit frame1 clip mode zscale
... the fits file is displayed but the Magnifier doesn't work! (it's still white) Any ideas?