|
- :: 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)
- --
|