*-----------------------------------------------------------------------
*     PROGRAM FOR BITMAP FILE CONVERSION FOR X               (94/05/07)
*-----------------------------------------------------------------------
*     Copyright (C) 2000-2022 GFD Dennou Club. All rights reserved.
*-----------------------------------------------------------------------
      PROGRAM BMCX11

      PARAMETER (NBASE=8,NBMAX=32)
      PARAMETER (NCMAX=NBMAX/NBASE,NHMAX=NCMAX*2)
      PARAMETER (NLMAX=NBMAX*NHMAX)
      PARAMETER (IU1=11,IU2=21)

      CHARACTER CPAT(NCMAX)*(NBASE),CPATX*(NBMAX),CLINE*(NLMAX),
     +          CDSNI*64,CDSNO*64,CFMT1*8,CMSG*80

      EQUIVALENCE (CPAT,CPATX)


*     / READ BITMAP FILE NAMES /

*     WRITE(*,*) ' INPUT  BITMAP FILE NAME (C) ? ;'
*     READ(*,*) CDSNI
*     WRITE(*,*) ' OUTPUT BITMAP FILE NAME (C) ? ;'
*     READ(*,*) CDSNO

      READ(*,*) CDSNI,CDSNO

*     / OPEN BITMAP FILES /

      OPEN(IU1,FILE=CDSNI,FORM='FORMATTED',STATUS='OLD')
      REWIND(IU1)
      OPEN(IU2,FILE=CDSNO,FORM='FORMATTED',STATUS='NEW')
      REWIND(IU2)

*     / READ ASCII BITMAP IMAGE & WRITE HEXADECIMAL BITMAP IMAGE /

      READ(IU1,'(I4)') NPAT
      WRITE(IU2,'(I4)') NPAT

      DO 10 I=1,NPAT

        READ(IU1,'(4I4)') IPAT1,IPAT2,IBITS,ILINE

        IF (.NOT.(NBASE.LE.IBITS .AND. IBITS.LE.NBMAX)) THEN
          CMSG='BIT LENGTH IS NOT WITHIN ## - ##.'
          WRITE(CMSG(26:27),'(I2)') NBASE
          WRITE(CMSG(31:32),'(I2)') NBMAX
          WRITE(*,'(A)') ' ERROR -- '//CMSG
        END IF
        IF (MOD(IBITS,NBASE).NE.0) THEN
          CMSG='BIT LENGTH IS NOT MULTIPLE OF ##.'
          WRITE(CMSG(31:32),'(I2)') NBASE
          WRITE(*,'(A)') ' ERROR -- '//CMSG
        END IF

        NBIT=IBITS
        NBYT=NBIT/NBASE
        NHEX=NBYT*2

        WRITE(CFMT1,'(A,I2,A)') '(A',NBIT,')'

        DO 20 J=1,ILINE
          READ(IU1,CFMT1) CPATX(1:NBIT)
          DO 30 K=1,NBYT
            CALL CRVRS(CPAT(K)(1:NBASE))
   30     CONTINUE
          DO 40 N=1,NHEX
            IH1=4*(N-1)+1
            IH2=IH1+(4-1)
            IDX=NHEX*(J-1)+N
            CALL HEXDCC(CPATX(IH1:IH2),CLINE(IDX:IDX))
   40     CONTINUE
   20   CONTINUE

        WRITE(IU2,100) IPAT1,IPAT2,IBITS,ILINE,CLINE(1:NHEX*ILINE)
  100   FORMAT(I4,I4,I3,I3,TR1,A)

   10 CONTINUE

*     / CLOSE BITMAP FILE /

      CLOSE(IU1)
      CLOSE(IU2)

      END
*-----------------------------------------------------------------------
      SUBROUTINE CRVRS(CHR)

      CHARACTER CHR*(*)

      CHARACTER CH1*1


      LC=LEN(CHR)
      DO 10 I=1,LC/2
        CH1=CHR(LC-I+1:LC-I+1)
        CHR(LC-I+1:LC-I+1)=CHR(I:I)
        CHR(I:I)=CH1
   10 CONTINUE

      END
*-----------------------------------------------------------------------
      SUBROUTINE HEXDCC(CP,CH)

      CHARACTER CP*(*),CH*(*)

      CHARACTER CHEX(0:15)*1

      SAVE

      DATA      CHEX/ '0', '1', '2', '3', '4', '5', '6', '7',
     +                '8', '9', 'A', 'B', 'C', 'D', 'E', 'F'/


      NN=0
      DO 10 I=4,1,-1
        IF (CP(I:I).NE.'0') THEN
          NN=NN+2**(4-I)
        END IF
   10 CONTINUE
      CH=CHEX(NN)

      END
