*-----------------------------------------------------------------------
*     Copyright (C) 2000-2022 GFD Dennou Club. All rights reserved.
*-----------------------------------------------------------------------
      PROGRAM SGFONT

      CHARACTER CH*3,USGI*3,CTTL*32
      CHARACTER FONTNAME*70

      INTEGER   ISYS

      DATA      CTTL/'FONT NO. = #'/


      WRITE(*,*) ' WORKSTATION ID (I)  ? ;'
      CALL SGPWSN
      READ(*,*) IWS
      WRITE(*,*) ' STROKE FONT(1) / SYSTEM FONT(2)  ? ;'
      READ(*,*)ISYS

      CALL SGLSET('LCNTL', .FALSE.)
      IF (ISYS.EQ.2) THEN
        CALL SWLSET('LSYSFNT', .TRUE.)
        WRITE(*,*) ' FONT NO (1,2) (I) OR DIALOG(3) ? ;'
        READ(*,*) N
      ELSE
        CALL SWLSET('LSYSFNT', .FALSE.)
        WRITE(*,*) ' FONT NO (1,2) (I)  ? ;'
        READ(*,*) N
      END IF


      CALL SGOPN( IWS )
      IF (ISYS.EQ.2 .AND. N.EQ.3)THEN
        CALL SWSLFT(FONTNAME)
        CALL SWCSET('FONTNAME', FONTNAME)
      END IF

      CALL SGLSET('LCNTL',.FALSE.)

      CALL SLMGN( 0.1, 0.1, 0.1, 0.1 )
      CALL SLRAT( 1.0, 1.0 )

      CALL SGFRM

      CALL SGISET( 'IFONT', N )

      CALL SGSWND( 0.0, 16.0, 0.0, 16.0 )
      CALL SGSVPT( 0.05, 0.95, 0.0, 0.9 )
      CALL SGSTRN( 1 )
      CALL SGSTRF

      DO 10 I=0,16
        CALL SGLNZU( REAL(I), 0.0, REAL(I), 16.0, 2 )
        CALL SGLNZU( 0.0, REAL(I), 16.0, REAL(I), 2 )
   10 CONTINUE

      WRITE(CTTL(12:12),'(I1)') N

      CALL SGTXZV( 0.5, 0.95, CTTL, 0.03, 0, 0, 3 )

      DO 15 I=0,255
        UX=I/16+0.5
        UY=16-MOD(I,16)-0.5
        CALL SGTXZU( UX, UY, USGI(I), 0.035, 0, 0, 3 )
        UX=UX+0.48
        UY=UY+0.38
        WRITE(CH,'(I3)') I
        CALL SGTXZU( UX, UY, CH, 0.01, 0, +1, 1 )
   15 CONTINUE

      CALL SGCLS

      END
