; docformat = 'rst'
;
; NAME:
; cgSnapshot
;
; PURPOSE:
; To get accurate screen dumps with the IDL command TVRD on 24-bit
; PC and Macintosh computers, you have to be sure to set color
; decomposition on. This program adds that capability automatically.
; In addition, the program will optionally write BMP, GIF, JPEG,
; PICT, PNG, and TIFF color image files of the screen dump.
;
;******************************************************************************************;
; ;
; Copyright (c) 2011, by Fanning Software Consulting, Inc. All rights reserved. ;
; ;
; Redistribution and use in source and binary forms, with or without ;
; modification, are permitted provided that the following conditions are met: ;
; ;
; * Redistributions of source code must retain the above copyright ;
; notice, this list of conditions and the following disclaimer. ;
; * Redistributions in binary form must reproduce the above copyright ;
; notice, this list of conditions and the following disclaimer in the ;
; documentation and/or other materials provided with the distribution. ;
; * Neither the name of Fanning Software Consulting, Inc. nor the names of its ;
; contributors may be used to endorse or promote products derived from this ;
; software without specific prior written permission. ;
; ;
; THIS SOFTWARE IS PROVIDED BY FANNING SOFTWARE CONSULTING, INC. ''AS IS'' AND ANY ;
; EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES ;
; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT ;
; SHALL FANNING SOFTWARE CONSULTING, INC. BE LIABLE FOR ANY DIRECT, INDIRECT, ;
; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED ;
; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; ;
; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ;
; ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ;
; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;
; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ;
;******************************************************************************************;
;
;+
; To get accurate screen dumps with the IDL command TVRD on 24-bit
; PC and Macintosh computers, you have to be sure to set color
; decomposition on. This program adds that capability automatically.
; In addition, the program will optionally write BMP, GIF, JPEG,
; PICT, PNG, and TIFF color image files of the screen dump.
;
; :Categories:
; Graphics
;
; :Returns:
; The returned image will be a 2D image on 8-bit systems and a 24-bit pixel
; interleaved true-color image on 24-bit systems. A -1 will be returned if a
; file output keyword is used (e.g., JPEG, TIFF, etc.).
;
; :Params:
; xstart: in, optional, type=integer, default=0
; The starting column index of the rectantular area that is to be copied.
; ystart: in, optional, type=integer, default=0
; The starting row index of the rectantular area that is to be copied.
; ncols: in, optional, type=integer
; The number of columns to read in the rectantular area that is to be
; copied. By default, !D.X_Size - xstart.
; nrows: in, optional, type=integer
; The number of rows to read in the rectantular area that is to be
; copied. By default, !D.Y_Size - ystart.
;
; :Keywords:
; bmp: in, optional, type=boolean, default=0
; Set this keyword to write the screen dump as a color BMP file.
; cancel: out, optional, type=boolean, default=0
; An output keyword set to 1 if the user cancels out of a filename dialog.
; Set to 0 otherwise.
; colors: in, optional, type=integer, default=256
; If a 24-bit image has to be quantized, this will set the number of colors in
; the output image. Applies to BMP, GIF, PICT, and PNG formats written from
; 24-bit displays.(See the COLOR_QUAN documentation for details.)
; cube: in, optional, type=integer
; If this keyword is set to a value between 2 and 6 the color quantization will
; use a cubic method of quantization. Applies to BMP, GIF, PICT, and PNG formats
; written from 24-bit displays.(See the COLOR_QUAN documentation for details.)
; dither: in, optional, type=boolean, default=0
; If this keyword is set the quantized image will be dithered. Applies to BMP,
; GIF, PICT, and PNG formats written from 24-bit displays.(See the COLOR_QUAN
; documentation for details.)
; filename: in, optional, type=string
; The name of the output file. If you specify a name with a file extension of the
; type of file you want to create (e.g., *.jpg, *.png, etc), then you do not have
; to use the file type keywords (e.g., JPEG, PNG, etc.). Otherwise, you can specify
; the name of the the file without an extension, use the file keywords, and a file
; extension will be added to the filename automatically, depending upon the type of
; output file selected.
; gif: in, optional, type=boolean, default=0
; Set this keyword to write the screen dump as a color GIF file.
; jp2: in, optional, type=boolean, default=0
; Set this keyword to write a color JPEG2000 file.
; jpeg: in, optional, type=boolean, default=0
; Set this keyword to write the screen dump as a color JPEG file.
; nodialog: in, optional, type=boolean, default=0
; Set this keyword if you wish to avoid the DIALOG_PICKFILE dialog that asks you
; to name the output file. This keyword should be set, for example, if you are
; processing screens in batch mode.
; order: in, optional, type=boolean, default=0
; Set this keyword to determine the image order for reading the display. Corresponds to
; !Order and set to such as the default.
; overwrite_prompt: in, optional, type=boolean, default=0
; Set this keyword if you would like to get a prompt if you are overwriting a file.
; This applies only to operations involving DIALOG_PICKFILE.
; pict: in, optional, type=boolean, default=0
; Set this keyword to write the screen dump as a color PICT file.
; png: in, optional, type=boolean, default=0
; Set this keyword to write the screen dump as a color PNG file.
; position: in, optional, type=float
; An alternative way of setting the `xstart`, `ystart`, `ncols` and `nrows` parameters
; by specifying a four-element normalized array, [x0,y0,x1,y1].
; tiff: in, optional, type=boolean, default=0
; Set this keyword to write the screen dump as a color TIFF file.
; true: in, optional, type=integer, default=1
; Set this keyword to the type of interleaving you want. 1 = Pixel interleaved,
; 2 = row interleaved, 3 = band interleaved.
; type: in, optional, type=string
; Set this keyword to the type of file to write. Use this instead of
; setting BMP, GIF, JPEG, PICT, PNG, or TIFF keywords: TYPE='JPEG'. The
; primary purpose of this is to make widget event handlers easier to write.
; quality: in, optional, type=integer, default=75
; This keyword sets the amount of compression for JPEG images. It should be set to a
; value between 0 and 100. (See the WRITE_JPEG documentation for details.)
; wid: in, optional, type=integer
; The index number of the window to read from. The current graphics window
; (!D.Window) is selected by default. An error is issued if no windows are
; currently open on a device that supports windows.
; _ref_extra: in, optional
; Any keywords that are appropriate for the WRITE_*** routines are also accepted via
; keyword inheritance.
;
; :Examples:
; To obtain an image of the current graphics window::
;
; IDL> image = cgSnapshot()
;
; To create a PNG file, named "test.png", of the current graphics window::
;
; IDL> void = cgSnapshot(FILENAME='test.png')
;
; To obtain the lower quadrant of a 512-by-512 graphics window as a
; band interleaved image::
;
; IDL> image = cgSnapshot(0, 0, 256, 256, TRUE=3)
;
; :Author:
; FANNING SOFTWARE CONSULTING::
; David W. Fanning
; 1645 Sheely Drive
; Fort Collins, CO 80526 USA
; Phone: 970-221-0438
; E-mail: david@idlcoyote.com
; Coyote's Guide to IDL Programming: http://www.idlcoyote.com
;
; :History:
; Change History::
; Renamed TVRead to cgSnapshot and retired TVRead. 20 February 2011. DWF.
; Added the ability to get the file type from the file name extension. 26 Dec 2011. DWF.
; Added a POSITION keyword to select a position inside the window for capture. 20 October 2012. DWF.
; Fixed a problem with not setting back to incoming decomposed state on an error. 20 Nov 2012. DWF.
; Added ability to write JPEG2000 files. 7 February 2014. DWF.
;
; :Copyright:
; Copyright (c) 2011-2014, Fanning Software Consulting, Inc.
;-
FUNCTION cgSnapshot, xstart, ystart, ncols, nrows, $
BMP=bmp, $
Cancel=cancel, $
Colors=colors, $
Cube=cube, $
Dither=dither, $
Filename=filename, $
GIF=gif, $
JP2=jp2, $
JPEG=jpeg, $
NoDialog=nodialog, $
Order=order, $
Overwrite_Prompt=overwrite_prompt, $
PICT=pict, $
PNG=png, $
POSITION=position, $
TIFF=tiff, $
True=true, $
Type=type, $
Quality=quality, $
WID=wid, $
_Ref_Extra=extra
; Error handling.
Catch, theError
IF theError NE 0 THEN BEGIN
Catch, /Cancel
ok = cgErrorMsg()
IF N_Elements(thisWindow) EQ 0 THEN RETURN, -1
IF thisWindow GE 0 THEN WSet, thisWindow
; Need to set color decomposition back?
IF (N_Elements(theDecomposedState) NE 0) && (theDepth GT 0) THEN BEGIN
Device, Decomposed=theDecomposedState
ENDIF
RETURN, -1
ENDIF
cancel = 0
; Check for availability of GIF files.
thisVersion = Float(!Version.Release)
IF (thisVersion LT 5.3) OR (thisVersion GE 6.1) THEN haveGif = 1 ELSE haveGIF = 0
; Go to correct window.
IF N_Elements(wid) EQ 0 THEN wid =!D.Window
thisWindow = !D.Window
IF (!D.Flags AND 256) NE 0 THEN WSet, wid
; Did the user specify a normalized position in the window?
IF N_Elements(position) NE 0 THEN BEGIN
xstart = position[0] * !D.X_VSize
ystart = position[1] * !D.Y_VSize
ncols = (position[2]*!D.X_VSize) - xstart
nrows = (position[3]*!D.Y_VSize) - ystart
ENDIF
; Check keywords and parameters. Define values if necessary.
IF N_Elements(xstart) EQ 0 THEN xstart = 0
IF N_Elements(ystart) EQ 0 THEN ystart = 0
IF N_Elements(ncols) EQ 0 THEN ncols = !D.X_VSize - xstart
IF N_Elements(nrows) EQ 0 THEN nrows = !D.Y_VSize - ystart
IF N_Elements(order) EQ 0 THEN order = !Order
IF N_Elements(true) EQ 0 THEN true = 1
dialog = 1 - Keyword_Set(nodialog)
; Is the FILENAME keyword being used? If so, get the type of the
; file from the filename extension.
IF N_Elements(filename) NE 0 THEN BEGIN
root_name = cgRootName(filename, DIRECTORY=theDir, EXTENSION=ext)
IF ext NE "" THEN BEGIN
type = StrUpCase(ext)
typeFromExtension = 1
ENDIF ELSE typeFromExtension = 0
ENDIF ELSE typeFromExtension = 0
; Do you want to write an image file instead of capturing an image?
IF N_Elements(type) NE 0 THEN BEGIN
CASE StrUpCase(type) OF
'BMP': bmp = 1
'GIF': gif = 1
'JP2': jp2 = 1
'JPEG': jpeg = 1
'JPG': jpeg = 1
'PICT': pict = 1
'PNG': png = 1
'TIFF': tiff = 1
'TIF': tif = 1
ELSE: Message, 'Cannot write a file of type: ' + StrUpCase(type) + '.'
ENDCASE
ENDIF
writeImage = 0
fileType = ""
extention = ""
IF Keyword_Set(bmp)THEN BEGIN
writeImage = 1
fileType = 'BMP'
extension = 'bmp'
ENDIF
IF Keyword_Set(gif) THEN BEGIN
IF havegif THEN BEGIN
writeImage = 1
fileType = 'GIF'
extension = 'gif'
ENDIF ELSE BEGIN
ok = Dialog_Message('GIF files not supported in this IDL version. Replacing with JPEG.')
writeImage = 1
fileType = 'JPEG'
extension = 'jpg'
ENDELSE
ENDIF
IF Keyword_Set(jp2) THEN BEGIN
writeImage = 1
fileType = 'JPEG2000'
extension = 'jp2'
ENDIF
IF Keyword_Set(jpeg) THEN BEGIN
writeImage = 1
fileType = 'JPEG'
extension = 'jpg'
ENDIF
IF Keyword_Set(PICT) THEN BEGIN
writeImage = 1
fileType = 'PICT'
extension = 'pict'
ENDIF
IF Keyword_Set(png) THEN BEGIN
writeImage = 1
fileType = 'PNG'
extension = 'png'
ENDIF
IF Keyword_Set(tiff) THEN BEGIN
writeImage = 1
fileType = 'TIFF'
extension = 'tif'
ENDIF
IF N_Elements(colors) EQ 0 THEN colors = 256
IF N_Elements(quality) EQ 0 THEN quality = 75
dither = Keyword_Set(dither)
; On 24-bit displays, make sure color decomposition is ON.
IF (!D.Flags AND 256) NE 0 THEN BEGIN
Device, Get_Decomposed=theDecomposedState, Get_Visual_Depth=theDepth
IF theDepth GT 8 THEN BEGIN
Device, Decomposed=1
IF theDepth EQ 24 THEN truecolor = true ELSE truecolor = 0
ENDIF ELSE truecolor = 0
IF wid LT 0 THEN $
Message, 'No currently open windows. Returning.', /NoName
ENDIF ELSE BEGIN
truecolor = 0
theDepth = 8
ENDELSE
; Fix for 24-bit Z-buffer.
IF (Float(!Version.Release) GE 6.4) AND (!D.NAME EQ 'Z') THEN BEGIN
Device, Get_Decomposed=theDecomposedState, Get_Pixel_Depth=theDepth
IF theDepth EQ 24 THEN truecolor = true ELSE truecolor = 0
ENDIF
; Get the screen dump. 2D image on 8-bit displays. 3D image on 24-bit displays.
image = TVRD(xstart, ystart, ncols, nrows, True=truecolor, Order=order)
; Need to set color decomposition back?
IF theDepth GT 8 THEN Device, Decomposed=theDecomposedState
; If we need to write an image, do it here.
IF writeImage THEN BEGIN
; Get the name of the output file.
IF N_Elements(filename) EQ 0 THEN BEGIN
filename = 'idl.' + StrLowCase(extension)
ENDIF ELSE BEGIN
IF typeFromExtension EQ 0 THEN filename = filename + "." + StrLowCase(extension)
ENDELSE
IF dialog THEN filename = Dialog_Pickfile(/Write, File=filename, OVERWRITE_PROMPT=Keyword_Set(overwrite_prompt))
IF filename EQ "" THEN BEGIN
cancel = 1
RETURN, image
ENDIF
; Write the file.
CASE fileType OF
'BMP': BEGIN
IF truecolor THEN BEGIN
; BMP files assume blue, green, red planes.
temp = image[0,*,*]
image[0,*,*] = image[2,*,*]
image[2,*,*] = temp
Write_BMP, filename, image, _Extra=extra
ENDIF ELSE BEGIN
TVLCT, r, g, b, /Get
Write_BMP, filename, image, r, g, b, _Extra=extra
ENDELSE
END
'GIF': BEGIN
IF truecolor THEN BEGIN
CASE Keyword_Set(cube) OF
0: image2D = Color_Quan(image, 1, r, g, b, Colors=colors, Dither=dither)
1: image2D = Color_Quan(image, 1, r, g, b, Cube=2 > cube < 6)
ENDCASE
ENDIF ELSE BEGIN
TVLCT, r, g, b, /Get
image2D = image
ENDELSE
Write_GIF, filename, image2D, r, g, b, _Extra=extra
END
'JPEG2000': BEGIN
IF truecolor THEN BEGIN
image3D = image
ENDIF ELSE BEGIN
s = Size(image, /Dimensions)
image3D = BytArr(3, s[0], s[1])
TVLCT, r, g, b, /Get
image3D[0,*,*] = r[image]
image3D[1,*,*] = g[image]
image3D[2,*,*] = b[image]
ENDELSE
Write_JPEG2000, filename, image3D, _Extra=extra
END
'JPEG': BEGIN
IF truecolor THEN BEGIN
image3D = image
ENDIF ELSE BEGIN
s = Size(image, /Dimensions)
image3D = BytArr(3, s[0], s[1])
TVLCT, r, g, b, /Get
image3D[0,*,*] = r[image]
image3D[1,*,*] = g[image]
image3D[2,*,*] = b[image]
ENDELSE
Write_JPEG, filename, image3D, True=1, Quality=quality, _Extra=extra
END
'PICT': BEGIN
IF truecolor THEN BEGIN
CASE Keyword_Set(cube) OF
0: image2D = Color_Quan(image, 1, r, g, b, Colors=colors, Dither=dither)
1: image2D = Color_Quan(image, 1, r, g, b, Cube=2 > cube < 6)
ENDCASE
ENDIF ELSE BEGIN
TVLCT, r, g, b, /Get
image2D = image
ENDELSE
Write_PICT, filename, image2D, r, g, b
END
'PNG': BEGIN
IF truecolor THEN BEGIN
Write_PNG, filename, image, _Extra=extra
ENDIF ELSE BEGIN
TVLCT, r, g, b, /Get
image2D = image
Write_PNG, filename, image2D, r, g, b, _Extra=extra
ENDELSE
END
'TIFF': BEGIN
IF truecolor THEN BEGIN
image3D = Reverse(image,3)
ENDIF ELSE BEGIN
s = Size(image, /Dimensions)
image3D = BytArr(3, s[0], s[1])
TVLCT, r, g, b, /Get
image3D[0,*,*] = r[image]
image3D[1,*,*] = g[image]
image3D[2,*,*] = b[image]
image3D = Reverse(Temporary(image3D), 3)
ENDELSE
Write_TIFF, filename, image3D, 1, _Extra=extra
END
ENDCASE
RETURN, -1
ENDIF
; Return the screen dump image.
RETURN, image
END ;-------------------------------------------------------------------------------