File: cgsnapshot.pro

package info (click to toggle)
coyote 2019.01.29-1
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 6,316 kB
  • sloc: python: 184; makefile: 14; sh: 13
file content (455 lines) | stat: -rw-r--r-- 19,211 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
; 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 ;-------------------------------------------------------------------------------