PROGRAM FONTMAP
!	Print a map of characters
	CHARACTER*6 TEXT,lfont*40,nfont*20,LWORK*30
	INTEGER IASF(13)
	REAL ARX(4),ARY(4)
	LOGICAL INIT
	DATA INIT/.FALSE./
	INCLUDE 'SYS$LIBRARY:GKSDEFS.BND'
	INCLUDE 'GPLOT_SRC:GKALF.INC'	! FONTID, FPREC-->CHRMSG
	DATA IASF/13*1/		! Aspect Source Flags Individually settable

1	WRITE(6,FMT='(''$Font No.:'')')
	READ(5,FMT='(Q,I4)') NCHAR,INFONT
	IF(NCHAR .EQ. 0) GOTO 30

	IF(.NOT. INIT) THEN
	  CALL GSTART
	  INIT = .TRUE.
	END IF

	INPREC = 2
	IF     (INFONT .EQ. -1) THEN
	  NFONT = 'CARTOG'
	ELSE IF (INFONT .EQ. -3 ) THEN
	  NFONT = 'SIMPLX'
	ELSE IF	(INFONT .EQ. -6 ) THEN
	  NFONT = 'SCMPLX'
	ELSE IF	(INFONT .EQ. -9 ) THEN
	  NFONT = 'COMPLX'
	ELSE IF	(INFONT .EQ. -12) THEN
	  NFONT = 'DUPLX'
	ELSE IF	(INFONT .EQ. -15) THEN
	  NFONT = 'TRIPLX'
	ELSE IF (INFONT .EQ. -5) THEN
	  NFONT = 'SCRIPT'
	ELSE IF (INFONT .EQ. -8) THEN
	  NFONT = 'ITALIC'
	ELSE IF (INFONT .EQ. -11) THEN
	  NFONT = 'ITALIC'
	ELSE IF (INFONT .EQ. -16) THEN
	  NFONT = 'ITALIC'
	ELSE IF (INFONT .EQ. -7) THEN
	  NFONT = 'GREEKM7'
	ELSE IF (INFONT .EQ. -10) THEN
	  NFONT = 'GREEK'
	ELSE IF (INFONT .EQ. -18) THEN
	  NFONT = 'GOTHIC'
	ELSE IF (INFONT .EQ. -14) THEN
	  NFONT = 'RUSSIAN/CYRILLIC'
	ELSE IF (INFONT .EQ. -23) THEN
	  NFONT = 'MATH'
	ELSE IF (INFONT .EQ. -20) THEN
	  NFONT = 'SPECIAL'
	ELSE IF (INFONT .EQ. -17) THEN
	  NFONT = 'GERMAN'
	ELSE IF (INFONT .EQ. -19) THEN
	  NFONT = 'ITALIAN'
	ELSE IF (INFONT .EQ. -21) THEN
	  NFONT = 'MUSIC'
	ELSE IF (INFONT .EQ. -22) THEN
	  NFONT = 'SIGN'
	ELSE
	  NFONT = ' '
	END IF
	LNF = JLEN(NFONT)
	WRITE(LFONT,FMT='(''Font: '',I4,3A,''$'')')
	1           INFONT,' (',NFONT(1:LNF),')'
	
	CALL PAGE(11.0,8.5)
	CALL AREA2D(10.0,6.5)
	CALL DUPLX
	CALL HEIGHT(0.20)
	CALL HEADIN('Font-Map$',100,1.5,3)
	CALL HEADIN(lfont,100,1.0,3)
	CALL GQWKC(1,IERR,ICONID,IWKTYP)
	WRITE(LWORK,FMT='(''Workstation type'',I4,''$'')') iwktyp
	CALL HEADIN(LWORK,100,1.0,3)
	CALL GSASF(IASF)
!	Put the input font and precision in common for CHRMSG use
	IF(IWKTYP .EQ. 61) THEN
	  FONTID = -1
	ELSE
	  FONTID = 1
	END IF
	FPREC = INPREC
	CALL GSTXFP(FONTID,FPREC)

	call height(0.20)
c	CALL GSCHH(0.20)
	CALL GSCLIP(GNCLIP)

	XPOS = 0.0
	YPOS = 0.0
	I0 = 33
	IMAX = 126
	ICOL = 1
2	CONTINUE
	I = I0
	ARY(1) = -0.09
	DO WHILE (I .LT. IMAX)
	  IF(I .GT. 126) THEN
	    IF(IWKTYP .EQ. 61 .AND. FONTID .EQ. 1) THEN
	      FONTID = -1
	      CALL GSTXFP(FONTID,FPREC)
	    END IF
	  END IF
	  IF(ICOL .EQ. 1 .AND. ABS(INFONT) .EQ. 1) THEN
	    CALL INTNO(I,XPOS,YPOS)
	  ELSE
	    CALL GTX(XPOS,YPOS,CHAR(I))
	  END IF
	  I = I + 1
	  YPOS = YPOS + 0.3
	  IF(YPOS .GT. 6.0 .OR. I .EQ. IMAX) THEN
	    IF(ICOL .EQ. 1) THEN
	      CONX = XPOS + 0.2*0.67
!	(Software characters are 0.67 times correct height)
	      IF(ABS(FONTID) .EQ. 1) THEN
		IF(I .LT. 100) THEN
	          CONX = CONX + 0.2*.67
		ELSE
		  CONX = CONX + 2*0.2*0.67
		END IF
	      END IF
C	      CONX = XPOS + 0.25
C	      call vector(CONX,-0.09,CONX,ypos-0.09,0)
	      ARX(1) = CONX
	      ARX(2) = CONX
	      ARY(2) = YPOS - 0.09
	      CALL GPL(2,ARX,ARY)
	      CONX = CONX + 0.1
	      FONTID = INFONT
	      CALL GSTXFP(FONTID,FPREC)
	      XPOS = CONX + 0.05
	      I = I0
	      YPOS = 0.0
	      ICOL = 2
	    ELSE
	      FONTID = -1
	      CALL GSTXFP(FONTID,FPREC)
	      ICOL = 1
	      XPOS = XPOS + 0.50
	      YPOS = 0.0
	      I0 = I
	    END IF
	  END IF
	END DO
	IF(ABS(INFONT) .eq. 1) then	! Draw supplemental characters
	  IF (I .LT. 161) THEN
	    I0 = 161
	    IMAX = 254
	    GOTO 2
	  END IF
	end if
	YPOS = -0.09
	DO WHILE (YPOS .LE. 6.2)
C	  CALL VECTOR(-0.1,YPOS,XPOS-0.4,YPOS,0)
	  ARX(1) = -0.1
	  ARX(2) = XPOS-0.4
	  ARY(1) = YPOS
	  ARY(2) = YPOS
	  CALL GPL(2,ARX,ARY)
	  YPOS = YPOS + 0.3
	END DO
	call endpl(0)
	GOTO 1
30	CALL GSTOP

	END