Hoon101/201/week1/poker.hoon

:: Hoon 201 - Week 1
:: ~bannum-magtus || s@p7.co.nz
::
:: im very sorry i messed up all my faces and i also dont know
:: how to make gates that make gates so this is messy code :(
:: dont leave your assignments until the last minute kids.
::
/+  playing-cards
:-  %say
|=  [[* eny=@uv *] *]
:-  %noun
=<
%-  rank-hands
%-  score-hands
%-  sort-hands
%-  draw-hands
[%pregame 4]
!:
|%
+$  title
  $%  %royal-flush
      %straight-flush
      %four-of-a-kind
      %full-house
      %flush
      %straight
      %three-of-a-kind
      %two-pair
      %pair
      %high-card
  ==
+$  card  darc:playing-cards
+$  suit  suit:playing-cards
+$  deck  deck:playing-cards
+$  grouped  (list (list card))
+$  unsorted  (list card)
+$  sorted  (list card)
+$  hands  [g=grouped s=sorted u=unsorted]
+$  tiebreaker  (list [v=@ s=@])
+$  draw-phase-state  [h=(list unsorted) d=deck]
+$  sort-phase-state  [h=(list hands) d=deck]
+$  score-phase-state  [s=(list [r=@ t=title h=hands b=tiebreaker]) d=deck]
+$  rank-phase-state  (list [r=@ t=title h=unsorted])
++  rank-hands
  |=  [%score st=score-phase-state]
  ^-  [%ranking rank-phase-state]
  =.  s.st  (sort s.st rank-sort)
  [%ranking (flop (rank-display s.st))]
++  rank-display
  |=  i=(list [* t=title h=hands *])
  ^-  (list [r=@ t=title h=unsorted])
  =/  c=@  1
  =|  l=(list [r=@ t=title h=unsorted])
  |-
  ?~  i  l
  =/  s  [c t.i.i u.h.i.i]
  %=  $
    c  .+(c)
    l  :-(s l)
    i  t.i
  ==
++  rank-sort
  |=  [a=[r=@ * * b=tiebreaker] b=[r=@ * * b=tiebreaker]]
  ^-  ?
  ?.  =(r.a r.b)
    (gth r.a r.b)
  (tb-comp b.a b.b)
++  tb-comp
  |=  [a=tiebreaker b=tiebreaker]
  ^-  ?
  ?.  =((lent a) (lent b))
    !!
  |-
  ?~  a  %.y
  ?~  b  %.n
  ?.  =(v.i.a v.i.b)
    (gth v.i.a v.i.b)
  $(a t.a, b t.b)
++  draw-hands
  |=  [%pregame n=@]
  =/  d=deck  init-deck
  =|  h=(list unsorted)
  ^-  [%draw draw-phase-state]
  |-
  ?~  n  [%draw [h d]]
  =/  i  (draw:playing-cards 5 d)
  $(h :-(hand.i h), d rest.i, n (dec n))
++  sort-hands
  |=  [%draw st=draw-phase-state]
  ^-  [%sort sort-phase-state]
  [%sort [(turn h.st zip-sorted) d.st]]
++  card-sort
  |=  [a=card b=card]
  ^-  ?
  (gth val.a val.b)
++  sort-hand
  |=  u=unsorted
  ^-  sorted
  (sort u card-sort)
++  tuples
  |=  h=sorted
  ^-  grouped
  =|  c=(list card)
  =|  l=(list (list card))
  |-
  ?~  h  :-(c l)
  ?~  c
    %=  $
        c  [i.h ~]
        h  t.h
    ==
  ?:  =(val.i.c val.i.h)
    %=  $
        c  :-(i.h c)
        h  t.h
    ==
  %=  $
      c  ~
      l  :-(c l)
  ==
++  zip-sorted
  |=  u=unsorted
  ^-  hands
  =/  sh  (sort-hand u)
  =/  gh  (tuples sh)
  [gh sh u]
++  score-hands
  |=  [%sort st=sort-phase-state]
  ^-  [%score score-phase-state]
  [%score (turn h.st con-tb) d.st]
++  init-deck
  (shuffle-deck:playing-cards make-deck:playing-cards eny)
++  suit-to-num
  |=  c=darc:playing-cards
  ^-  @
  ?-  sut.c
    %spades  4
    %hearts  3
    %diamonds  2
    %clubs  1
  ==
++  get-title
  |=  h=hands
  ^-  [t=title r=@]
    ?:  (is-royal-flush h)      [%royal-flush 9]
    ?:  (is-straight-flush h)   [%straight-flush 8]
    ?:  (is-four-of-a-kind h)   [%four-of-a-kind 7]
    ?:  (is-full-house h)       [%full-house 6]
    ?:  (is-flush h)            [%flush 5]
    ?:  (is-straight h)         [%straight 4]
    ?:  (is-three-of-a-kind h)  [%three-of-a-kind 3]
    ?:  (is-two-pair h)         [%two-pair 2]
    ?:  (is-pair h)             [%pair 1]
                                [%high-card 0]
++  is-flush
  |=  [* h=sorted *]
  ^-  ?
  =|  s=?(~ suit)
  |-
  ?~  h  %.y
  ?~  s
    $(h t.h, s sut.i.h)
  ?.  =(s sut.i.h)
    %.n
  $(h t.h)
++  is-straight
  |=  [* h=sorted *]
  ^-  ?
  =|  l=?(~ @)
  |-
  ?~  h  %.y
  ?~  l
    $(h t.h, l val.i.h)
  ?.  =(.+(l) val.i.h)
    %.n
  $(l val.i.h, h t.h)
++  high-card
  |=  [* h=sorted *]
  ^-  card
  ?~  h  !!
  i.h
++  is-royal-flush
  |=  i=[* h=sorted *]
  ^-  ?
  ?&  (is-straight-flush i)
      =(13 val:(high-card i))
  ==
++  is-straight-flush
  |=  i=[* h=sorted *]
  ^-  ?
  ?&  (is-straight i)
      (is-flush i)
  ==
++  one-of
  |=  [n=@ [g=grouped * *]]
  ^-  @
  =|  t=@
  |-
  ?~  g  t
  ?:  =(n (lent i.g))
    $(g t.g, t .+(t))
  $(g t.g)
++  is-four-of-a-kind
  |=  i=[g=grouped * *]
  ^-  ?
  =(1 (one-of 4 i))
++  is-full-house
  |=  i=[g=grouped * *]
  ^-  ?
  ?&  =(1 (one-of 3 i))
      =(1 (one-of 2 i))
  ==
++  is-three-of-a-kind
  |=  i=[g=grouped * *]
  ^-  ?
  =(1 (one-of 3 i))
++  is-two-pair
  |=  i=[g=grouped * *]
  ^-  ?
  =(2 (one-of 2 i))
++  is-pair
  |=  i=[g=grouped * *]
  ^-  ?
  =(1 (one-of 2 i))
++  con-tb
  |=  fh=hands
  =/  o=[t=title r=@]  (get-title fh)
  [r.o t.o fh (get-tiebreaker fh)]
++  get-tiebreaker
  |=  [g=grouped * *]
  ^-  tiebreaker
  =.  g  (sort g tuple-sort)
  (turn g tuple-tb)
++  tuple-tb
  |=  l=(list card)
  ^-  [v=@ s=@]
  =|  sv=@
  =|  vv=@
  |-
  ?~  l  [vv sv]
  =.  vv  val.i.l
  ?.  (gth (suit-to-num i.l) sv)
    $(l t.l)
  $(l t.l, sv (suit-to-num i.l))
++  tuple-sort
  |=  [a=(list card) b=(list card)]
  ^-  ?
  =/  la  (lent a)
  =/  lb  (lent b)
  ?.  =(la lb)
    (gth la lb)
  ?~  a  !!
  ?~  b  !!
  ?:  =(val.i.a val.i.b)
    (gth (suit-to-num i.a) (suit-to-num i.b))
  (gth val.i.a val.i.b)
--