Viewing contents of file '../idllib/user_contrib/creaso/xfont.pro'
; Copyright (c) 1991, Research Systems, Inc. All rights reserved.
; Unauthorized reproduction prohibited.
;+
; NAME:
; XFONT
; PURPOSE:
; This procedure allows to view arbritrary text in different font
; on your operating system.
;
; CATEGORY:
; Widgets, Fonts
; CALLING SEQUENCE:
; XFONT
; INPUTS:
; OPTIONAL INPUT PARAMETERS:
; KEYWORD PARAMETERS:
; GROUP = The widget ID of the widget that calls xfont. When this
; ID is specified, a death of the caller results in a death of
; xfont.
; OUTPUTS:
; OPTIONAL OUTPUT PARAMETERS:
; COMMON BLOCKS:
; SIDE EFFECTS:
; Initiates the XManager if it is not already running.
; RESTRICTIONS:
; Written and tested on VAX/VMS. For other operating systems we
; need a file containing all valid names of X fonts. A default
; X font file that works for all operating systems has not yet
; been created (suggestion: X11 fonts list). New font list files
; should be named "XFONTS."+!VERSION.OS .
;
; Selection on the spacing field (P=Proportional, M=Monospaced and
; C=CharCell is not yet implemented (Arrays: fa and xa).
;
; Selection of slants "Reverse Italic", "Reverse Oblique" and
; "Other" is not yet implemented.
;
; PROCEDURE:
; Create and register the widget and then exit.
; MODIFICATION HISTORY:
; Created from a template written by: Hans-Joachim Bothe, November 1991
;-
; Define a function that prepares a string array for multi line output
; in a widget.
FUNCTION makexyoutstr, arr
n=N_ELEMENTS(arr)
res=arr(0)
if (n GT 1)THEN BEGIN
FOR i=1,n-1 DO BEGIN
res=res+'!C'+arr(i)
ENDFOR
ENDIF
RETURN, res
END
PRO xfont_event, event
COMMON widget_ids, x1_ids, x2_ids, x3_ids, x4_ids, x5_ids, x7_ids, x9_ids,$
xfontdraw, xfontlbox, xfontbase, xfontlab2,$
xfonttxt1
COMMON fontdata1, f1, f2, f3, f4, f5, f7, f9, s, gidx
COMMON fontdata2, x1, x2, x3, x4, x5, x7, x9, cfont, estr
COMMON fontsens, ffound, fname, fweight, fslant, fwidth, fdpi, fsize, fidx
; Find the user value.
WIDGET_CONTROL, event.id, GET_UVALUE=eventval
; Determine event type
CASE eventval OF
; XLoadct is the library routine that lets you select and adjust the
; color palette being used.
"XLOADCT": XLoadct, GROUP = event.top
; XPalette is the library routine that lets you adjust individual color
; values in the palette.
"XPALETTE": XPalette, GROUP = event.top
; XManTool is a library routine that shows which widget applications are
; currently registered with the XManager.
"XMANTOOL": XManagerTool, GROUP = event.top
; There is no need to "unregister" a widget application. The XManager
; will clean the dead widget from its list.
"DONE": WIDGET_CONTROL, event.top, /DESTROY
; Handle list box selection event.
"LISTBOX": BEGIN
; Set new list box font in label widget 2.
cfont = s(gidx(event.index))
WIDGET_CONTROL, xfontlab2, SET_VALUE=cfont
; Select new font
device,font=cfont
; Print some graphics Text.
ERASE
XYOUTS, 5, 920, /FONT, /DEV, makexyoutstr(estr)
END
; Handle text widget events.
"TEXT1": BEGIN
; Get current text from widget.
WIDGET_CONTROL, xfonttxt1, GET_VALUE=estr
; Print the graphics Text.
ERASE
XYOUTS, 5, 920, /FONT, /DEV, makexyoutstr(estr)
END
; Determine whether the menu selection came from the exclusive menu.
; If it did, set the interface state based on the user value.
ELSE: BEGIN
; Handle the RESET event.
IF (eventval EQ "RESET") THEN BEGIN
; Reset selection filters.
cfont = "Default."
estr = ['The quick','brown fox','jumps over','the lazy','dog','0123456789']
ffound(0) = -1
fname(0) = -1
fweight(0) = -1
fslant(0) = -1
fwidth(0) = -1
fdpi(0) = -1
fsize(0) = -1
; Deselect all buttons
WIDGET_CONTROL, xfontbase, SET_BUTTON=0
WIDGET_CONTROL, xfontlab2, SET_VALUE=cfont
WIDGET_CONTROL, xfonttxt1, SET_VALUE=estr
; Print the graphics Text.
ERASE
XYOUTS, 5, 920, /FONT, /DEV, makexyoutstr(estr)
ENDIF
; Did the selection come from the manufacturer menu ?
count=0
IF (count LE 0) THEN BEGIN
id = WHERE(x1_ids EQ event.id, count)
IF (count GT 0) THEN BEGIN
IF (event.select EQ 1) THEN BEGIN
ffound = WHERE(f1 EQ eventval)
ENDIF ELSE BEGIN
ffound(0) = -1
ENDELSE
ENDIF
ENDIF
; Did the selection come from the fontname menu ?
IF (count LE 0) THEN BEGIN
id = WHERE(x2_ids EQ event.id, count)
IF (count GT 0) THEN BEGIN
IF (event.select EQ 1) THEN BEGIN
fname = WHERE(f2 EQ eventval)
ENDIF ELSE BEGIN
fname(0) = -1
ENDELSE
ENDIF
ENDIF
; Did the selection come from the fontweight menu ?
IF (count LE 0) THEN BEGIN
id = WHERE(x3_ids EQ event.id, count)
IF (count GT 0) THEN BEGIN
IF (event.select EQ 1) THEN BEGIN
fweight = WHERE(f3 EQ eventval)
ENDIF ELSE BEGIN
fweight(0) = -1
ENDELSE
ENDIF
ENDIF
; Did the selection come from the font slant menu ?
IF (count LE 0) THEN BEGIN
id = WHERE(x4_ids EQ event.id, count)
IF (count GT 0) THEN BEGIN
IF (event.select EQ 1) THEN BEGIN
fslant = WHERE(f4 EQ STRMID(eventval,0,1))
ENDIF ELSE BEGIN
fslant(0) = -1
ENDELSE
ENDIF
ENDIF
; Did the selection come from the fontwidth menu ?
IF (count LE 0) THEN BEGIN
id = WHERE(x5_ids EQ event.id, count)
IF (count GT 0) THEN BEGIN
IF (event.select EQ 1) THEN BEGIN
fwidth = WHERE(f5 EQ eventval)
ENDIF ELSE BEGIN
fwidth(0) = -1
ENDELSE
ENDIF
ENDIF
; Did the selection come from the font resolution menu ?
IF (count LE 0) THEN BEGIN
id = WHERE(x7_ids EQ event.id, count)
IF (count GT 0) THEN BEGIN
IF (event.select EQ 1) THEN BEGIN
fdpi = WHERE(LONG(f7) EQ LONG(eventval))
ENDIF ELSE BEGIN
fdpi(0) = -1
ENDELSE
ENDIF
ENDIF
; Did the selection come from the font size menu ?
IF (count LE 0) THEN BEGIN
id = WHERE(x9_ids EQ event.id, count)
IF (count GT 0) THEN BEGIN
IF (event.select EQ 1) THEN BEGIN
fsize = WHERE(LONG(f9) EQ LONG(eventval))
ENDIF ELSE BEGIN
fsize(0) = -1
ENDELSE
ENDIF
ENDIF
; Determine current font group based on all user selections.
fidx(*,*)=0
IF (ffound(0) NE -1) THEN fidx(1,ffound) = 1 ELSE fidx(1,*) = 1
IF (fname(0) NE -1) THEN fidx(2,fname) = 1 ELSE fidx(2,*) = 1
IF (fweight(0) NE -1) THEN fidx(3,fweight) = 1 ELSE fidx(3,*) = 1
IF (fslant(0) NE -1) THEN fidx(4,fslant) = 1 ELSE fidx(4,*) = 1
IF (fwidth(0) NE -1) THEN fidx(5,fwidth) = 1 ELSE fidx(5,*) = 1
IF (fdpi(0) NE -1) THEN fidx(7,fdpi) = 1 ELSE fidx(7,*) = 1
IF (fsize(0) NE -1) THEN fidx(9,fsize) = 1 ELSE fidx(9,*) = 1
gidx = WHERE(fidx(1,*) EQ 1 AND $
fidx(2,*) EQ 1 AND $
fidx(3,*) EQ 1 AND $
fidx(4,*) EQ 1 AND $
fidx(5,*) EQ 1 AND $
fidx(7,*) EQ 1 AND $
fidx(9,*) EQ 1)
; Loop through all font menus an set sensitivity
FOR i=0,N_ELEMENTS(x1)-1 DO BEGIN
v=SIZE(WHERE(STRPOS(f1(gidx),x1(i)) GE 0))
IF (v(0) GT 0) THEN BEGIN
WIDGET_CONTROL, x1_ids(i), SENSITIVE=1
ENDIF ELSE BEGIN
WIDGET_CONTROL, x1_ids(i), SENSITIVE=0
ENDELSE
ENDFOR
FOR i=0,N_ELEMENTS(x2)-1 DO BEGIN
v=SIZE(WHERE(STRPOS(f2(gidx),x2(i)) GE 0))
IF (v(0) GT 0) THEN BEGIN
WIDGET_CONTROL, x2_ids(i), SENSITIVE=1
ENDIF ELSE BEGIN
WIDGET_CONTROL, x2_ids(i), SENSITIVE=0
ENDELSE
ENDFOR
FOR i=0,N_ELEMENTS(x3)-1 DO BEGIN
v=SIZE(WHERE(STRPOS(f3(gidx),x3(i)) GE 0))
IF (v(0) GT 0) THEN BEGIN
WIDGET_CONTROL, x3_ids(i), SENSITIVE=1
ENDIF ELSE BEGIN
WIDGET_CONTROL, x3_ids(i), SENSITIVE=0
ENDELSE
ENDFOR
FOR i=0,N_ELEMENTS(x4)-1 DO BEGIN
v=SIZE(WHERE(STRMID(f4(gidx),0,1) EQ STRMID(x4(i),0,1)) GE 0)
IF (v(0) GT 0) THEN BEGIN
WIDGET_CONTROL, x4_ids(i), SENSITIVE=1
ENDIF ELSE BEGIN
WIDGET_CONTROL, x4_ids(i), SENSITIVE=0
ENDELSE
ENDFOR
FOR i=0,N_ELEMENTS(x5)-1 DO BEGIN
v=SIZE(WHERE(STRPOS(f5(gidx),x5(i)) GE 0))
IF (v(0) GT 0) THEN BEGIN
WIDGET_CONTROL, x5_ids(i), SENSITIVE=1
ENDIF ELSE BEGIN
WIDGET_CONTROL, x5_ids(i), SENSITIVE=0
ENDELSE
ENDFOR
FOR i=0,N_ELEMENTS(x7)-1 DO BEGIN
v=SIZE(WHERE(LONG(f7(gidx)) EQ LONG(x7(i))))
IF (v(0) GT 0) THEN BEGIN
WIDGET_CONTROL, x7_ids(i), SENSITIVE=1
ENDIF ELSE BEGIN
WIDGET_CONTROL, x7_ids(i), SENSITIVE=0
ENDELSE
ENDFOR
FOR i=0,N_ELEMENTS(x9)-1 DO BEGIN
v=SIZE(WHERE(LONG(f9(gidx)) EQ LONG(x9(i))))
IF (v(0) GT 0) THEN BEGIN
WIDGET_CONTROL, x9_ids(i), SENSITIVE=1
ENDIF ELSE BEGIN
WIDGET_CONTROL, x9_ids(i), SENSITIVE=0
ENDELSE
ENDFOR
; Update fontname list box.
WIDGET_CONTROL, xfontlbox, SET_VALUE=s(gidx)
; Did we find an event ?
IF (count EQ 0 AND eventval NE "RESET") THEN BEGIN
PRINT, 'Event value ', eventval, ' not found.'
ENDIF
ENDELSE
ENDCASE
END
PRO xfont, GROUP = GROUP
COMMON widget_ids, x1_ids, x2_ids, x3_ids, x4_ids, x5_ids, x7_ids, x9_ids,$
xfontdraw, xfontlbox, xfontbase, xfontlab2,$
xfonttxt1
COMMON fontdata1, f1, f2, f3, f4, f5, f7, f9, s, gidx
COMMON fontdata2, x1, x2, x3, x4, x5, x7, x9, cfont, estr
COMMON fontsens, ffound, fname, fweight, fslant, fwidth, fdpi, fsize, fidx
; Check for other copies and do nothing if xfont is already running:
IF(XRegistered('xfont') NE 0) THEN RETURN
; Set number of fonts and allocate workspace
nf = 0
IF (!VERSION.OS EQ 'vms') THEN nf=468
IF (!VERSION.OS EQ 'sunos') THEN nf=0 ;Put appropriate number for SUN here.
IF (nf EQ 0) THEN BEGIN
MESSAGE, 'Number of known fonts is zero. Processing aborted.'
ENDIF
s=STRARR(nf)
p=INTARR(nf)
f0=STRARR(nf)
f1=STRARR(nf)
f2=STRARR(nf)
f3=STRARR(nf)
f4=STRARR(nf)
f5=STRARR(nf)
f6=STRARR(nf)
f7=STRARR(nf)
f8=STRARR(nf)
f9=STRARR(nf)
fa=STRARR(nf)
fb=STRARR(nf)
fc=STRARR(nf)
fd=STRARR(nf)
fe=STRARR(nf)
; Read Font list from file
OPENR,1,"xfont." + !VERSION.OS
READF,1,s
CLOSE,1
; Separate information from font names
p=STRPOS(s,'-')
FOR i=0,nf-1 DO BEGIN
f0(i)=STRMID(s(i),0,p(i))
n=STRPOS(s(i),'-',p(i)+1)
f1(i)=STRMID(s(i),p(i)+1,n-p(i)-1)
p(i)=n
n=STRPOS(s(i),'-',p(i)+1)
f2(i)=STRMID(s(i),p(i)+1,n-p(i)-1)
p(i)=n
n=STRPOS(s(i),'-',p(i)+1)
f3(i)=STRMID(s(i),p(i)+1,n-p(i)-1)
p(i)=n
n=STRPOS(s(i),'-',p(i)+1)
f4(i)=STRMID(s(i),p(i)+1,n-p(i)-1)
p(i)=n
n=STRPOS(s(i),'-',p(i)+1)
f5(i)=STRMID(s(i),p(i)+1,n-p(i)-1)
p(i)=n
n=STRPOS(s(i),'-',p(i)+1)
f6(i)=STRMID(s(i),p(i)+1,n-p(i)-1)
p(i)=n
n=STRPOS(s(i),'-',p(i)+1)
f7(i)=STRMID(s(i),p(i)+1,n-p(i)-1)
p(i)=n
n=STRPOS(s(i),'-',p(i)+1)
f8(i)=STRMID(s(i),p(i)+1,n-p(i)-1)
p(i)=n
n=STRPOS(s(i),'-',p(i)+1)
f9(i)=STRMID(s(i),p(i)+1,n-p(i)-1)
p(i)=n
n=STRPOS(s(i),'-',p(i)+1)
fa(i)=STRMID(s(i),p(i)+1,n-p(i)-1)
p(i)=n
n=STRPOS(s(i),'-',p(i)+1)
fb(i)=STRMID(s(i),p(i)+1,n-p(i)-1)
p(i)=n
n=STRPOS(s(i),'-',p(i)+1)
fc(i)=STRMID(s(i),p(i)+1,n-p(i)-1)
p(i)=n
n=STRPOS(s(i),'-',p(i)+1)
fd(i)=STRMID(s(i),p(i)+1,n-p(i)-1)
p(i)=n
n=STRPOS(s(i),'-',p(i)+1)
fe(i)=STRMID(s(i),p(i)+1,n-p(i)-1)
p(i)=n
ENDFOR
; Make unique item lists
x1=f1(UNIQ(f1,SORT(f1)))
x2=f2(UNIQ(f2,SORT(f2)))
x3=f3(UNIQ(f3,SORT(f3)))
x4=f4(UNIQ(f4,SORT(f4)))
x5=f5(UNIQ(f5,SORT(f5)))
x7=f7(UNIQ(f7,SORT(LONG(f7))))
x9=f9(UNIQ(f9,SORT(LONG(f9))))
; Convert Slant abbreviation to full name
; x4(WHERE(x4 EQ 'RI')) = 'Reverse Italic'
; x4(WHERE(x4 EQ 'RO')) = 'Reverse Oblique'
; x4(WHERE(x4 EQ 'OT')) = 'Other'
x4(WHERE(x4 EQ 'R')) = 'Roman'
x4(WHERE(x4 EQ 'I')) = 'Italics'
x4(WHERE(x4 EQ 'O')) = 'Oblique'
; Initialize some variables.
cfont = "Default."
gidx = indgen(nf)
ffound = INTARR(1)
fname = INTARR(1)
fweight = INTARR(1)
fslant = INTARR(1)
fwidth = INTARR(1)
fdpi = INTARR(1)
fsize = INTARR(1)
fidx = INTARR(10,nf)
ffound(0) = -1
fname(0) = -1
fweight(0) = -1
fslant(0) = -1
fwidth(0) = -1
fdpi(0) = -1
fsize(0) = -1
estr = ['The quick','brown fox','jumps over','the lazy','dog','0123456789']
; Define base widgets.
xfontbase = WIDGET_BASE (TITLE='IDL Font Selection Utility for DECwindows',$
/COLUMN)
xfonttop0 = WIDGET_BASE (xfontbase, /ROW)
xfontlab1 = WIDGET_LABEL(xfontbase, VALUE="Current Font:")
xfontlab2 = WIDGET_LABEL(xfontbase, VALUE=cfont)
xfontbot0 = WIDGET_BASE (xfontbase, /ROW)
xfonttopv = WIDGET_BASE (xfonttop0, /ROW)
xfonttop1 = WIDGET_BASE (xfonttopv, /COLUMN)
xfonttop2 = WIDGET_BASE (xfonttopv, /COLUMN)
xfonttop3 = WIDGET_BASE (xfonttopv, /COLUMN)
xfonttop4 = WIDGET_BASE (xfonttopv, /COLUMN)
; Define exclusive menus.
XMenu, x1, xfonttop1, BUTTONS=x1_ids, /EXCLUSIVE, UVALUE=x1, TI='Foundry'
XMenu, x2, xfonttop1, BUTTONS=x2_ids, /EXCLUSIVE, UVALUE=x2, TI='Family name'
XMenu, x3, xfonttop2, BUTTONS=x3_ids, /EXCLUSIVE, UVALUE=x3, TI='Weight name'
XMenu, x4, xfonttop2, BUTTONS=x4_ids, /EXCLUSIVE, UVALUE=x4, TI='Slant'
XMenu, x5, xfonttop2, BUTTONS=x5_ids, /EXCLUSIVE, UVALUE=x5, TI='Width name'
XMenu, x7, xfonttop3, BUTTONS=x7_ids, /EXCLUSIVE, UVALUE=x7, TI='Size'
XMenu, x9, xfonttop2, BUTTONS=x9_ids, /EXCLUSIVE, UVALUE=x9, TI='Resolution'
; Make a 'DONE' and a 'RESET' button:
xfontbut1 = WIDGET_BUTTON(xfonttop4, UVALUE='XMANTOOL' , VALUE='X Manager')
xfontbut2 = WIDGET_BUTTON(xfonttop4, UVALUE='RESET' , VALUE='RESET')
xfontbut3 = WIDGET_BUTTON(xfonttop4, UVALUE='DONE' , VALUE='DONE')
; Define graphics draw window
xfontdraw = WIDGET_DRAW(xfonttop4, UVALUE='DRAW', /SCROLL, RETAIN=2, $
X_SCROLL_SIZE=240, Y_SCROLL_SIZE=240, XSIZE=480, YSIZE=960)
; Define label text input widget.
xfontlab3 = WIDGET_LABEL(xfonttop4, $
VALUE="You may enter your own text here:")
xfonttxt1 = WIDGET_TEXT(xfonttop4, $
VALUE=estr, UVALUE='TEXT1', /EDITABLE, YSIZE=6, /FRAME)
xfontbut4 = WIDGET_BUTTON(xfonttop4, UVALUE='TEXT1', $
VALUE='Draw text in graphics window')
; Define List Box widget
xfontlbox = WIDGET_LIST(xfontbot0, VALUE=s, UVALUE='LISTBOX', YSIZE=13)
; Create the widgets that are defined.
WIDGET_CONTROL, xfontbase, /REALIZE
; Register the widgets with the XManager.
XManager, 'xfont', xfontbase, $
EVENT_HANDLER = 'xfont_event', $
GROUP_LEADER = GROUP
END