program CardList

! List a "deck" of "cards" from a "column binary" file.

  use ReadCB_m, only: OpenCB, ReadRaw, CloseCB

  ! Values for Decode
  integer, parameter :: Cardamation = 4 ! -c Decode Cardamation code
  integer, parameter :: None = 0        ! -n No decoding
  integer, parameter :: Pierce_A = 1    ! -a Decode Pierce primary
  integer, parameter :: Pierce_H = 2    ! -h Decode Pierce alternate
  integer, parameter :: SimH = 3        ! -d Decode SimH traditional

  integer :: BCD(80)   ! BCD code from card, 64 = invalid
  integer :: Cols(80)  ! Column  binary from card
  integer :: Decode = SimH

  character(12) :: Decodings(0:4) = (/ 'None        ', 'Pierce IBM A', &
    &                                'Pierce IBM H', 'SimH        ', &
    &                                'Cardamation ' /)
  integer :: I, J
  integer :: IOSTAT
  character(127) :: Line
  logical :: More          ! Some column still has a punch in it
  logical :: Octal = .false.
  logical :: Punches = .false.
  integer :: Rec           ! Record number
  integer :: Row           ! Row number being decoded
  integer :: Scale = 0     ! 0 = none, 1 = once, 2 = every card
  logical :: Seq = .false. ! Show sequence number
  integer :: Unit = 10 ! I/O Unit

  character(80) :: TheScale = &
    '....5...10...15...20...25...30...35...40' // &
  & '...45...50...55...60...65...70...75...80'

! Column binary codes for valid punch combinations
! High-order six bits are rows 12-3, low-order six bits are rows 4-9

  integer :: Colbin(0:63)
  data colbin / &
    o'0000', o'0400', o'0200', o'0100', o'0040', o'0020', o'0010', o'0004', &
    o'0002', o'0001', o'1000', o'0102', o'0042', o'0022', o'0012', o'0006', &
    o'0202', o'1400', o'1200', o'1100', o'1040', o'1020', o'1010', o'1004', &
    o'1002', o'1001', o'1202', o'1102', o'1042', o'1022', o'1012', o'1006', &
    o'2000', o'2400', o'2200', o'2100', o'2040', o'2020', o'2010', o'2004', &
    o'2002', o'2001', o'3000', o'2102', o'2042', o'2022', o'2012', o'2006', &
    o'4000', o'4400', o'4200', o'4100', o'4040', o'4020', o'4010', o'4004', &
    o'4002', o'4001', o'5000', o'4102', o'4042', o'4022', o'4012', o'4006'  /

  character(12) :: Rows = '9876543210-+'

  character(65), parameter :: Encodings(4) = (/ & ! z = invalid punch
    ' 1234567890#@:>{^/STUVWXYZ|,%~\"-JKLMNOPQR!$*];_&ABCDEFGHI?.)[<}z', &
    ' 1234567890='':>{^/STUVWXYZ|,(~\"-JKLMNOPQR!$*];_+ABCDEFGHI?.)[<}z', &
    ' 1234567890#@:>(^/STUVWXYZ'',%=\+-JKLMNOPQR!$*];_&ABCDEFGHI?.)[<"z', &
    ' 1234567890#@''=":/STUVWXYZ\,%_>?-JKLMNOPQR}$*);^&ABCDEFGHI{.<(+!z' &
    /)

  integer, parameter :: ScaleAll = 2    ! -s Show scale above every card
  integer, parameter :: ScaleOne = 1    ! -S Show scale above first card

  i = 0
o: do
    i = i + 1
    call getarg ( i, line )
    if ( line(1:1) == '-' ) then
      do j = 2, len(line)
        select case ( line(j:j) )
        case ( 'a' )
          decode = Pierce_A
        case ( 'c' )
          decode = cardamation
        case ( 'd' )
          decode = SimH
        case ( 'h' )
          decode = Pierce_H
        case ( 'n' )
          decode = none
        case ( 'O' )
          octal = .true.
        case ( 'p' )
          punches = .true.
        case ( 'q' )
          seq = .true.
        case ( 's' )
          scale = scaleOne
        case ( 'S' )
          scale = scaleAll
        case ( '-' ) ! Skip rest of this field, next is input file
          i = i + 1
          call getarg ( i, line )
          exit o
        case ( ' ' )
          exit
        case default
          call usage
        end select
      end do
    else
      exit
    end if
  end do o

  if ( line == '' ) call usage

  call openCB ( line, unit )

  if ( scale == scaleOne ) write ( *, '(a)' ) theScale

  line = ''
  rec = 0
  do
    rec = rec + 1
    call readRaw ( unit, rec, cols, iostat )
    if ( iostat /= 0 ) exit

    if ( octal ) write ( *, '(20(1x,o4.4))' ) cols

    if ( seq ) write ( line(87:90), '(i4)' ) rec

    if ( scale == scaleAll ) then
      write ( *, '(a)' ) trim(theScale//line(81:90))
      line = ''
    end if

    if ( decode /= 0 ) then
      ! Convert column binary to BCD
      do i = 1, 80
        do j = 0, 63
          if ( cols(i) == colbin(j) ) exit
        end do
        line(i:i) = encodings(decode)(j+1:j+1)
      end do
      write ( *, '(a)' ) trim(line)
      line = ''
    end if

    if ( punches ) then
      more = .true.
      do while ( more )
        more = .false.
        do i = 1, 80
          do row = 11, 0, -1
            if ( ibits(cols(i),row,1) /= 0 ) then
              line(i:i) = rows(row+1:row+1)
              cols(i) = ibclr(cols(i),row)
              if ( cols(i) /= 0 ) more = .true.
              exit
            end if
          end do
        end do
        write ( *, '(a)' ) trim(line)
        line = ''
      end do
    end if

  end do

  call CloseCB ( unit )

contains

  subroutine Usage
    call getarg ( 0, line )
    print *, 'Usage: ', trim(line), ' [options] [--] input_file'
    print *, ' Options: -a => Decode using Pierce primary (IBM-A) code'
    print *, '          -c => Decode using Cardamation code'
    print *, '          -d => Decode using SimH traditional code'
    print *, '          -h => Decode using Pierce alternate (IBM-H) code'
    print *, '          -n => No decoding'
    print *, '          -O => Dump cards'' column-binary representation in octal'
    print *, '          -p => Show punches'
    print *, '          -q => Show sequence numbers'
    print *, '          -s => Print a column scale above first card'
    print *, '          -S => Print a column scale above every card'
    print *, ' Default decoding: ', trim(decodings(decode))
    stop
  end subroutine Usage

end program CardList
