; $Id: //depot/Release/ENVI50_IDL82/idl/idldir/lib/showfont.pro#1 $
;
; Copyright (c) 1992-2012, Exelis Visual Information Solutions, Inc. All
;       rights reserved. Unauthorized reproduction is prohibited.

;+
; NAME:
;	SHOWFONT
;
; PURPOSE:
;	This procedure displays a vector-drawn font on the current
;	graphics device.
;
; CATEGORY:
;	Fonts.
;
; CALLING SEQUENCE:
;	SHOWFONT, Font, Name
;
; INPUTS:
;	Font:	 The index number of the font (may range from 3 to 29)
;		 or, if the TT_FONT keyword is set, a string representing
;                the name of the TrueType font to display.
;	Name:	 Title text to appear at top of display.
;
; KEYWORD PARAMETERS:
;	ENCAPSULATED:	If this keyword is set, and if the current graphics
;			device is "PS", makes encapsulated PostScript output.
;	TT_FONT:	If this keyword is set, the Font argument is 
;			interpreted as the name of a TrueType font.
;
; OUTPUTS:
;	No explicit outputs.
;
; SIDE EFFECTS:
;	A display is made.
;
; RESTRICTIONS:
;	Not very flexible.
;
; PROCEDURE:
;	Straightforward.
;
; EXAMPLE:
;	To create a display of Font 3 for PostScript:
;		SET_PLOT, 'PS'
;		SHOWFONT, 3, "Simplex Roman"
;
;	To create a display of the Times Roman TrueType font:
;		SHOWFONT, 'Times', 'Times Roman', /TT_FONT
;
; MODIFICATION HISTORY:
; 	Written by:
;	DMS, Nov, 1992
;	WSO, 1/95, Updated for new directory structure
;	DD, 12/97, Updated to handle TrueType fonts
;-
PRO SHOWFONT, FONT, NAME, $
  ENCAPSULATED = encapsulated, $
  OFFSET=offsetIn, $
  TT_FONT = tt_font, $
  _EXTRA=_extra

if !d.name eq 'PS' then begin
	device, encap=KEYWORD_SET(encapsulated), BITS_PER_PIXEL=8, /COLOR
endif

device, get_decomposed=olddecomp
device, decomposed=0

offset = (ISA(offsetIn) && KEYWORD_SET(tt_font)) ? offsetIn[0] : 32

erase
y0 = (offset eq 32) ? 0.87 : 0.95		;Top line
y1 = 0.03		;Bottom
x0 = 0.03		;Left
x1 = .97		;Right
dx = (x1-x0) / 17

oldpfont = !p.font

if KEYWORD_SET(tt_font) then begin
	sesc = ''
	!P.FONT = 1
  cses = ''

	DEVICE, SET_FONT='helvetica', /TT_FONT
	if (offset eq 32) then $
    xyouts,0.5,.95,'Font '+name, siz=2.5, alig=0.5, /norm, _EXTRA=_extra
	for ix=0,16 do begin	;Each column
    x = x0 + ix * dx
    y = y0 + 0.01
    xx = x + dx/2
    format = (offset eq 32) ? "(I3)" : "(Z1)"
    if ix eq 0 then begin
      s = (offset eq 32) ? 'Code' : 'Hex'
    endif else begin
      s = string((ix-1) and 15, FORMAT=format)
    endelse
    xyouts, xx, y, s, /NORM, ALIGN=0.5, _EXTRA=_extra
    plots, [x,x],[y0,y1], /norm, color=200
  endfor
	DEVICE, SET_FONT=font, /TT_FONT

	nchars = 224
  if (offset ne 32) then nchars = 256

endif else begin

	sesc = '!'+strtrim(font,2)	; Font selecting string
	!P.FONT = -1
  cses = '!X'
	offset = 32

	openr, unit, /GET_LUN, /SWAP_IF_LITTLE_ENDIAN, $
           filepath('hersh1.chr', subdir=['resource', 'fonts'])

	;Peek into font file
	hdr = lonarr(2,40)
	readu, unit, hdr

	;Determine # of chars in font:
	if hdr[1,font] lt 0 then nchars = 224 else nchars = 96  ;8 or 7 bits?
	FREE_LUN, unit

	;Title line:
	xyouts,0.5,.95,'!3Font '+strtrim(font,2)+', '+name+'!X',siz=2.5,$
	   alig=0.5,/norm, _EXTRA=_extra

	for ix=0,16 do begin	;Each column
	   x = x0 + ix * dx
	   y = y0 + 0.01
	   xx = x + dx/2
	   if ix eq 0 then s = '!3Code!X' else $   ;Column header
	      s = string((ix-1) and 15, format='("!3",I3,"!X")')
	   xyouts, xx, y, s, /NORM, ALIGN=0.5, _EXTRA=_extra
	   plots, [x,x],[y0,y1], /norm, color=200
	endfor
endelse

nrows = nchars / 16
dy = (y1-y0) / nrows

plots, [x1, x1], [y0, y1], /NORM, color=200
plots, [x0, x1], [y0, y0], /NORM, color=200

for iy=0, nrows-1 do begin
	y = y0 + (iy+1) * dy
	plots, [x0, x1], [y, y], /NORM, color=200
	format = (offset eq 32) ? "(I3)" : "(Z4.4)"
	xyouts, x0+dx/2, y-dy/5, /NORM, ALIGN=0.5, _EXTRA=_extra, $
		"!3"+STRING(iy*16+offset, FORMAT=format)+"!X"
	for ix=0,15 do begin		;Each character
	    X = (ix+1) * dx + x0
	    k = iy*16 + ix + offset
	    s = (offset eq 32) ? STRING(BYTE(k)) : STRING(k, FORMAT='("!Z(",Z4.4,")")')
	    if (s eq '!') then s = '!!'
      xyouts,x+.02,y+.005,sesc+s+cses,size=2.0,/norm, _EXTRA=_extra
	endfor
ENDFOR
!p.font = oldpfont
device, decomposed=olddecomp
END