PROGRAM SETS
C
C	This program generates the listings of the various character
C	sets.
C
	COMMON /PLTR/ ILun, IDev, IsTerm, IMode, IXMax, IYMax,
	1  Cnvrsn, CMag, CnvMag, IX0, IY0, KSetNo, IFancy, IBfDv3,
	1  CSize, DeltaH, DeltaV, Upsiln, CosUp, SinUp, WidAdj
	LOGICAL*1 CHAR(90), ICHAR(2), TITLE(18), DEF(80), IT
C
	ENCODE(90,10,CHAR)
10	FORMAT('AaBbCcDdEe','FfGgHhIiJj','KkLlMmNnOo','PpQqRrSsTt',
	1  'UuVvWwXxYy','Zz.,?:;''"!','0123456789',
	1  '()[]<>+-=*', '#$%&^@\_/ ' )
C
	CALL PSEUDO
	DX = IXMAX/( 10.*CNVMAG )
	DY = IYMAX/( 10.*CNVMAG )
1	CALL ERASE
	CALL HOME
	WRITE(5,9)
9	FORMAT(' Do you want just fonts or all characters?(A,T) ')
	READ(5,11)IT
11	FORMAT(1A1)
	IF (IT.NE.'A')GOTO 4000
	WRITE(5,2)
2	FORMAT('$Character sets: ')
	READ(5,3,ERR=1,END=3100) KMIN, KMAX
3	FORMAT(2I8)
	KMIN = MIN0( 39, MAX0( KMIN, 3 ) )
	KMAX = MAX0( KMIN, MIN0( KMAX, 39 ) )
C
	DO 3000 KSET=KMIN,KMAX
	CALL ERASE
	ENCODE(18,4,TITLE) KSET
4	FORMAT('$=Character Set ',I2)
	CALL HCUSE( 17 )
	CALL SIZEUP( .25, 0. )
	CALL HCSIZE( TITLE, 18, W, U, D )
	XP = IXMAX/(2.*CNVMAG) - W/2.
	YP = IYMAX/CNVMAG - U
	CALL HCGEN( XP, YP, 0,0 )
	DT = U
C
C
C - GENERATE IDENTIFIERS.
	CALL HCUSE(0)
	CALL SIZEUP(.25,0.)
	DO 1000 I=1,90
	ICHAR(1) = CHAR(I)
	N = 1
	CALL ITWAS( ICHAR, '<>$', 3, ITIS )
	IF( ITIS .EQ. 4 ) GO TO 100
	ICHAR(1) = '$'
	ICHAR(2) = CHAR(I)
	N = 2
100	W = N*DELTAH
	XP = ( MOD(I-1,10) + .5 )*DX - W
	YP = ( 9 - ( I-1 )/10 )*DY - DT
1000	CALL HCGEN( XP, YP, ICHAR, N )
C
C - GENERATE CHARACTERS.
	CALL HCUSE( KSET )
	CALL SIZEUP( .4, 0. )
	DO 2000 I=1,90
	ICHAR(1) = CHAR(I)
	N = 1
	CALL ITWAS( ICHAR, '<>$', 3, ITIS )
	IF( ITIS .EQ. 4 ) GO TO 1100
	ICHAR(1) = '$'
	ICHAR(2) = CHAR(I)
	N = 2
1100	XP = ( MOD(I-1,10) + .5 )*DX 
	YP = ( 9 - ( I-1 )/10 )*DY - DT
2000	CALL HCGEN( XP, YP, ICHAR, N )
	CALL SIZEUP( .2, 0. )
	CALL HCUSE( 8 )
	IF( KSET .EQ. 9 ) GO TO 2009
	IF( KSET .EQ. 10 ) GO TO 2010
	IF( ( KSET .GE. 30 ) .AND. ( KSET .LE. 37 ) ) GO TO 2030
	GO TO 3000
2009	CALL HCSIZE( 'Note: In this character set, the $<SP$> is
	1 a half-$<SP$>.', 999, W, U, D )
	GO TO 2199
2010	CALL HCSIZE( 'Note: Additional characters will be added
	1 at your request.', 999, W, U, D )
	GO TO 2199
2030	CALL SIZEUP( .125, 0. )
	CALL HCUSE(3)
	ENCODE(20,2031,DEF) KSET, 0
2031	FORMAT('DB0:[4,4]HCST',I2,'.DEF',A1)
	OPEN( UNIT=1, NAME=DEF, TYPE='OLD', READONLY )
2032	READ(1,2033,END=2034) IT, NDEF, DEF
2033	FORMAT(A1,1X,Q,80A1)
	CALL ITWAS( IT, CHAR, 90, ITIS )
	IF( CHAR(ITIS) .NE. IT ) ITIS = ITIS + 1
	XP = ( MOD(ITIS-1,10) + .5 )*DX + .2
	YP = ( 9 - (ITIS-1)/10 )*DY - .2 - DT
	CALL HCGEN( XP, YP, DEF, NDEF, 'C' )
	GO TO 2032
2034	CLOSE( UNIT=1 )
	CALL HCUSE( 8 )
	CALL SIZEUP( .2, 0. )
	ENCODE(49,2035,DEF) KSET-30
2035	FORMAT('Note: These character sets are referenced by $$O',I1)
	CALL HCSIZE( DEF, 49, W, U, D )
2199	CALL HCGEN( 0., -D, 0, 0 )
3000	CALL HDCOPY
	GO TO 1
C
3100	CALL HCUSE( 0 )
	CALL SIZEUP( .1, 0 )
	CALL CALPLT(0.,0.,999)
	STOP
4000	CALL ERASE
	CALL HCUSE( 17 )
	CALL SIZEUP( .25, 0. )
	CALL HCSIZE( 'Character Fonts', 999, W, U, D )
	XP = IXMAX/(2.*CNVMAG) - W/2.
	YP = IYMAX/CNVMAG - U
	CALL HCGEN( XP, YP, 0,0 )
	DT = U
C
C
C - GENERATE IDENTIFIERS.
	CALL HCUSE(0)
	CALL SIZEUP(.25,0.)
	DO 5000 I=1,39
	ENCODE(2,5001,ICHAR)I
5001	FORMAT(I2)
	N = 2
	W = N*DELTAH
	XP = ( MOD(I-1,10) + .5 )*DX - W
	YP = ( 9 - ( I-1 )/10 )*DY - DT
5000	CALL HCGEN( XP, YP, ICHAR, N )
C
C - GENERATE CHARACTERS.
	DO 6000 I=1,39
	CALL SIZEUP( .4, 0. )
	CALL HCUSE(I)
	ICHAR(1) = 'A'
	N = 1
	XP = ( MOD(I-1,10) + .5 )*DX 
	YP = ( 9 - ( I-1 )/10 )*DY - DT
	KSET = I
	CALL HCGEN( XP, YP, ICHAR, N )
	CALL SIZEUP( .2, 0. )
	CALL HCUSE( 8 )
	IF( ( KSET .GE. 30 ) .AND. ( KSET .LE. 37 ) ) GO TO 6030
	GO TO 7000
6030	CALL SIZEUP( .125, 0. )
	CALL HCUSE(3)
	ENCODE(20,6031,DEF) KSET, 0
6031	FORMAT('DB0:[4,4]HCST',I2,'.DEF',A1)
	OPEN( UNIT=1, NAME=DEF, TYPE='OLD', READONLY )
6032	READ(1,6033,END=6034) IT, NDEF, DEF
6033	FORMAT(A1,1X,Q,80A1)
	ITIS=I
	XP = ( MOD(ITIS-1,10) + .5 )*DX + .2
	YP = ( 9 - (ITIS-1)/10 )*DY - .2 - DT
	CALL HCGEN( XP, YP, DEF, NDEF, 'C' )
6034	CLOSE( UNIT=1 )
7000	CONTINUE
6000	CONTINUE
C
	CALL SIZEUP( .1, 0 )
	CALL HCUSE(0)
	CALL CALPLT(0.,0.,999)
	STOP
	END