PROGRAM HCG
C
C	This program is used to generate and edit the Hershey
C	character sets.
C
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
	COMMON /HCDB/ ICASE, NVEC, IWIDTH, LL0, LL0D, SCALE, SCALED,
	1  COSUPC, SINUPC, COSUPD, SINUPD, COSUPT, SINUPT, DES, DEF
	COMMON /ETC/ NEWDO, OLDDO, DFAULT, MAPIN(128), SCALEF,
	1  NVCTRS(90), NCHAR, IVCTRS(800), ITIS, H, HD, TABFAC,
	2  ISETAV, TRNFRM, TABON, YWRITE, CHMIN, CHMAX, XMENU, YMENU,
	3  XC, YC, XCH, YCH, IPEN, COSTH, SINTH, XTAB0, YTAB0, 
	4  IXTAB, IYTAB, ICHAR, ISET(2)
	DIMENSION ISCALE(2)
	INTEGER OLDDO
	LOGICAL DFAULT, TRNFRM, TABON
	LOGICAL*1 ICHAR, ISET
	EQUIVALENCE ( SCALE, ISCALE )
C-
	EXTERNAL PLTNOS
	LOGICAL*1 IANS
	DIMENSION IDC(65)
	DATA IDC/ "55, "66, "64, "60, "53, "63, "67, "70,
	1  "51, "52, "47, "45, "56, "46, "57, "50,
	2  "33, "34, "35, "36, "37, "40, "41, "42,
	3  "43, "44, "00, "77, "72, "54, "73, "71,
	4  "74, "01, "02, "03, "04, "05, "06, "07,
	5  "10, "11, "12, "13, "14, "15, "16, "17,
	6  "20, "21, "22, "23, "24, "25, "26, "27,
	7  "30, "31, "32, "61, "75, "62, "76, "65, "70/
	DATA NEWDO, OLDDO/2*0/
	DATA DFAULT/.TRUE./, TRNFRM, TABON/2*.FALSE./
	CALL USEREX( PLTNOS )
C
C - CALCULATE MAPPINGS.
	NREC = 1
	MAPIN(1) = NREC
	MAPIN(2) = NREC
	DO 1 I=1,52
	NREC = NREC + 1
1	MAPIN(2+I) = NREC
	DO 2 I=55,128,2
	NREC = NREC + 1
	MAPIN(I) = NREC
2	MAPIN(I+1) = NREC
C
C
C - GET TABLET SIZING INFORMATION.
	CALL PSEUDO(2)
	CALL HOME
	WRITE(2,3)
3	FORMAT('$Which size tablet? [Small/large]? ')
	READ(2,4,END=1500) IANS
4	FORMAT(A1)
	CALL ITWAS( IANS, 'L', 1, ITIS )
	TABFAC = 4.
	IF( ITIS .EQ. 1 ) TABFAC = 1.
C
C - GET FILE AND CONTINUE.
	CALL PLTSLV
	NEWDO = 0
100	CALL HCGSAV
C
C - WHICH CHARACTER?
200	CALL ERASE
	CALL HOME
	WRITE(2,210)
210	FORMAT(/,'$Which Character: ')
	READ(2,220,END=1500) ICHAR
220	FORMAT(A1)
C
C - CALCULATE CHARACTER NUMBER.
	IF( ICHAR .LT. "40 ) GO TO 200
	ICASE = 0
	NCHAR = ICHAR
	IF( NCHAR .LT. "141 ) GO TO 300
	ICASE = 4
	NCHAR = NCHAR - "40
300	NCHAR = NCHAR - "40
	IOFF = NCHAR+1
	NCHAR = IDC( IOFF )
	NCHAR = ( NCHAR*8 + ICASE)/4 + 1
	IF( ( NCHAR .LT. 1 ) .OR. ( NCHAR .GT. 128 ) ) GO TO 200
	NCHAR = MAPIN( NCHAR )
C
C - READ IN PRESENT DEFINITION OF CHARACTER.
400	READ(1'91) LL0D, SCALED, HD, NVCTRS
	NVEC = NVCTRS( NCHAR )
	IF( NVEC .EQ. 0 ) READ(1'NCHAR) IWIDTH, DFAULT, LL0, SCALE, H
	IF( NVEC .NE. 0 ) READ(1'NCHAR) IWIDTH, DFAULT, LL0, SCALE, H,
	1  ( IVCTRS(J), J=1,NVEC )
	GO TO 900
C
C - WHAT TO DO NEXT.
500	CALL HCGHIT
	IF( NEWDO .LE. 0 ) GO TO 500
C
	GO TO ( 700, 800, 600, 900, 1001, 600, 600, 500, 400,
	1  1000, 1100, 700, 1200, 1300, 1400 ), NEWDO
C
C - ADD, DELETE, INSERT, MOVE, SELECT.
600	IF( OLDDO .NE. 12 ) GO TO 500
700	CALL HCGSEL
	GO TO 500
C
C - CLEAR.
800	NVEC = 0
	IWIDTH = 0
C
C - DISPLAY.
900	CALL HCGDIS
	IF( NEWDO .EQ. 2 ) CALL HCGLBL( 'Cleared.' )
	IF( NEWDO .EQ. 9 ) CALL HCGLBL( 'Restarted.' )
	IF( NEWDO .EQ. 11 ) CALL HCGLBL( 'Scaled.' )
	CALL HCGLBL( 'Displayed.' )
	IF( TABON ) CALL HCGLBL( 'Tablet On.' )
	IF( .NOT. TABON ) CALL HCGLBL( 'Tablet Off.' )
	GO TO 500
C
C - SAVE.
1000	IF( NVEC .EQ. 0 ) WRITE(1'NCHAR) IWIDTH, DFAULT, LL0, SCALE, H
	IF( NVEC .NE. 0 ) WRITE(1'NCHAR) IWIDTH, DFAULT, LL0, SCALE, H,
	1  ( IVCTRS(J), J=1,NVEC )
	NVCTRS(NCHAR) = NVEC
	WRITE(1'91) LL0D, SCALED, HD, NVCTRS
	CALL HCGLBL( 'Saved.' )
1001	CALL HCGLBL( 'Continue, Display, Exit or Save? [C/d/e/s] ')
	READ(2,220,END=1500) IANS
	CALL ITWAS( IANS, 'DES', 3, ITIS )
	GO TO ( 900, 1002, 1000, 200 ) ITIS
1002	NEWDO = 5
	GO TO 100
C
C - SCALE.
1100	CALL HCGSCL
	GO TO 900
C
C - TABLET.
1200	TABON = .NOT. TABON
	IF( TABON ) CALL HCGLBL( 'Tablet On.' )
	IF( .NOT. TABON ) CALL HCGLBL( 'Tablet Off.' )
	IF( ( TABON .AND. TRNFRM ) .OR. ( .NOT. TABON ) ) GO TO 500
C
C - TRANSFORM.
1300	IF( TABON ) CALL HCGTRN
	GO TO 500
C
C - WIDTH.
1400	CALL HCGLBL( 'Set Width.' )
	CALL HCGHIT
	IF( NEWDO .EQ. 5 ) GO TO 500
	IF( NEWDO .NE. 0 ) GO TO 1400
	IWIDTH = IXTAB
	CALL HCGLBL( 'Width Set.' )
	GO TO 500
C
1500	CALL PLTNOS
	CALL CALPLT(0.,0.,999)
	STOP
	END