IDL-Mailing-List-Gateway
Sender: idlusers-request@maz.sma.ch
We had some troubles with the new (undocumented ) ps_show_fonts
procedure from the IDL distribution 3.1.
To get smaller postscript files we have changed the code to
produce single files for each font, for details see modification
history. It might be useful for others
too. Here is the changed code (save it as ps_show_fonts2.pro ):
-Thomas
; ****************************** cut here **********************
; modified version of ps_show_fonts.pro from IDL Distribution 3.1
; to get it work on our Environment (SUN 4.1.2,
; Openwindows 3.0, Th. Oettli, see MODIFICATION HISTORY for details).
;
;+
; NAME:
; PS_SHOW_FONTS2
;
; PURPOSE:
; Display all the PostScript fonts that IDL knows about, with
; both the StandardAdobe and ISOLatin1 encodings. Each display
; takes is printed into a separate postscript file, and each
; character in each font is shown with its character index.
;
; CATEGORY:
; Fonts
;
; CALLING SEQUENCE:
; PS_SHOW_FONTS2
;
; INPUTS:
; None.
;
; OUTPUTS:
; None.
;
; COMMON BLOCKS:
; None.
;
; SIDE EFFECTS:
; PostScript files are produced, one file (1 page) per font/mapping
; combination.
;
; RESTRICTIONS:
; Save the world, a PostScript previewer is recommended rather than
; sending it to a printer.
;
; MODIFICATION HISTORY:
; 12 January 1993, AB, RSI.
; 8 July 1993, Th. Oettli ,
; - added full keyword to title print in
; ps_shofont: /COURIER,ISOLATIN1=0 instead of only
; /COURIER ( this doesn't work after the first font)
; - moved set_plot, 'PS' and device close to ps_shofont
; - inserted filename evaluation into ps_shofont and
; filename keyword to device statement
; - included function repchr from astronomy library
; (for usage out of our environment)
; - Inserted ' DEVICE, /COURIER,ISOLATIN1=0 ' before
; printing fonts number to have numbers even in
; fonts like Symbol or Zapfdingbats
; - renamed from ps_show_fonts to ps_show_fonts2.pro to
; avoid conflicts with existing procdure ps_show_fonts.
; - Correction in help section:
; procedure produces now small single files per font
; instead of one 2 MB File.
;
;-
FUNCTION REPCHR, OLD, C1, C2, help=hlp
;+
; NAME:
; REPCHR
;
; PURPOSE:
; Replace all occurences of one character with another
; in a text string. (Use the procedure REPSTR to replace
; more than one character.)
;
; CATEGORY:
; String Processing
;
; CALLING SEQUENCE:
; new = repchr( old, c1, [c2] )
;
; INPUTS:
; OLD = text string to edit, scalar or vector
; C1 = character to replace.
;
; OPTIONAL INPUTS:
; C2 = character to insert (def = ' ' = space).
;
; OUTPUTS:
; NEW = edited string.
;
; EXAMPLE:
; If old = 'THIS_IS_THE_TEXT' and c1 = '_'
; then
; IDL> print, repchr( old,c1 )
;
; would display 'THIS IS THE TEXT'
;
; MODIFICATION HISTORY:
; R. Sterner. 28 Oct, 1986.
; Removed call to ARRAY function, W. Landsman December, 1991
; Added to idlmeteo from the
; Astronomy User's Library (NASA) Nov-1992 oet@sma.ch
;
;-
if (N_params() LT 2) or keyword_set(HELP) then begin
print,' Replace all occurrences of one character with another '+$
'in a text string.'
print,' new = repchr(old, c1, [c2])'
print,' old = original text string. in'
print,' c1 = character to replace. in'
print,' c2 = character to replace it with. in'
print,' default is space.'
print,' new = edited string. out'
return, -1
endif
b = byte(old) ; convert string to a byte array.
cb1 = byte(c1) ; convert char 1 to byte.
w = where( b EQ cb1(0), Nfound) ; find occurrences of char 1.
if Nfound EQ 0 then return, old ; if none, return old string.
if N_params() LT 3 then c2 = ' ' ; default char 2 is space.
cb2 = byte(c2) ; convert char 2 to byte.
b(w) = cb2(0) ; replace char 1 by char 2.
return, string(b) ; return new string.
end
;
PRO PS_SHOFONT, font_kw
; Display the font selected by applying font_kw to the DEVICE
; procedure.
on_error, 2 ; Return to caller if an error occurs
message,/info,font_kw
olddev = !d.name
set_plot, 'PS'
fname=strmid(font_kw,1,strlen(font_kw))
fname=repchr(fname,'/','_')
fname=repchr(fname, ',','_')
fname=repchr(fname,'=','_')
fname=fname + '.ps'
DEVICE,ysize=9, yoffset=1, xsize=7, xoffset=0.3, /inch, $
/COURIER,ISOLATIN1=0, FILENAME=fname
xyouts, !d.x_size/2, !d.y_size+1000, /dev, font_kw, font=0
; Lay the characters and indices out in separate passes to minimize
; font switching.
junk = execute('DEVICE,'+font_kw)
row = 25
col = 0
xstep = 1./10.
ystep = 1./26.0
for ch = 1, 255 do begin
s = string(byte(ch))
if (s eq '!') then s = '!!'
xyouts, .075 + col * xstep, row*ystep, /norm, font=0, charsize=2.0, s
if (col eq 9) then begin
col = 0
row = row - 1
endif else col = col + 1
endfor
DEVICE, /COURIER,ISOLATIN1=0
row = 25
col = 0
xstep = 1./10.
ystep = 1./26.0
yoff=ystep * .1
for ch = 1, 255 do begin
xyouts, .12 + col * xstep, row*ystep-yoff, /norm, font=0, charsize=.5, $
string(ch,format='(I0)')
if (col eq 9) then begin
col = 0
row = row - 1
endif else col = col + 1
endfor
DEVICE, /CLOSE
set_plot,olddev
END
pro ps_show_fonts2 ;Display all of the fonts with and without ISO encodings.
on_error, 2 ; Return to caller if an error occurs
ps_shofont,'/COURIER,ISOLATIN1=0'
ps_shofont,'/COURIER,ISOLATIN1=1'
ps_shofont,'/COURIER,/BOLD,ISOLATIN1=0'
ps_shofont,'/COURIER,/BOLD,ISOLATIN1=1'
ps_shofont,'/COURIER,/OBLIQUE,ISOLATIN1=0'
ps_shofont,'/COURIER,/OBLIQUE,ISOLATIN1=1'
ps_shofont,'/COURIER,/BOLD,/OBLIQUE,ISOLATIN1=0'
ps_shofont,'/COURIER,/BOLD,/OBLIQUE,ISOLATIN1=1'
ps_shofont,'/HELVETICA,ISOLATIN1=0'
ps_shofont,'/HELVETICA,ISOLATIN1=1'
ps_shofont,'/HELVETICA,/BOLD,ISOLATIN1=0'
ps_shofont,'/HELVETICA,/BOLD,ISOLATIN1=1'
ps_shofont,'/HELVETICA,/OBLIQU,ISOLATIN1=0'
ps_shofont,'/HELVETICA,/OBLIQU,ISOLATIN1=1'
ps_shofont,'/HELVETICA,/BOLD,/OBLIQU,ISOLATIN1=0'
ps_shofont,'/HELVETICA,/BOLD,/OBLIQU,ISOLATIN1=1'
ps_shofont,'/HELVETICA,/NARROW,ISOLATIN1=0'
ps_shofont,'/HELVETICA,/NARROW,ISOLATIN1=1'
ps_shofont,'/HELVETICA,/NARROW,/BOLD,ISOLATIN1=0'
ps_shofont,'/HELVETICA,/NARROW,/BOLD,ISOLATIN1=1'
ps_shofont,'/HELVETICA,/NARROW,/OBLIQUE,ISOLATIN1=0'
ps_shofont,'/HELVETICA,/NARROW,/OBLIQUE,ISOLATIN1=1'
ps_shofont,'/HELVETICA,/NARROW,/BOLD,/OBLIQUE,ISOLATIN1=0'
ps_shofont,'/HELVETICA,/NARROW,/BOLD,/OBLIQUE,ISOLATIN1=1'
ps_shofont,'/AVANTGARDE,/BOOK,ISOLATIN1=0'
ps_shofont,'/AVANTGARDE,/BOOK,ISOLATIN1=1'
ps_shofont,'/AVANTGARDE,/BOOK,/OBLIQUE,ISOLATIN1=0'
ps_shofont,'/AVANTGARDE,/BOOK,/OBLIQUE,ISOLATIN1=1'
ps_shofont,'/AVANTGARDE,/DEMI,ISOLATIN1=0'
ps_shofont,'/AVANTGARDE,/DEMI,ISOLATIN1=1'
ps_shofont,'/AVANTGARDE,/DEMI,/OBLIQUE,ISOLATIN1=0'
ps_shofont,'/AVANTGARDE,/DEMI,/OBLIQUE,ISOLATIN1=1'
ps_shofont,'/BKMAN,/DEMI,ISOLATIN1=0'
ps_shofont,'/BKMAN,/DEMI,ISOLATIN1=1'
ps_shofont,'/BKMAN,/DEMI,/ITALIC,ISOLATIN1=0'
ps_shofont,'/BKMAN,/DEMI,/ITALIC,ISOLATIN1=1'
ps_shofont,'/BKMAN,/LIGHT,ISOLATIN1=0'
ps_shofont,'/BKMAN,/LIGHT,ISOLATIN1=1'
ps_shofont,'/BKMAN,/LIGHT,/ITALIC,ISOLATIN1=0'
ps_shofont,'/BKMAN,/LIGHT,/ITALIC,ISOLATIN1=1'
ps_shofont,'/ZAPFCHANCERY,/MEDIUM,/ITALIC,ISOLATIN1=0'
ps_shofont,'/ZAPFCHANCERY,/MEDIUM,/ITALIC,ISOLATIN1=1'
ps_shofont,'/ZAPFDINGBATS'
ps_shofont,'/SCHOOLBOOK,ISOLATIN1=0'
ps_shofont,'/SCHOOLBOOK,ISOLATIN1=1'
ps_shofont,'/SCHOOLBOOK,/BOLD,ISOLATIN1=0'
ps_shofont,'/SCHOOLBOOK,/BOLD,ISOLATIN1=1'
ps_shofont,'/SCHOOLBOOK,/ITALIC,ISOLATIN1=0'
ps_shofont,'/SCHOOLBOOK,/ITALIC,ISOLATIN1=1'
ps_shofont,'/SCHOOLBOOK,/BOLD,/ITALIC,ISOLATIN1=0'
ps_shofont,'/SCHOOLBOOK,/BOLD,/ITALIC,ISOLATIN1=1'
ps_shofont,'/PALATINO,ISOLATIN1=0'
ps_shofont,'/PALATINO,ISOLATIN1=1'
ps_shofont,'/PALATINO,/BOLD,ISOLATIN1=0'
ps_shofont,'/PALATINO,/BOLD,ISOLATIN1=1'
ps_shofont,'/PALATINO,/ITALIC,ISOLATIN1=0'
ps_shofont,'/PALATINO,/ITALIC,ISOLATIN1=1'
ps_shofont,'/PALATINO,/BOLD,/ITALIC,ISOLATIN1=0'
ps_shofont,'/PALATINO,/BOLD,/ITALIC,ISOLATIN1=1'
ps_shofont,'/SYMBOL'
ps_shofont,'/TIMES,ISOLATIN1=0'
ps_shofont,'/TIMES,ISOLATIN1=1'
ps_shofont,'/TIMES,/BOLD,ISOLATIN1=0'
ps_shofont,'/TIMES,/BOLD,ISOLATIN1=1'
ps_shofont,'/TIMES,/ITALIC,ISOLATIN1=0'
ps_shofont,'/TIMES,/ITALIC,ISOLATIN1=1'
ps_shofont,'/TIMES,/BOLD,/ITALIC,ISOLATIN1=0'
ps_shofont,'/TIMES,/BOLD,/ITALIC,ISOLATIN1=1'
end
|
comp.lang.idl-pvwave archive
Members
Search
Help
Login
Home
