diff options
Diffstat (limited to 'ds9/library/movie.tcl')
-rw-r--r-- | ds9/library/movie.tcl | 534 |
1 files changed, 534 insertions, 0 deletions
diff --git a/ds9/library/movie.tcl b/ds9/library/movie.tcl new file mode 100644 index 0000000..36a0047 --- /dev/null +++ b/ds9/library/movie.tcl @@ -0,0 +1,534 @@ +# Copyright (C) 1999-2016 +# Smithsonian Astrophysical Observatory, Cambridge, MA, USA +# For conditions of distribution and use, see copyright notice in "copyright" + +package provide DS9 1.0 + +proc MovieDef {} { + global imovie + global movie + + global tcl_platform + + set imovie(top) .moviestatus + set imovie(mb) .moviestatusmb + + set movie(action) slice + # must be >=5, or sometimes will generate bad data + set movie(quality) 5 + set movie(num) 24 + set movie(az,from) 45 + set movie(az,to) -45 + set movie(el,from) 30 + set movie(el,to) 30 + set movie(sl,from) 1 + set movie(sl,to) 1 + set movie(repeat) oscillate + set movie(repeat,num) 0 + + set movie(status) 0 + set movie(abort) 0 + + set aa [msgcat::mc {An error has occurred while creating the image. Please be sure that the entire image window is visible on the screen.}] + set bb [msgcat::mc {An error has occurred while creating the image. Please be sure that the ds9 window is in the upper left corner of the default screen and the entire window is visible.}] + switch $tcl_platform(os) { + Darwin { + switch [lindex [split $tcl_platform(osVersion) {.}] 0] { + 10 - + 11 {set movie(error) $bb} + 8 - + 9 - + default {set movie(error) $aa} + } + } + default {set movie(error) $aa} + } +} + +proc MovieDialog {} { + global movie + global mpegfbox + global ed + global current + + set w {.movie} + + set ed(ok) 0 + set ed(action) $movie(action) + + DialogCreate $w [msgcat::mc {Create Movie}] ed(ok) + + # Param + set f [ttk::frame $w.param] + ttk::label $f.title -text [msgcat::mc {Format}] + ttk::radiobutton $f.slice -text {Slice Movie} \ + -variable ed(action) -value slice + ttk::radiobutton $f.frame -text {Frames Movie} \ + -variable ed(action) -value frame + ttk::radiobutton $f.3d -text {3D Movie} \ + -variable ed(action) -value 3d + + grid $f.slice -padx 2 -pady 2 -sticky w + grid $f.frame -padx 2 -pady 2 -sticky w + grid $f.3d -padx 2 -pady 2 -sticky w + + switch [$current(frame) get type] { + base - + rgb {$f.3d configure -state disabled} + 3d {$f.3d configure -state normal} + } + + # Buttons + set f [ttk::frame $w.buttons] + ttk::button $f.ok -text [msgcat::mc {OK}] -command {set ed(ok) 1} \ + -default active + ttk::button $f.cancel -text [msgcat::mc {Cancel}] -command {set ed(ok) 0} + pack $f.ok $f.cancel -side left -expand true -padx 2 -pady 4 + + bind $w <Return> {set ed(ok) 1} + + # Fini + ttk::separator $w.sep -orient horizontal + pack $w.buttons $w.sep -side bottom -fill x + pack $w.param -side top -fill both -expand true + + DialogCenter $w + DialogWait $w ed(ok) + DialogDismiss $w + + if {$ed(ok)} { + set movie(action) $ed(action) + set fn [SaveFileDialog mpegfbox] + + if {$fn != {}} { + set ok 1 + switch $movie(action) { + slice - + frame {} + 3d {set ok [Movie3dDialog]} + } + + if {$ok} { + Movie $fn + } + } + } + + set rr $ed(ok) + unset ed + return $rr +} + +proc Movie {fn} { + global ds9 + global movie + global current + global saveimage + + if {$fn == {} || ![$current(frame) has fits]} { + return + } + + switch $ds9(wm) { + x11 {} + aqua - + win32 { + Error $saveimage(error) + return + } + } + + # besure we are on top + raise $ds9(top) + + # we need single mode + if {$ds9(display) != {single}} { + set modesav $ds9(display) + set current(display) single + DisplayMode + } + + switch $movie(action) { + slice {MovieSlice $fn} + frame {MovieFrame $fn} + 3d {Movie3d $fn} + } + + if {[info exists modesav]} { + set current(display) $modesav + DisplayMode + } +} + +proc MovieSlice {fn} { + global current + global movie + global cube + + set depth [$current(frame) get fits depth $cube(axis)] + set slice [$current(frame) get fits slice $cube(axis)] + + if {$cube(axis)==2} { + set ss [$current(frame) get crop 3d image] + set from [lindex $ss 0] + set to [lindex $ss 1] + } else { + set from 1 + set to [$current(frame) get fits depth $cube(axis)] + } + + # loop thru cube + set movie(first) 1 + for {set ii $from} {$ii <= $to} {incr ii} { + $current(frame) update fits slice $cube(axis) $ii + if {[MoviePhoto $fn]} { + break + } + } + mpeg close + + # reset current slice + $current(frame) update fits slice $cube(axis) $slice +} + +proc MovieFrame {fn} { + global ds9 + global current + global movie + + # loop thru all active frames + set movie(first) 1 + set framesav $current(frame) + + foreach ff $ds9(active) { + set ds9(next) $ff + GotoFrame + if {[MoviePhoto $fn]} { + break + } + } + mpeg close + + set ds9(next) $framesav + GotoFrame +} + +proc Movie3d {fn} { + global movie + global current + global cube + + set slice [$current(frame) get fits slice $cube(axis)] + set vp [$current(frame) get 3d view] + + set azincr [expr 1.*($movie(az,to)-$movie(az,from))/$movie(num)] + set elincr [expr 1.*($movie(el,to)-$movie(el,from))/$movie(num)] + set slincr [expr 1.*($movie(sl,to)-$movie(sl,from))/$movie(num)] + + # loop over az/el/slice + set movie(status) 0 + set movie(abort) 0 + set movie(first) 1 + + set az $movie(az,from) + set el $movie(el,from) + set sl $movie(sl,from) + + for {set rr 0} {$rr<=$movie(repeat,num)} {incr rr} { + for {set nn 0} {$nn<=$movie(num)} {incr nn} { + MovieStatusDialog + + if {$movie(abort)} { + break + } + set movie(status) [expr 1.*$nn/$movie(num)*100] + update idletasks + + $current(frame) 3d view $az $el + $current(frame) update fits slice $cube(axis) [expr int($sl)] + if {[MoviePhoto $fn]} { + break + } + set az [expr $az+$azincr] + set el [expr $el+$elincr] + set sl [expr $sl+$slincr] + } + switch $movie(repeat) { + repeat { + set az $movie(az,from) + set el $movie(el,from) + set sl $movie(sl,from) + } + oscillate { + set azincr [expr -$azincr] + set elincr [expr -$elincr] + set slincr [expr -$slincr] + } + } + } + mpeg close + + MovieStatusDestroyDialog + + # reset + $current(frame) 3d view $vp + $current(frame) update fits slice $cube(axis) $slice + Update3DDialog + UpdateCubeDialog +} + +# Support + +proc MoviePhoto {fn} { + global ds9 + global movie + global current + + # yes, we need this + UpdateDS9 + RealizeDS9 1 + + set rr [catch {image create photo -format window -data $ds9(canvas)} ph] + if {$rr} { + Error $movie(error) + return $rr + } + + if {$movie(first)} { + set w [image width $ph] + set h [image height $ph] + mpeg create "$fn" $w $h 25 1 $movie(quality) + set movie(first) 0 + } + mpeg add $ph + + image delete $ph + return 0 +} + +proc Movie3dDialog {} { + global movie + global ed2 + global current + global cube + + set w {.movie3d} + + set ed2(ok) 0 + set ed2(num) $movie(num) + set ed2(az,from) $movie(az,from) + set ed2(az,to) $movie(az,to) + set ed2(el,from) $movie(el,from) + set ed2(el,to) $movie(el,to) + set ed2(sl,from) [$current(frame) get fits slice $cube(axis)] + set ed2(sl,to) $ed2(sl,from) + set ed2(repeat) $movie(repeat) + set ed2(repeat,num) $movie(repeat,num) + + DialogCreate $w [msgcat::mc {Save 3D Movie}] ed2(ok) + + # Param + set f [ttk::frame $w.param] + ttk::label $f.tnum -text [msgcat::mc {Number}] + ttk::entry $f.num -textvariable ed2(num) -width 7 + ttk::label $f.tframes -text [msgcat::mc {Frames}] + + ttk::label $f.taz -text [msgcat::mc {Azimuth}] + ttk::label $f.tazfrom -text [msgcat::mc {From}] + ttk::entry $f.azfrom -textvariable ed2(az,from) -width 7 + ttk::label $f.tazto -text [msgcat::mc {To}] + ttk::entry $f.azto -textvariable ed2(az,to) -width 7 + + ttk::label $f.tel -text [msgcat::mc {Elevation}] + ttk::label $f.telfrom -text [msgcat::mc {From}] + ttk::entry $f.elfrom -textvariable ed2(el,from) -width 7 + ttk::label $f.telto -text [msgcat::mc {To}] + ttk::entry $f.elto -textvariable ed2(el,to) -width 7 + + ttk::label $f.tsl -text [msgcat::mc {Slice}] + ttk::label $f.tslfrom -text [msgcat::mc {From}] + ttk::entry $f.slfrom -textvariable ed2(sl,from) -width 7 + ttk::label $f.tslto -text [msgcat::mc {To}] + ttk::entry $f.slto -textvariable ed2(sl,to) -width 7 + + ttk::radiobutton $f.repeat -text [msgcat::mc {Repeat}] \ + -variable ed2(repeat) -value repeat + ttk::radiobutton $f.oscillate -text [msgcat::mc {Oscillate}] \ + -variable ed2(repeat) -value oscillate + ttk::entry $f.repeatnum -textvariable ed2(repeat,num) -width 7 + ttk::label $f.ttimes -text [msgcat::mc {Times}] + + grid $f.tnum x $f.num $f.tframes -padx 2 -pady 2 -sticky w + grid $f.taz $f.tazfrom $f.azfrom $f.tazto $f.azto -padx 2 -pady 2 -sticky w + grid $f.tel $f.telfrom $f.elfrom $f.telto $f.elto -padx 2 -pady 2 -sticky w + grid $f.tsl $f.tslfrom $f.slfrom $f.tslto $f.slto -padx 2 -pady 2 -sticky w + grid $f.oscillate x $f.repeatnum $f.ttimes -padx 2 -pady 2 -sticky w + grid $f.repeat -padx 2 -pady 2 -sticky w + + # Buttons + set f [ttk::frame $w.buttons] + ttk::button $f.ok -text [msgcat::mc {OK}] -command {set ed2(ok) 1} \ + -default active + ttk::button $f.cancel -text [msgcat::mc {Cancel}] -command {set ed2(ok) 0} + pack $f.ok $f.cancel -side left -expand true -padx 2 -pady 4 + + bind $w <Return> {set ed2(ok) 1} + + # Fini + ttk::separator $w.sep -orient horizontal + pack $w.buttons $w.sep -side bottom -fill x + pack $w.param -side top -fill both -expand true + + DialogCenter $w + DialogWait $w ed2(ok) + DialogDismiss $w + + if {$ed2(ok)} { + set movie(num) $ed2(num) + set movie(az,from) $ed2(az,from) + set movie(az,to) $ed2(az,to) + set movie(el,from) $ed2(el,from) + set movie(el,to) $ed2(el,to) + set movie(sl,from) $ed2(sl,from) + set movie(sl,to) $ed2(sl,to) + set movie(repeat) $ed2(repeat) + set movie(repeat,num) $ed2(repeat,num) + } + + set rr $ed2(ok) + unset ed2 + return $rr +} + +proc MovieStatusDialog {} { + global imovie + global movie + + # see if we already have a window visible + if {[winfo exists $imovie(top)]} { + raise $imovie(top) + return + } + + # create the 3d window + set w $imovie(top) + set mb $imovie(mb) + + Toplevel $w $mb 6 [msgcat::mc {Movie}] MovieStatusDestroyDialog + raise $imovie(top) + + # Status + set f [ttk::frame $w.param] + ttk::label $f.tstatus -text [msgcat::mc {Status}] + ttk::progressbar $f.status -variable movie(status) -length 350 + grid $f.tstatus $f.status -padx 2 -pady 2 -sticky w + + # Buttons + set f [ttk::frame $w.buttons] + ttk::button $f.abort -text [msgcat::mc {Abort}] \ + -command MovieStatusAbortDialog + pack $f.abort -side left -expand true -padx 2 -pady 4 + + # Fini + ttk::separator $w.sep -orient horizontal + pack $w.buttons $w.sep -side bottom -fill x + pack $w.param -side top -fill x +} + +proc MovieStatusDestroyDialog {} { + global movie + global imovie + + if {[winfo exists $imovie(top)]} { + destroy $imovie(top) + destroy $imovie(mb) + } +} + +proc MovieStatusAbortDialog {} { + global movie + set movie(abort) 1 +} + +# Process Cmds + +proc ProcessMovieCmd {varname iname} { + upvar $varname var + upvar $iname i + + global movie + + # we need to be realized + # already implemented + # ProcessRealizeDS9 + + set item [string tolower [lindex $var $i]] + switch -- $item { + slice - + frame - + 3d { + set movie(action) $item + incr i + } + default { + # backward compatibility + set movie(action) frame + } + } + + set fn [lindex $var $i] + + set go 1 + while {$go} { + incr i + set item [string tolower [lindex $var $i]] + switch -- $item { + number { + incr i + set movie(num) [lindex $var $i] + } + azfrom { + incr i + set movie(az,from) [lindex $var $i] + } + azto { + incr i + set movie(az,to) [lindex $var $i] + } + elfrom { + incr i + set movie(el,from) [lindex $var $i] + } + elto { + incr i + set movie(el,to) [lindex $var $i] + } + slfrom { + incr i + set movie(sl,from) [lindex $var $i] + } + slto { + incr i + set movie(sl,to) [lindex $var $i] + } + oscillate { + incr i + set movie(repeat) oscillate + set movie(repeat,num) [lindex $var $i] + } + repeat { + incr i + set movie(repeat) repeat + set movie(repeat,num) [lindex $var $i] + } + default { + incr i -1 + set go 0 + } + } + } + + Movie $fn +} + + |