program CardView

  use ReadCB_m, only: OpenCB, ReadRaw
  use Winteracter

  implicit None

  ! Dot pitch
  real, parameter :: DPI = 94.11 ! Dots per inch

  ! Window dimensions
  real, parameter :: CardWidth = 7.375, CardHeight = 3.25   ! Inches

  ! Hole dimensions
  real, parameter :: HoleWidth = 0.055, HoleHeight = 0.125  ! Inches
  real, parameter :: BotMargin = 0.250, LeftMargin = 0.251  ! inches
  real, parameter :: HorizSpace = 0.087, VertSpace = 0.250  ! Inches

  ! For row numbers
  real, parameter :: Mag = 1.325   ! Magnification for row number font
  real, parameter :: Shr = 0.65    ! Shrink for column number font
  real, parameter :: XOff = 0.01   ! Horizontal offset for row numbers

  ! Colors
  integer, parameter :: BGColor = 245 + 256*222 + 256*256*179 ! Wheat
  integer, parameter :: FGcolor = 0                           ! Black

  ! Fill pattern for "punches"
  integer, parameter :: Dense = 4

  ! Menu stuff
  integer, parameter :: IDM_Menu1    = 30001 ! The menu
  integer, parameter :: IDM_File     = 40001 ! File name
  integer, parameter :: IDM_CardNo   = 40002 ! Card number
  integer, parameter :: IDM_ShowRows = 40003 ! Show row numbers
  integer, parameter :: IDM_HideRows = 40004 ! Hide row numbers
  integer, parameter :: IDM_Exit     = 40005 ! Exit
  integer, parameter :: IDM_CmdLine  = 40006 ! Show command-line usage
  integer, parameter :: IDM_Keys     = 40007 ! Show key usage

  ! Dialogue stuff
  integer, parameter :: IDD_Dialog = 101  ! Dialog box for card number
  integer, parameter :: IDF_String = 1001 ! String box within dialog box

  integer :: Button              ! From the dialog box
  integer :: C = 0               ! Character position for accumulating key presses
  integer :: COLS(0:79) = 0      ! Columns 1:80 from the card
  character(len=12) :: CardNoTxt ! From the dialog
  integer :: CardNo = 1          ! From -r or the dialog via READ statement
  logical :: Debug = .false.
  character(len=1023) :: Fname   ! File name
  integer :: I                   ! Subscript for command-line arguments
  integer :: ITYPE               ! Window event type
  character(len=1023) :: Line
  type(win_message) :: MESSAGE
  logical :: Open = .false.      ! The file is open
  character(127) :: Prog
  logical :: ShowRows = .false.
  logical :: Starting = .true.   ! Window system isn't running yet

! Process command line
  call getarg ( 0, prog )
  i = 0
  fname = ''
  do
    i = i + 1
    call getarg ( i, line )
    if ( line(1:2) == '-d' ) then
      debug = .true.
    else if ( line(1:2) == '-r' ) then
      if ( line(3:3) == '' ) then
        i = i + 1
        call getarg ( i, line(3:) )
      end if
      read ( line(3:), * ) cardNo
    else if ( line(1:3) == '-s ' ) then
      showRows = .true.
    else if ( line(1:1) == '-' ) then
      print *, 'Usage: ', trim(prog), ' [options] [file]'
      print *, '  Options: -r[ ]rec => Show record number rec'
      print *, '           -s       => Show row numbers'
      print *, '           -<anything else> => Show usage'
      stop
    else if ( line == '' ) then
  exit
    else
      fname = line
    end if
  end do

! Initialize WiSK
  call wInitialise ( )

  call windowOpen ( &
    & flags = SysMenuOn + MinButton + MaxButton + FixedSizeWin + StatusBar, &
    & width = nint(cardWidth*dpi), height = nint(cardHeight*dpi), &
    & menuid = idm_menu1, title = 'Cardview' )

  call iGrUnits ( 0.0, 0.0, cardWidth, cardHeight )

  call windowStatusBarParts ( 3, (/ 1000, 1000, 8000 /) )

  call iGrColourModel ( 24 )
  call iGrColourN ( fgColor )
  call iGrFillPattern ( dense )

  call wDialogLoad ( IDD_Dialog )

  call wMessageEnable ( keyDown, 1 )
  call wMessageEnable ( pushButton, 1 )

  if ( fname /= '' ) then
    call openDeck
    call drawCard
  end if
  c = 0
  cardNoTxt = ''
  starting = .false.
  do
    call wMessage ( itype, message )
    if ( debug ) &
      & print *, 'itype =', itype, ', win =', message%win, ', value1 =', message%value1, &
        &  ', value2 =', message%value2, ', x =', message%x, ', y =', message%y
    select case ( itype )

    case ( closeRequest )
  exit

    case ( expose )
      call drawCard

    case ( keyDown )
      select case ( achar(message%value1) )
      case ( '0':'9' )
        c = c + 1
        cardNoTxt(c:c) = achar(message%value1)
      case ( 'd' )
        debug = .false.
      case ( 'D' )
        debug = .true.
      case ( 'h', 'H' )
        showRows = .false.
        call drawCard
      case ( 'n', 'N', achar(keyCursorDown), achar(keyPageDown) )
        c = 0
        cardNo = cardNo + 1
        call drawCard
      case ( 'p', 'P', achar(keyCursorUp), achar(keyPageUp) )
        c = 0
        cardNo = max(1, cardNo - 1 )
        call drawCard
      case ( 's', 'S' )
        showRows = .true.
        call drawCard
      case ( achar(keyBackSpace) )
        c = max(0,c-1)
      case ( achar(keyHome) )
        c = 0
        cardNo = 1
        call drawCard
      case ( '?' )
        call usageBox
      case ( 'q', 'Q', 'x', 'X', achar(keyF3) )
  exit
      case default
        if ( c > 0 ) then
          read ( cardNoTxt(:c), * ) cardNo
          c = 0
          cardNo = max(cardNo, 1)
          if ( cardNo > 0 ) then
            call drawCard
          end if
        end if
      end select
      ! Now draw the second status bar pane if we're working on numbers
      select case ( achar(message%value1) )
      case ( '0':'9', achar(keyBackSpace) )
      case default
        c = 0
      end select
      call windowOutStatusBar ( 2, cardNoTxt(:c) )
    case ( menuSelect )
      select case ( message%value1 )
      case ( IDM_CardNo )
        call wDialogSelect ( IDD_Dialog )
        call wDialogShow ( itype=modal )
        call cardNoDialog
      case ( IDM_CmdLine )
        call wMessageBox ( OKOnly, InformationIcon, CommonOk, &
          & "Usage: " // trim(prog) // " [options] [file]" // achar(13) // &
          & "Options:" // achar(13) // &
          & "  -r[ ]rec => Start with record 'rec'" // achar(13) // &
          & "  -s => Start by showing row numbers (default off)", &
          & 'Command Line' )
        call drawCard

      case ( IDM_Exit )
  exit

      case ( IDM_File )
        call wSelectFile ( '', PromptOn, fname, 'Load Deck' )
        if ( wInfoDialog(ExitButtonCommon) == CommonOK ) then
        ! print *, 'Input file name is ', trim(fname)
          close ( 10, iostat=i ) ! Ignore status
          call openDeck
          call drawCard
        end if

      case ( IDM_HideRows )
        showRows = .false.

      case ( IDM_Keys )
        call usageBox

      case ( IDM_ShowRows )
        showRows = .true.

      end select

    case ( pushButton )
      call cardNoDialog

    end select

  end do

! call windowClose ( )

contains

  ! -----------------------------------------------  CardNoDialog  -----
  subroutine CardNoDialog
    if ( wInfoDialog(exitButton) == IDOK ) then
      call wDialogGetString ( IDF_String, CardNoTxt )
      read ( cardNoTxt, *, iostat=i ) cardNo
      if ( i /= 0 ) then
        call io_error ( i )
      else
        cardNo = max(cardNo, 1)
      end if
      call drawCard
    end if
    call drawCard
  end subroutine CardNoDialog
  ! ---------------------------------------------------  DrawCard  -----
  subroutine DrawCard

    ! Draw a hole
    real, parameter :: Xhole(4) = (/ 0.0, holeWidth, holeWidth, 0.0 /)
    real, parameter :: Yhole(4) = (/ 0.0, 0.0, holeHeight, holeHeight /)

    character(2) :: Col
    character(*), parameter :: Digits = '9876543210'
    character(12) :: Msg

    integer :: IOSTAT

    ! Subscripts / loop inductors
    integer :: Row             ! Rows 0:11, numbered from the bottom
    integer :: Column          ! Columns 0:79, numbered from the left

    write ( msg, * ) 'Card', cardNo
    call windowOutStatusBar ( 1, trim(adjustl(msg)) )

    if ( open .and. cardNo > 0 ) then
      call readRaw ( 10, cardNo, cols, iostat )
      if ( iostat /= 0 ) then
        call io_error ( iostat )
  return
      end if
    end if
    call wGrTextFont ( ffHelvetica, fsBold, mag*holeWidth/cardWidth, &
      &                                     mag*holeHeight/cardHeight )
    call windowClear ( rgb = bgcolor ) ! Background
    do row = 0, 11
      do column = 0, 79
        if ( ibits(cols(column),row,1) /= 0 ) then
          call iGrPolygonComplex ( &
          & XHole + leftMargin - 0.5*holeWidth + horizSpace*Column, &
          & YHole + botMargin - 0.5*holeHeight + vertSpace*row, 4 )
        else if ( showRows .and. row < 10 ) then
          call wgrTextString ( leftMargin + horizSpace*Column + xoff, &
            &                  botMargin + vertSpace*row, digits(row+1:row+1) )
        end if
      end do ! column
    end do ! row
    if ( .not. showRows ) return
    call wGrTextFont ( ffHelvetica, fsBold, shr*holeWidth/cardWidth, &
      &                                     shr*holeHeight/cardHeight )
    do column = 1, 80
      write ( col, '(i0)' ) column
      call wgrTextString ( leftMargin + horizSpace*(column-1), &
        &                  botMargin - vertSpace*0.5, trim(col) )
    end do
  end subroutine DrawCard

  ! ---------------------------------------------------  IO_Error  -----
  subroutine IO_Error ( IOSTAT )
    integer, intent(in) :: IOSTAT
    character(len=127) :: MSG
    if ( starting ) then
      call wMessage ( itype, message )
      call windowClear ( rgb = bgcolor ) ! Background
    end if
    call iostat_msg ( iostat, msg )
    call wMessageBox ( OKOnly, ExclamationIcon, CommonOk, trim(msg), 'I/O Error' )
  end subroutine IO_Error

  ! ---------------------------------------------------  OpenDeck  -----
  subroutine OpenDeck
    integer :: IOSTAT
    close ( 10, iostat=iostat ) ! ignore status
    call openCB ( fname, 10, iostat )
    if ( iostat /= 0 ) then
      call io_error ( iostat )
      open = .false.
      call windowOutStatusBar ( 3, '' )
    else
      open = .true.
      call windowOutStatusBar ( 3, trim(fname) )
    end if
  end subroutine OpenDeck

  ! ---------------------------------------------------  UsageBox  -----
  subroutine UsageBox
    call wMessageBox ( OKOnly, InformationIcon, CommonOk, &
      & "h, H => Hide row numbers" // achar(13) // &
      & "s, S => Show row numbers" // achar(13) // &
      & "n, N, Cursor Down, Page Down => Next card" // achar(13) // &
      & "p, P, Cursor Up, Page Up => Previous card" // achar(13) // &
      & "q, Q, x, X, F3 => Quit" // achar(13) // &
      & "? => This box" // achar(13) // &
      & "digits followed by none of the above => Card number", &
      & 'Key strokes' )
    call drawCard
  end subroutine UsageBox

end program CardView
