! pairs.f90      concentration

! user must get a pair on successive trys

! 11/12/96 JSS initial version

program pairs
  use pair_sort
  use vt_plotd
  implicit none
  character (len=1) :: row, col
  integer :: iostat
  integer :: x1, y1, i1, val1
  integer :: x2, y2, i2, val2
  integer :: turn, found, won
  logical, dimension(0:19) :: used
  character (len=3) :: count
  character (len=1) :: value

  call PairInit     ! set up initial deal
  call initialize   ! clear screen
  won = 0
  write(count, fmt="(i3)")won
  call put_string(14, 40, count)

  outer: do
    call PairDeal
    call PairDisplay
    turn = 0
    found = 0
    used = .false.

    inner : do

      call PairMessage("uncover first")
      do
        read(*,fmt="(2a1)",iostat=iostat)row,col    ! read first of pair
        if(iostat < 0) exit outer
        if(row == "q" .and. col == "q") exit inner
        call xy_from_input(row, col, x1, y1, i1, val1)
        if(used(i1)) then
          call PairMessage("already uncovered, enter again")
          cycle
        end if
        call bold_on
        write(value,fmt="(i1)")val1
        call put_string(12+2*y1, 8+4*x1, value)
        call bold_off
        exit
      end do

      do
        call PairMessage("uncover second")
        read(*,fmt="(2a1)",iostat=iostat)row,col    ! read second of pair
        if(iostat < 0) exit outer
        if(row == "q" .and. col == "q") exit inner
        call xy_from_input(row, col, x2, y2, i2, val2)
        if(used(i1) .or. (x1==x2 .and. y1==y2)) then
          call PairMessage("already uncovered, enter again")
          cycle
        end if
        call bold_on
        write(value,fmt="(i1)")val2
        call put_string(12+2*y2, 8+4*x2, value)
        call bold_off
        turn = turn + 1
        write(count, fmt="(i3)")turn
        call put_string(18, 40, count)
        if(val1 == val2) then
          found = found + 1
          write(count, fmt="(i3)")found
          call put_string(16, 40, count)
          if(found==10) then
            call bold_on
            call PairMessage("YOU WON!")
            call bold_off
            won = won + 1
            write(count, fmt="(i3)")won
            call put_string(14, 40, count)
            call delay(3.0)
            exit inner
          end if
          write(value,fmt="(i1)")val1
          call put_string(12+2*y1, 8+4*x1, value)
          write(value,fmt="(i1)")val2
          call put_string(12+2*y2, 8+4*x2, value)
          used(i1) = .true.
          used(i2) = .true.
          exit
        end if
        call PairMessage("not a pair")
        call delay(3.0)
        call put_string(12+2*y1, 8+4*x1, 'X')
        call put_string(12+2*y2, 8+4*x2, 'X')
        exit
      end do

    end do inner
  end do outer
contains
  subroutine PairDisplay

    call bold_on
    call put_string(22, 9,"Pick a Pair")
    call bold_off
    call put_string(20, 4, "    A   B   C   D   E")
    call put_string(18, 4, "1   X   X   X   X   X         Turn    0")
    call put_string(16, 4, "2   X   X   X   X   X         Found   0")
    call put_string(14, 4, "3   X   X   X   X   X         Won   ")   ! short
    call put_string(12, 4, "4   X   X   X   X   X")

    call PairMessage("uncover first")
  end subroutine PairDisplay


  subroutine PairMessage(S)
    character (len=*), intent(in) :: S

    call put_string( 8 ,8, S//"                ")
  end subroutine PairMessage

  subroutine xy_from_input(arow, acol, x, y, i, val)
    character (len=1), intent(in)  :: arow
    character (len=1), intent(in)  :: acol
    integer,           intent(out) :: x
    integer,           intent(out) :: y
    integer,           intent(out) :: i
    integer,           intent(out) :: val
    character (len=1)              :: row, col

    row = arow
    col = acol
    do
      x = -1
      y = -1
      if(row=='a' .or. row=='A') x=0
      if(row=='b' .or. row=='B') x=1
      if(row=='c' .or. row=='C') x=2
      if(row=='d' .or. row=='D') x=3
      if(row=='e' .or. row=='E') x=4
      if(row=='1') y=3
      if(row=='2') y=2
      if(row=='3') y=1
      if(row=='4') y=0
      if(col=='a' .or. col=='A') x=0
      if(col=='b' .or. col=='B') x=1
      if(col=='c' .or. col=='C') x=2
      if(col=='d' .or. col=='D') x=3
      if(col=='e' .or. col=='E') x=4
      if(col=='1') y=3
      if(col=='2') y=2
      if(col=='3') y=1
      if(col=='4') y=0
      if(x /= -1 .and. y /= -1) exit
      call PairMessage("enter again")
      read(*,fmt="(2a1)")row, col    ! read pair again
    end do

    i = 4*x+y
    val = cards(i)%card
  end subroutine xy_from_input

end program pairs