Go Fish/PicoLisp

From Rosetta Code
Go Fish/PicoLisp is part of Go Fish. You may find other members of Go Fish at Category:Go Fish.
(de *Ranks
Ace 2 3 4 5 6 7 8 9 10 Jack Queen King )
 
(de goFish ()
(let
(Ocean (by '(NIL (rand)) sort (mapcan '((R) (need 4 R)) *Ranks))
Your (cut 9 'Ocean)
Mine (cut 9 'Ocean)
YouHave NIL
YouDont NIL
YourBooks NIL
MyBooks NIL
Reply NIL
Options NIL
Request NIL )
(loop
(prin "Your Books: ")
(flush)
(println YourBooks)
(prin "My Books: ")
(flush)
(println MyBooks)
(T (nor Your Mine Ocean)
(let (Y (length YourBooks) M (length MyBooks))
(prinl
(cond
((= Y M) "Tie game")
((> Y M) "You won!")
(T "I won!") ) ) ) )
(prin "You have ")
(flush)
(println (sort Your))
(prinl "I have " (length Mine) " cards")
(loop
(prin
(if Ocean
"Ask for a rank, lay down a book, or 'draw' a card: "
"Ask for a rank or lay down a book: " ) )
(flush)
(T (member (setq Reply (read)) *Ranks)
(ifn (filter = Mine (circ Reply))
(prinl
" I don't have any card of rank "
(push 'YouHave Reply) )
(prin " I give you ")
(flush)
(println @)
(setq
Mine (diff Mine @)
Your (append @ Your)
YouHave (append @ YouHave)
YouDont (diff YouDont @) ) ) )
(T (and Ocean (== 'draw Reply))
(prinl " You draw a " (push 'Your (pop 'Ocean)))
(off YouDont) )
(cond
((atom Reply)
(prin " The rank must be one of ")
(flush)
(println *Ranks) )
((and (cdddr Reply) (member (car Reply) *Ranks) (not (cdr (uniq Reply))) (= (length Your) (length (append (diff Your Reply) Reply))))
(prin " You lay down the book ")
(flush)
(println (push 'YourBooks Reply))
(setq
Your (diff Your Reply)
YouHave (diff YouHave Reply) ) )
(T (prinl " A book consists of four ranks, e.g. (7 7 7 7)")) ) )
(cond
((setq Options (diff (rot Mine) YouDont))
(setq Request
(car
(or
(sect
(filter
'((Opt) (= 3 (cnt = Mine (circ Opt))))
Options )
YouHave )
(sect Options YouHave)
Options ) ) )
(loop
(prin "Please give me all your " Request "s (or NIL): ")
(flush)
(NIL (setq Reply (read))
(push 'YouDont Request)
(ifn Ocean
(prinl " I pass")
(prinl " I draw a card")
(push 'Mine (pop 'Ocean)) ) )
(T (and (pair Reply) (member Request Reply) (not (cdr (uniq Reply))) (= (length Your) (length (append (diff Your Reply) Reply))))
(setq
Your (diff Your Reply)
YouHave (diff YouHave Reply)
Mine (append Reply Mine) ) )
(prinl " I expect a list of " Request "s") ) )
(Ocean
(prinl " I draw a card")
(push 'Mine (pop 'Ocean)) )
(T (prinl " I pass")) )
(while (find '((R) (= 4 (cnt = Mine (circ R)))) *Ranks)
(let B (need 4 @)
(prin " I lay down the book ")
(flush)
(println (push 'MyBooks B))
(setq Mine (diff Mine B)) ) )
(prinl) ) ) )