\ VP-score-hand
\ Hand scoring
\ 
\ $Id: VP-score-hand.txt,v 1.1 2000/10/25 00:17:43 kris_johnson Exp $

\ Copyright 2000
\ Kristopher D. Johnson
\ 
\ See LICENSE-JacksOrBetter for the
\ conditions under which you may
\ use, redistribute, or modify this 
\ code, or create derived works.

docneeds VP-hand
docneeds VP-score
docneeds VP-scoringcards

.( VP-score-hand... )

\ Array used by score-hand
MaxRank 1+ array RankCount

0 RankCount constant 0RankCount

MaxRank 1+ RankCount
constant LimRankCount

LimRankCount 0RankCount -
constant /RankCount

\ Array used by score-hand
MaxSuit 1+ array SuitCount

0 SuitCount constant 0SuitCount

MaxSuit 1+ SuitCount
constant LimSuitCount

LimSuitCount 0SuitCount -
constant /SuitCount

: init-count ( -- )
  0RankCount /RankCount 0 fill
  0SuitCount /SuitCount 0 fill
  0ScoringCard /ScoringCard 0 fill
;

\ Increment appropriate elements
\ of SuitCount and RankCount
: count-card ( adr -- )
  card@ ( rank suit )
  SuitCount incr
  RankCount incr
;

\ Call count-card for each card
\ in Hand
: count-hand ( -- )
  init-count
  HandBounds do
    i count-card
  cell +loop
;

\ Return suit if hand is a flush,
\ or zero if not a flush
: flush? ( -- 0|suit )
  SuitBounds do
    i SuitCount @ #Hand = if
      i unloop exit
    then
  loop
  false
;

  \ Find lowest-ranked card
: low-rank ( -- rank )
  RankBounds do
    i RankCount @
    0<> if
      i unloop exit
    then
  loop
  0
;

: RankCount1= ( u -- f )
  RankCount @ 1 = ;

: ace-low-straight? ( -- f )
  Ace RankCount1= if
    2 RankCount1= if
      3 RankCount1= if
        4 RankCount1= if
          5 RankCount1= if
            true exit
          then
        then
      then
    then
  then
  false
;

\ Return 0 if no straight, or rank
\ of lowest card of straight
: straight? ( -- 0|rank )
  low-rank
  dup 10 > if
    drop 0 exit
  then
  dup RankCount @ 1 > if
    drop 0 exit
  then

  dup 2 = if
    ace-low-straight?
    if drop Ace exit then
  then

  \ Check whether the next
  \ four ranks are also there.
  dup 5 + over 1+ ( n n+5 n+1 )
  do ( n )
    i RankCount @
    1 <> if drop 0 leave then
  loop
;

\ Return lowest rank of cards
\ if n-of-a-kind
: n-of-a-kind? ( n -- 0|rank )
  RankBounds do
    dup i RankCount @ = if
      drop i unloop exit
    then
  loop
  drop 0
;

\ Return rank of cards if 4-of-a-kind
: 4-of-a-kind? ( -- 0|rank )
  4 n-of-a-kind? ;

\ Return rank of cards if 3-of-a-kind
: 3-of-a-kind? ( -- 0|rank )
  3 n-of-a-kind? ;

\ Return true and both ranks if there
\ are two pairs, or false if none
: 2-pair? ( -- 0 | rank1 rank2 1 )
  0
  RankBounds do
    i RankCount @ 2 = if
      1+ i swap
    then
  loop
  dup 2 = if drop true exit then
  dup 1 = if 2drop false exit then
;

\ Return rank of cards if there is
\ a pair
: pair? ( -- 0|rank )
  2 n-of-a-kind? ;

\ Determine Score for contents
\ of Hand. 
: score-hand ( -- Score )
  count-hand
  flush? if
    all-scoring
    straight? ?dup if
      10 = if RoyalFlush exit then
      StraightFlush exit
    then
    Flush exit
  then

  4-of-a-kind? ?dup if
    scoring-rank 4OfAKind exit
  then

  3-of-a-kind? ?dup if
    pair? if
      drop all-scoring FullHouse exit
    then
    scoring-rank 3OfAKind exit
  then

  straight? if
    all-scoring Straight exit
  then

  2-pair? if
    scoring-rank scoring-rank
    2Pair exit
  then

  pair? ?dup if
    dup Jack >= if
      scoring-rank 1Pair exit
    then
    drop
  then

  Loss
;


