# This code is an example I found on the Wiki (http://mini.net/tcl/9127).
#
# Capture a window into an image
# Author: David Easton
#

proc captureWindow {win} {
   global img_version

   if {$img_version < 0} {
      tk_messageBox -type ok -message \
      "The Img extension is
REQUIRED for capturing
the window to an image
file from within JStrack.

See the JStrack web page
for more information
about adding the Img extension."
      return
   }

   regexp {([0-9]*)x([0-9]*)\+([0-9]*)\+([0-9]*)} \
          [winfo geometry $win] - w h x y

   # Make the base image based on the window
   set image [image create photo -format window -data $win]

   foreach child [winfo children $win] {
      captureWindowSub $child $image 0 0
   }

   return $image
}

proc captureWindowSub {win image px py} {
   if {![winfo ismapped $win]} { return }

   regexp {([0-9]*)x([0-9]*)\+([0-9]*)\+([0-9]*)} \
          [winfo geometry $win] - w h x y
   incr px $x
   incr py $y

   # Make an image from this widget
   set tempImage [image create photo -format window -data $win]

   # Copy this image into place on the main image
   $image copy $tempImage -to $px $py
   image delete $tempImage

   foreach child [winfo children $win] {
      captureWindowSub $child $image $px $py
   }
}


proc windump {win imgtype filename {stormname ""}} {
   global stinfo st_names st_times storm_x storm_y ptrlocstr
   global show_ptrloc color altprint

   # If we're printing this for a specific storm (command line),
   # jump to the latest position so it shows up (with a pointer)
   # in the info fields on the bottom of the main window.

   if {[string length $stormname]} {
      # Collect info
      set stormname [string toupper $stormname]
      set timestamp [lindex [split $st_times($stormname)] end]
      # canvas x/y for lat/long
      set x $storm_x($stormname$timestamp)
      set y $storm_y($stormname$timestamp)
      # root x/y
      set lx [expr {$x + [winfo rootx .c]}]
      set ly [expr {$y + [winfo rooty .c]}]

      # Warp the mouse to the storm's latest position
      event generate "" <<MOTION>> -warp 1 -x $lx -y $ly

      set latt [get_latt $y]
      set long [get_long $x]
      set ptrlocstr "$latt N $long W"
      update
   }

   set arrows [list]
   set uc $color(b3box)
   if {$altprint} { set uc black }
   foreach s $st_names {
      set t [lindex [split $st_times($s)] 0]
      set type [lindex $stinfo($s$t) 0]
      set x $storm_x($s$t) ; set y $storm_y($s$t)
      set x [expr {$x + 5}]
      set arr_off [expr {$x + 20}]
      set txt_off [expr {$arr_off + 10}]
      lappend arrows [.c create line $x $y $arr_off $y -width 3 \
         -arrow first -fill $uc -arrowshape [list 10 10 10]]
      lappend arrows [.c create text $txt_off $y -text "$type $s" \
         -fill $uc -font {Times 14 bold} -anchor w]
   }
   update

   set image [captureWindow $win]
   # Clean-up if we warped the mouse, etc.
   if {[string length $stormname]} {
      if {$show_ptrloc == 0} { set ptrlocstr "(not active)" }
   }
   foreach arrow $arrows { .c delete $arrow }
   if {[file exists $filename]} {
      set ans [tk_messageBox -type yesno \
               -message "$filename exists:  overwrite?"]
      switch $ans {
         yes { catch { file delete $filename } }
         no { image delete $image ; return }
      }
   }
   update
   $image write -format $imgtype $filename
   image delete $image
}


proc windump_ask {win} {
   set types {
      {"TIFF" {.tiff}}
   }

   tk_messageBox -type ok \
   -message "Make sure no windows are on top of the main window; your image will be saved as a TIFF image."
   set filename [tk_getSaveFile -filetypes $types]
   update

   if {[llength $filename]} {
      switch [file extension $filename] {
         .tiff   { set imgtype tiff }
         .tif    { set imgtype tiff }
         default {
            set imgtype tiff
            set filename [file rootname $filename].tiff
         }
      }
      windump $win $imgtype $filename
      tk_messageBox -type ok -message "Image saved to $filename"
   } else {
      puts "Write cancelled"
   }

}

