FTN4,L
C 
C 
C 
C 
C 
C 
CC************************************************************
C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  ALL RIGHTS    *
C RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
CC************************************************************
C 
C 
C 
C      NAME: GFON1
C      SOURCE: 92840 - 18140
C      RELOC:  92840 - 16021
C 
C 
C 
CC*********************************************************** 
      SUBROUTINE GFON1(IAC,IGCB,NAME,ISECU,ICR,IDCB)
     +,92840-16021 REV.2013 790904
C************************************************************** 
C GFON1 OPENS AND VERIFIES A FONT FILE. IF IT IS A VALID FONT 
C FILE, GFON1 RETRIEVES THE INFORMATION ABOUT THE CHARACTER 
C SET FROMTHE FIRST RECORD OF THE FONT FILE AND PLACES IT INTO
C THE GCB.
C 
C NAME = NAME OF THE FONT FILE. 
C ISECU= SECURITY CODE OF FONT FILE.
C ICR  = CARTRIDGE NUMBER OF FONT FILE. 
C IDCB = 144-WORD DCB THAT CAN BE USED TOOPEN AND READ THE FONT FILE. 
C***************************************************************
      INTEGER IDCB(1),IERR,INFO(1),NAME(1),ISECU,ICR
C***********************************************************
C IF NAME .EQ. 0, USER IS TURNING OFF SOFTWARE TEXT.
C 
      IF (NAME .EQ. 0) GO TO 1000 
C***************************************************************
C OPEN THE FONT FILE AS A TYPE 1 FILE, SHARED ACCESS. 
C 
      IOPTN=5B
      CALL OPEN(IDCB,IERR,NAME,IOPTN,ISECU,ICR) 
      IF (IERR .GT. 0) IERR=0 
      IF (IERR .LT. 0) GO TO 9000 
C***************************************************************
C READ THE FIRST RECORD IN THE FILE.
C 
      CALL READF(IDCB,IERR,IDCB(17),128,LEN,1)
      IF (IERR .LT. 0) GO TO 9000 
C***************************************************************
C VERIFY THAT ITS A FONT FILE.
C 
      IF (IDCB(144) .EQ. 177777B) GO TO 800 
      CALL PLTER(7,IDUMY) 
      CALL GFON3(IGCB,0)
      RETURN
C***************************************************************
C GOOD FONT FILE, TURN ON THE SOFTWARE TEXT BIT.
C 
800   CALL GFON3(IGCB,1)
      RETURN
C************************************************************** 
C USER WANTS TO TURN OFF SOFTWARE TEXT. 
C 
1000  CONTINUE
      CALL GFON3(IGCB,0)
      CALL CLOSE(IDCB,IERR) 
      IF (IERR .GE. 0) RETURN 
C************************************************************** 
C ERROR POINTS. 
C************************************************************** 
C FMP ERRORS. 
C 
9000  CONTINUE
      CALL PLTER(IERR-300,IDUMY)
      CALL GFON3(IGCB,0)
      RETURN
      END 
                                                                                            