source: trunk/SRC/Postscript/closeps.pro @ 220

Last change on this file since 220 was 136, checked in by pinsard, 18 years ago

some improvements and corrections in some .pro file according to
aspell and idldoc log file

  • Property svn:keywords set to Id
File size: 4.4 KB
Line 
1;------------------------------------------------------------
2;------------------------------------------------------------
3;------------------------------------------------------------
4;+
5; @file_comments
6; Close the Postscript mode
7;
8; when archive_ps ne 0, we add the name and the date at the bottom left corner
9; of the postscript page.
10; If the postscript is called idl.ps we change its name to number.ps
11; (number automatically found to be 1 larger that any of the existing ps file)
12;
13; @keyword INFOWIDGET
14; A long integer giving the id of the information widget (created by openps)
15; that we have to destroy at the end of closeps (when the postscript is done).
16;
17; @uses cm_4ps
18;
19; @history Sebastien Masson (smasson\@lodyc.jussieu.fr)
20;                       21/12/98
21; June 2005: Sebastien Masson, english version with new commons
22;
23; @version $Id$
24;
25;-
26;------------------------------------------------------------
27;------------------------------------------------------------
28;------------------------------------------------------------
29PRO closeps, INFOWIDGET = infowidget
30;
31;
32  compile_opt idl2, strictarrsubs
33;
34   IF lmgr(/demo) EQ 1 THEN return
35;------------------------------------------------------------
36; include commons
37@cm_4ps
38  IF NOT keyword_set(key_forgetold) THEN BEGIN
39@updatenew
40  ENDIF
41;
42  IF !d.name NE 'PS' THEN GOTO, last_part
43;------------------------------------------------------------
44; if archive_ps /= 0 we will add its name and the date at the bottom
45; left corner of the page (in case if the postscript will be archived
46; in printps
47;------------------------------------------------------------
48   IF keyword_set(archive_ps) THEN BEGIN
49;------------------------------------------------------------
50; we get the name of the latest created postscript.
51;------------------------------------------------------------
52     psdir = isadirectory(psdir, title = 'Select psdir')
53     nameps = file_search(psdir+'*.ps' $
54                          , /test_regular, /test_write, /nosort)
55     dates = (file_info(nameps)).mtime
56     lastdate = (reverse(sort(temporary(dates))))[0]
57     nameps = nameps[lastdate]
58     nameps = file_basename(nameps, '.ps')
59; If this name is idl.ps then we change it to the number.ps
60     IF nameps EQ 'idl' then BEGIN
61; get the name of all the *.ps or *.ps.gz files available in psdir
62       allps = file_search(psdir+'*[.ps|.ps.gz|.pdf]', /test_regular, /nosort)
63       allps = file_basename(file_basename(allps,'.gz'),'.ps')
64       allps = file_basename(allps,'.pdf')
65; find which of these names corresponds to numbers...
66; get ascii codes of the names
67       testnumb = byte(allps)
68; longest name
69       maxstrlen = (size(testnumb, /dimensions))[0]
70; ascii codes can be 0 or between byte('0') and byte('9')
71       testnumb = testnumb EQ 0 OR $
72                  (testnumb GE (byte('0'))[0] AND testnumb LE (byte('9'))[0])
73       testnumb = where(total(testnumb, 1) EQ maxstrlen, count)
74       IF count NE 0 THEN BEGIN
75; get the largest number
76         psnumber = fix(allps[testnumb])
77         psnumber = (psnumber[reverse(sort(psnumber))])[0] + 1
78       ENDIF ELSE psnumber = 0
79       nameps = strtrim(psnumber, 2)
80     ENDIF
81;------------------------------------------------------------
82; we annotate the postscript
83;------------------------------------------------------------
84     date = byte(systime(0))    ; we get the date
85     xyouts, !d.x_px_cm, !d.y_px_cm $
86             , nameps+') '+string(date[4:10])+string(date[20:23]) $
87             , /device, charsize = .75
88   ENDIF
89;------------------------------------------------------------
90; close the postscript mode
91   device, /close
92;
93last_part:
94;
95   thisOS = strupcase(strmid(!version.os_family, 0, 3))
96   CASE thisOS of
97     'MAC': SET_PLOT, thisOS
98     'WIN': SET_PLOT, thisOS
99     ELSE: SET_PLOT, 'X'
100   ENDCASE
101   def_myuniquetmpdir
102   colorfile = myuniquetmpdir + 'original_colors.dat'
103   IF file_test(colorfile, /regular) THEN BEGIN
104     restore, colorfile
105     file_delete, colorfile, /quiet
106; reload the original colors
107     tvlct, red, green, blue
108   ENDIF
109   !p.font = -1
110; force background color to the last color (white)
111   !p.BACKGROUND=(!d.n_colors-1) < 255
112   !p.color=0
113   if !d.n_colors gt 256 then !p.background='ffffff'x
114;------------------------------------------------------------
115   if keyword_set(infowidget) then $
116    widget_control, long(infowidget), bad_id = toto, /destroy
117;------------------------------------------------------------
118   return
119end
Note: See TracBrowser for help on using the repository browser.