1*******************************************************************************
2*               Support routines for PostScript labels                        *
3*******************************************************************************
4*     Version 3.0
5*
6* EAM Dec 1996	- Initial version (called labels3d, later changed)
7* EAM May 1999	- Updated to match V 2.4j as stand-alone program
8* EAM Nov 1999	- V2.5 called from render.f as part of normal processing
9* EAM Feb 2000	- iso-8859-1 encodings for �
10*		  TeX-like syntax for greek, superscript, subscript
11*		  sub- and super- scripts use 0.8 * current font size
12* EAM Sep 2000	- tweak RED values in work-around for ImageMagick bug
13* EAM Jun 2001	- Tru64 f90 compiler barfs on '\\' as meaning a single \
14*		  re-work pathway through ghostscript + ImageMagick 5.3.2
15* EAM Apr 2006	- Tweak for gfortran compatibility
16* EAM Dec 2010	- Label support is moving to libgd, with default lflag = TRUE
17*******************************************************************************
18*
19* These routines are called from render.f to handle object types 10, 11 and 12.
20* The PostScript file describes a canvas with the same dimension in pixels as
21* the image created by render.  The PostScript canvas can be composited on top
22* of the rendered image to produce a labeled figure.
23*
24*	Object types 10 and 11 are used for specifying labels.
25*	Label object types are
26*	  - type 10: Font_Name size alignment
27*	  - type 11: XYZ RGB on first line
28*		     label (ascii characters enclosed in quotes) on second line
29*	Object type 12 is reserved to go with this, as I have a nagging
30*	suspicion more information may turn out to be necessary.
31*
32*******************************************************************************
33      SUBROUTINE LOPEN( FILENAME )
34*
35      IMPLICIT NONE
36      REAL     PSCALE
37      REAL     BKGND(3)
38      CHARACTER*132 FILENAME
39      CHARACTER*80 TITLE
40*
41      INCLUDE 'VERSION.incl'
42*
43      INTEGER  I, J, LEN, IBEG
44      INTEGER  INPUT, INTYPE, KEEP
45      LOGICAL  MATCOL
46      REAL     RGBMAT(3)
47      CHARACTER*1 BACKSLASH
48*
49*     Input transformation
50      COMMON /MATRICES/ XCENT, YCENT, SCALE, EYEPOS, SXCENT, SYCENT,
51     &                  TMAT, TINV, TINVT, SROT, SRTINV, SRTINVT
52      REAL   XCENT, YCENT, SCALE, SXCENT, SYCENT
53*     Transformation matrix, inverse, and transposed inverse
54      REAL   TMAT(4,4), TINV(4,4), TINVT(4,4)
55*     Shortest rotation from light source to +z axis
56      REAL   SROT(4,4), SRTINV(4,4), SRTINVT(4,4)
57*     Distance (in +z) of viewing eye
58      REAL   EYEPOS
59*
60      EXTERNAL PERSP
61      REAL     PERSP, PFAC
62*
63      COMMON /NICETIES/ TRULIM,      ZLIM,    FRONTCLIP, BACKCLIP
64     &                , ISOLATION
65      REAL              TRULIM(3,2), ZLIM(2), FRONTCLIP, BACKCLIP
66      INTEGER           ISOLATION
67*
68*     Command line options
69      COMMON /OPTIONS/ FONTSCALE, GAMMA, ZOOM, NSCHEME, SHADOWFLAG, XBG,
70     &                 NAX, NAY, OTMODE, QUALITY, INVERT, LFLAG
71      REAL             FONTSCALE, GAMMA, ZOOM
72      INTEGER          NSCHEME, SHADOWFLAG, XBG
73      INTEGER*4        NAX, NAY, OTMODE, QUALITY
74      LOGICAL*2        INVERT, LFLAG
75*
76*     Stuff for labels
77      COMMON /LABELS/ LB
78      INTEGER         LB
79
80      CHARACTER*80  FONTNAME, FONTALIGN
81      CHARACTER*128 LABELSTRING
82      INTEGER       MAXLABLEN
83      PARAMETER    (MAXLABLEN = 128)
84      CHARACTER*1   LTEX,TEXSTRING
85      EXTERNAL      LTEX
86      INTEGER      LEVEL
87      REAL         SSSIZE
88      INTEGER      IALIGN
89      SAVE         IALIGN
90      INTEGER      FONT, LABEL
91      PARAMETER   (FONT = 10, LABEL = 11)
92      REAL         XA, YA, ZA, RED, GRN, BLU
93      REAL         FONTSIZE
94      SAVE         FONTSIZE
95      REAL         PSSCALE
96      SAVE         PSSCALE
97*
98*     Copy of NOISE for ASSERT to see
99      COMMON /ASSCOM/ NOISE, VERBOSE
100      INTEGER NOISE
101      LOGICAL VERBOSE
102*
103*     Initial entry
104*     Open file for PostScript output
105*
106      LEN = LEN_TRIM(FILENAME)
107      OPEN( UNIT=LB, FILE=FILENAME(1:LEN), STATUS='UNKNOWN', ERR=99)
108      WRITE (NOISE,*) 'Writing PostScript labels to file ',
109     &                FILENAME(1:LEN),' with scale',FONTSCALE
110      RETURN
111   99 CONTINUE
112      WRITE (NOISE,100) FILENAME(1:LEN)
113  100 FORMAT('>>> Cannot open ',A,' for writing labels')
114      CALL EXIT(-1)
115*
116*     Don't write PostScript header until we've read R3D header
117*
118      ENTRY LSETUP( PSCALE, BKGND, TITLE )
119	PSSCALE = PSCALE
120*     The libgd-based label code calls lsetup() regardless of LFLAG
121	if (.NOT.LFLAG) RETURN
122*     For some reason ImageMagick messes up image composition if the
123*     background is pure white or pure black.
124*     Work-around is to tweak the background. (Abandoned this idea for 2.6)
125COLD	if (bkgnd(1).eq.1.0) bkgnd(1) = 0.9900
126COLD	if (bkgnd(1).eq.0.0) bkgnd(1) = 0.0001
127	RED = sqrt( bkgnd(1) )
128	GRN = sqrt( bkgnd(2) )
129	BLU = sqrt( bkgnd(3) )
130*
131c
132c     Write out PostScript prolog records
133c	To be minimally-conforming, there should also be a
134c	%%DocumentFonts: (atend)
135c	record and record-keeping of all fonts used.
136c
1376     FORMAT(A,1X,A)
138600   FORMAT(A,1X,A,1X,A)
139601   FORMAT(A,I6,A)
140602   FORMAT(A,2I6,A)
141603   FORMAT(A,F6.3,A)
142604   FORMAT(3F6.3,A)
143605   FORMAT('/',A,' findfont',F6.2,' FontScale setfont')
144606   FORMAT('/CurrentFont /',A,' def /CurrentSize ',F6.2,' def ',A)
145607   FORMAT((A))
146
147      WRITE(LB,600) '%!PS-Adobe-3.0 EPSF-3.0'
148      WRITE(LB,600) '%%Creator: Raster3D',VERSION,'rendering program'
149      WRITE(LB,600) '%%Title:',TITLE
150      WRITE(LB,600) '%%Pages: 1'
151      WRITE(LB,602) '%%BoundingBox: 0 0',nax,nay
152      WRITE(LB,600) '%%DocumentFonts: (atend)'
153      WRITE(LB,600) '%%EndComments'
154      WRITE(LB,600) '%%BeginProlog'
155      WRITE(LB,600) '% These are the only control parameters'
156      WRITE(LB,603) '/FontSize ',FONTSCALE,' def'
157      WRITE(LB,601) '/UnitHeight ',nay/2,' def'
158      WRITE(LB,601) '/UnitWidth  ',nax/2,' def'
159      WRITE(LB,607) '% ',
160     & '% This should be dynamic, but how???',
161     & '/FontHeight 30 def',
162     & '/FontWidth  30 def',
163     & '% ',
164     & '/FontScale { FontSize mul scalefont } bind def',
165     & '/Center {',
166     & ' dup stringwidth exch -2 div exch -2 div rmoveto',
167     & ' } bind def',
168     & '/Right {',
169     & ' dup stringwidth exch -1 mul exch -1 mul rmoveto',
170     & ' } bind def',
171     & '/Skip { stringwidth 1.1 mul rmoveto } bind def',
172     & '/ShrinkFont {',
173     & '  CurrentFont findfont CurrentSize 0.8 mul FontScale setfont',
174     & ' } bind def',
175     & '/RestoreFont {',
176     & '  CurrentFont findfont CurrentSize FontScale setfont',
177     & ' } bind def',
178     & '/XYZmove { pop moveto } bind def',
179     & '/XYZrmove { pop rmoveto } bind def'
180      WRITE(LB,607) '/SetBackground { '
181      WRITE (LB,604) RED,GRN,BLU,' setrgbcolor'
182      WRITE(LB,607) ' } bind def'
183
184c
185c This is one way to do it
186c
187c     WRITE(LB,607)
188c    &      '%',
189c    &      '% Add Angstrom sign to commonly used fonts',
190c    &      '% using iso-8859-1 encoding (� = 197,  305 octal)',
191c    &      '%',
192c    &      '/reencsmalldict 12 dict def',
193c    &      '/ReEncodeSmall',
194c    &      '  { reencsmalldict begin',
195c    &      '    /newcodesandnames exch def ',
196c    &      '    /newfontname exch def',
197c    &      '    /basefontname exch def ',
198c    &      '    /basefontdict basefontname findfont def',
199c    &      '    /newfont basefontdict maxlength dict def',
200c    &      '    basefontdict',
201c    &      '      { exch dup /FID ne',
202c    &      '	{ dup /Encoding eq',
203c    &      '	  { exch dup length array copy newfont 3 1 roll put }',
204c    &      '	  { exch newfont 3 1 roll put }',
205c    &      '	  ifelse',
206c    &      '        }',
207c    &      '        { pop pop }',
208c    &      '        ifelse',
209c    &      '      } forall',
210c    &      '    newfont /FontName newfontname put',
211c    &      '    newcodesandnames aload pop',
212c    &      '    newcodesandnames length 2 idiv',
213c    &      '      { newfont /Encoding get 3 1 roll put }',
214c    &      '      repeat',
215c    &      '    newfontname newfont definefont pop',
216c    &      '    end',
217c    &      '  } def',
218c    &      '/symbvec [',
219c    &      '  8#305 /Aring',
220c    &      '  ] def',
221c    &      '/AddSymbs { dup symbvec ReEncodeSmall } def',
222c    &      '/Times-Roman AddSymbs',
223c    &      '/Times-Bold AddSymbs',
224c    &      '/Times-Italic AddSymbs',
225c    &      '/Times-BoldItalic AddSymbs',
226c    &      '/Helvetica AddSymbs',
227c    &      '/Helvetica-Bold AddSymbs',
228c    &      '/Helvetica-Narrow AddSymbs',
229c    &      '/Helvetica-Narrow-Bold AddSymbs',
230c    &      '% End re-encoding'
231c
232c This is another way to do it
233c
234      WRITE(LB,607)
235     &      '%',
236     &      '% Switch common fonts to iso-8859-1 encoding',
237     &      '%',
238     &      '/Latin1 {',
239     &      '  findfont dup length dict begin',
240     &      '    {1 index /FID ne {def} {pop pop} ifelse} forall',
241     &      '    /Encoding ISOLatin1Encoding def',
242     &      '    currentdict',
243     &      '  end',
244     &      '} def',
245     &      '/Times-Roman           dup Latin1 definefont pop',
246     &      '/Times-Bold            dup Latin1 definefont pop',
247     &      '/Times-Italic          dup Latin1 definefont pop',
248     &      '/Times-BoldItalic      dup Latin1 definefont pop',
249     &      '/Helvetica             dup Latin1 definefont pop',
250     &      '/Helvetica-Bold        dup Latin1 definefont pop',
251     &      '/Helvetica-Narrow      dup Latin1 definefont pop',
252     &      '/Helvetica-Narrow-Bold dup Latin1 definefont pop',
253     &      '/Helvetica-Oblique     dup Latin1 definefont pop',
254     &      '/Helvetica-BoldOblique dup Latin1 definefont pop',
255     &      '% End Re-encoding','%'
256c
257c
258      WRITE(LB,600) '%%EndProlog'
259      WRITE(LB,600) '%%BeginSetup'
260      WRITE(LB,600) 'gsave'
261      WRITE(LB,600) 'UnitWidth UnitHeight translate'
262      WRITE(LB,600) 'SetBackground'
263      WRITE(LB,600)
264     &	'UnitWidth -1 mul dup UnitHeight -1 mul newpath moveto'
265      WRITE(LB,600)
266     &	'UnitWidth UnitHeight -1 mul lineto UnitWidth UnitHeight lineto'
267      WRITE(LB,600) 'UnitHeight lineto closepath fill'
268      WRITE(LB,606) 'Times-Bold',10.,'RestoreFont'
269      WRITE(LB,600) '/LabelStart gstate def'
270      WRITE(LB,600) '%%Endsetup'
271      WRITE(LB,600) '%%Page: 1 1'
272
273      RETURN
274
275
276      ENTRY LINP( INPUT, INTYPE, MATCOL, RGBMAT )
277c
278c     Read in next object
279      IF (INTYPE .EQ. FONT) THEN
280	READ (INPUT,*,END=50) FONTNAME, FONTSIZE, FONTALIGN
281	IF (FONTALIGN(1:1).EQ.'C') THEN
282	    IALIGN=1
283	ELSE IF (FONTALIGN(1:1).EQ.'R') THEN
284	    IALIGN=2
285	ELSE IF (FONTALIGN(1:1).EQ.'O') THEN
286	    IALIGN=3
287	ELSE
288	    IALIGN=0
289	ENDIF
290c
291c	Here is where Perl would shine
292c
293	len = len_trim(fontname)
294	WRITE (LB,606) FONTNAME(1:len), FONTSIZE, 'RestoreFont'
295
296      ELSE IF (INTYPE .EQ. LABEL ) THEN
297	READ (INPUT,*,END=50) XA, YA, ZA, RED, GRN, BLU
298	IF (MATCOL) THEN
299	    RED = RGBMAT(1)
300	    GRN = RGBMAT(2)
301	    BLU = RGBMAT(3)
302	ENDIF
303c
304c	Here is where Perl would shine
305c
306	READ (INPUT,'(A)',END=50) LABELSTRING
307	do j= MAXLABLEN,1,-1
308	    len = j
309	    if (LABELSTRING(len:len).ne.' ') goto 702
310	enddo
311702	continue
312c
313c       Isolated objects not transformed by TMAT, but still subject to inversion.
314c       Then again, PostScript y-axis convention is upside-down from screen coords.
315        IF (ISOLATION.GT.0) THEN
316          IF (.not.INVERT) YA = -YA
317	  if (isolation.eq.2) then
318	    if (xcent.gt.ycent) xa = xa * xcent / ycent
319	    if (xcent.lt.ycent) ya = ya * ycent / xcent
320	  endif
321        ELSE
322c         modify the input, as it were
323	  IF (IALIGN.NE.3) THEN
324	    CALL TRANSF (XA,YA,ZA, TMAT)
325            YA = -YA
326	  ENDIF
327        ENDIF
328c       perspective
329        IF (EYEPOS.GT.0) THEN
330	    PFAC = PERSP(ZA)
331	ELSE
332	    PFAC = 1.0
333	ENDIF
334c
335	XA = XA * PFAC * PSSCALE
336	YA = YA * PFAC * PSSCALE
337	ZA = ZA * PFAC * PSSCALE
338c
339	IF  (ZA * (SCALE/PSSCALE) .LT. BACKCLIP
340     &  .OR. ZA * (SCALE/PSSCALE) .GT. FRONTCLIP) RETURN
341c
342	CALL CHKRGB( RED, GRN, BLU, 'invalid label color')
343	RED = SQRT(RED)
344	GRN = SQRT(GRN)
345	BLU = SQRT(BLU)
346c
347	IF (IALIGN.EQ.3) THEN
348	    WRITE (LB,802) RED,GRN,BLU,XA,YA,ZA
349	ELSE
350	    WRITE (LB,801) RED,GRN,BLU,XA,YA,ZA
351	ENDIF
352801	FORMAT(3f6.3,' setrgbcolor',3(1x,f10.4),' XYZmove')
353802	FORMAT(3f6.3,' setrgbcolor',3(1x,f10.4),' XYZrmove')
354c
355c	At this point I should loop over string looking for
356c	escape sequences, control characters, etc.
357c
358	WRITE (LB,600) 'LabelStart currentgstate pop'
359	LEVEL  = 0
360	IBEG = 1
361  81	CONTINUE
362  	I = IBEG
363	IF (I.GT.LEN) RETURN
364  82	CONTINUE
365c
366c	27-Feb-2000
367c	TeX-like escape sequence processing
368c	Unfortunately this is not easily made compatible with anything other
369c	that Left-Align.
370c	Possibly these problems can be fixed by additional PostScript code?
371c
372	  backslash = '\\'
373	  if (labelstring(i:i) .eq. backslash) then
374	    j = i
375   83	    j = j + 1
376   	    if (labelstring(j:j).ge.'A' .and. labelstring(j:j).le.'Z')
377     &         goto 83
378   	    if (labelstring(j:j).ge.'a' .and. labelstring(j:j).le.'z')
379     &         goto 83
380	    if (j.gt.i+2 .and. j.le.len+1) then
381	      texstring = ltex( labelstring(i+1:j-1) )
382	      if (texstring.eq.char(0)) goto 90
383	      if (ibeg.lt.i)
384     &           write(LB,804) labelstring(ibeg:i-1),'show'
385     	      sssize = FONTSIZE
386	      if (level.ne.0) sssize = sssize * 0.8
387	      write(LB,605) 'Symbol',sssize
388	      write(LB,804) texstring,'show RestoreFont'
389	      if (level.ne.0) write(LB,600)'ShrinkFont'
390	      if (labelstring(j:j).eq.' ') j = j + 1
391	      ibeg = j
392	      goto 81
393	    endif
394	  endif
395
396	  if (labelstring(i:i) .eq. '_') then
397	    if (ibeg.lt.i)
398     &         write(LB,804) labelstring(ibeg:i-1),'show'
399	    write(LB,600) '0 FontHeight -0.3 mul rmoveto'
400	    write(LB,600) 'ShrinkFont'
401	    i = i + 1
402	    if (labelstring(i:i) .eq. '{') then
403	      level = -1
404	      ibeg = i + 1
405	      goto 81
406	    else
407	      if (labelstring(i:i).eq.backslash) labelstring(i:i)='^'
408	      write(LB,804) labelstring(i:i),'show'
409	      write(LB,600) 'RestoreFont'
410	      write(LB,600) '0 FontHeight 0.3 mul rmoveto'
411	      ibeg = i + 1
412	      goto 81
413	    endif
414	  endif
415
416	  if (labelstring(i:i) .eq. '^') then
417	    if (ibeg.lt.i)
418     &         write(LB,804) labelstring(ibeg:i-1),'show'
419	    write(LB,600) '0 FontHeight 0.3 mul rmoveto'
420	    write(LB,600) 'ShrinkFont'
421	    i = i + 1
422	    if (labelstring(i:i) .eq. '{') then
423	      level = 1
424	      ibeg = i + 1
425	      goto 81
426	    else
427	      if (labelstring(i:i).eq.backslash) labelstring(i:i)='^'
428	      write(LB,804) labelstring(i:i),'show'
429	      write(LB,600) 'RestoreFont'
430	      write(LB,600) '0 FontHeight -0.3 mul rmoveto'
431	      ibeg = i + 1
432	      goto 81
433	    endif
434	  endif
435
436	  if (labelstring(i:i) .eq. '}') then
437	    if (ibeg.lt.i)
438     &         write(LB,804) labelstring(ibeg:i-1),'show'
439	    write(LB,600) 'RestoreFont'
440	    write(LB,603) '0 FontHeight ',-0.3*level,'  mul rmoveto'
441	    level = 0
442	    ibeg = i + 1
443	    goto 81
444	  endif
445c
446c	End of TeX-like escape processing
447c
448   90	CONTINUE
449	  IF  ( LABELSTRING(I:I)    .EQ.backslash
450     &    .AND. LABELSTRING(I+1:I+1).EQ.'n') THEN
451	    IF (IBEG.LT.I) THEN
452	      IF (IALIGN.EQ.1) THEN
453	        WRITE (LB,803) LABELSTRING(IBEG:I-1),'Center'
454	      ELSE IF (IALIGN.EQ.2) THEN
455	        WRITE (LB,803) LABELSTRING(IBEG:I-1),'Right'
456	      ELSE
457	        WRITE (LB,803) LABELSTRING(IBEG:I-1),' '
458	      ENDIF
459	    ENDIF
460	    WRITE(LB,600) 'LabelStart setgstate',
461     &                    '0 FontHeight -1 mul rmoveto',
462     &	                  'LabelStart currentgstate pop'
463	    IBEG = I+2
464	    GOTO 81
465	  ENDIF
466	  IF  ( LABELSTRING(I:I)    .EQ.backslash
467     &    .AND. LABELSTRING(I+1:I+1).EQ.'v') THEN
468	    IF (IBEG.LT.I) THEN
469	      IF (IALIGN.EQ.1) THEN
470	        WRITE (LB,803) LABELSTRING(IBEG:I-1),'Center'
471	      ELSE IF (IALIGN.EQ.2) THEN
472	        WRITE (LB,803) LABELSTRING(IBEG:I-1),'Right'
473	      ELSE
474	        WRITE (LB,803) LABELSTRING(IBEG:I-1),' '
475	      ENDIF
476	    ENDIF
477	    WRITE(LB,600) '0 FontHeight 0.5 mul rmoveto'
478	    IBEG = I+2
479	    GOTO 81
480	  ENDIF
481	  IF  ( LABELSTRING(I:I)    .EQ.backslash
482     &    .AND. LABELSTRING(I+1:I+1).EQ.'b') THEN
483	    IF (IBEG.LT.I) THEN
484	      IF (IALIGN.EQ.1) THEN
485	        WRITE (LB,803) LABELSTRING(IBEG:I-1),'Center'
486	      ELSE IF (IALIGN.EQ.2) THEN
487	        WRITE (LB,803) LABELSTRING(IBEG:I-1),'Right'
488	      ELSE
489	        WRITE (LB,803) LABELSTRING(IBEG:I-1),' '
490	      ENDIF
491	    ENDIF
492	    WRITE(LB,600) 'FontWidth -0.5 mul 0 rmoveto'
493	    IBEG = I+2
494	    GOTO 81
495	  ENDIF
496	  IF  ( LABELSTRING(I:I)    .EQ.backslash
497     &    .AND. LABELSTRING(I+1:I+1).EQ.'A') THEN
498     	    LABELSTRING(I+1:I+1) = CHAR(197)
499     	  ENDIF
500	I = I + 1
501	IF (I.LE.LEN) GOTO 82
502c
503c	End proposed escape interpretation loop
504c
505	IF (IALIGN.EQ.1) THEN
506	    WRITE (LB,803) LABELSTRING(IBEG:LEN),'Center'
507	ELSE IF (IALIGN.EQ.2) THEN
508	    WRITE (LB,803) LABELSTRING(IBEG:LEN),'Right'
509	ELSE
510	    WRITE (LB,803) LABELSTRING(IBEG:LEN),' '
511	ENDIF
512803	FORMAT('(',A,') ',A6,'  show')
513804	FORMAT('(',A,') ',A)
514      ENDIF
515
516      RETURN
517
518c
519c Error handling
520c
521 50	WRITE (NOISE,*) '>>> Unrecognized label command'
522 	RETURN
523
524
525
526c
527c All done, finish off PostScript file and report success
528c
529      ENTRY LCLOSE( KEEP )
530c
531c     Make 100% sure that pixel[0,0] is background color so that
532c     it can be used for auto-definition of matte
533      WRITE (LB,600) '%Force pixel [0,0] to background color'
534      WRITE (LB,600) 'SetBackground'
535      WRITE (LB,600) 'newpath UnitWidth -1 mul UnitHeight moveto'
536      WRITE (LB,600) '1 0 rlineto 0 -1 rlineto -1 0 rlineto',
537     &               'closepath fill'
538c
539c     Finish off PostScript output
540      WRITE (LB,600) '%'
541      WRITE (LB,600) 'showpage'
542      WRITE (LB,600) '%%Trailer'
543      WRITE (LB,600) '%%DocumentFonts: Times-Bold'
544      WRITE (LB,600) '%%EOF'
545
546      IF (KEEP.GT.0) THEN
547          CLOSE (UNIT=LB)
548      ELSE
549          CLOSE (UNIT=LB,STATUS='DELETE')
550      ENDIF
551*
552      end
553
554C
555C     Map TeX escape sequences to the corresponding character in the
556C     standard PostScript SYmbol font.
557C     Most greek letters map to their own first letter, so we don't
558C     need to explicitly search for them.
559C     We explicitly map \nu to distinguish it from \n = newline,
560C     and \beta to distinguish it from \b = backspace.
561C
562      function ltex( symbolstring )
563      character*1 ltex
564      character*(*) symbolstring
565      ltex = symbolstring(1:1)
566c
567      if (ltex.eq.'b') ltex = char(0)
568      if (ltex.eq.'n') ltex = char(0)
569      if (ltex.eq.'v') ltex = char(0)
570c
571      if (symbolstring.eq.'beta') then
572          ltex = 'b'
573      else if (symbolstring.eq.'eta') then
574          ltex = 'h'
575      else if (symbolstring.eq.'nu') then
576          ltex = 'n'
577      else if (symbolstring.eq.'theta') then
578          ltex = 'q'
579      else if (symbolstring.eq.'phi') then
580          ltex = 'j'
581      else if (symbolstring.eq.'psi') then
582          ltex = 'y'
583      else if (symbolstring.eq.'omega') then
584          ltex = 'w'
585      else if (symbolstring.eq.'Eta') then
586          ltex = 'H'
587      else if (symbolstring.eq.'Theta') then
588          ltex = 'Q'
589      else if (symbolstring.eq.'Phi') then
590          ltex = 'F'
591      else if (symbolstring.eq.'Psi') then
592          ltex = 'Y'
593      else if (symbolstring.eq.'Omega') then
594          ltex = 'W'
595      else if (symbolstring.eq.'infty') then
596          ltex = char(165)
597C         ltex = '�'
598      else if (symbolstring.eq.'nabla') then
599          ltex = char(165)
600C         ltex = '�'
601      else if (symbolstring.eq.'ellipses') then
602          ltex = char(188)
603C         ltex = '�'
604      else if (symbolstring.eq.'partial') then
605          ltex = char(182)
606C         ltex = '�'
607      else if (symbolstring.eq.'degree') then
608          ltex = char(176)
609C         ltex = '�'
610      else if (symbolstring.eq.'func') then
611          ltex = char(166)
612C         ltex = '�'
613      else if (symbolstring.eq.'sqrt') then
614          ltex = char(214)
615C         ltex = '�'
616      else if (symbolstring.eq.'aleph') then
617          ltex = char(192)
618C         ltex = '�'
619      endif
620      return
621      end
622