Go Fish/PicoLisp: Difference between revisions

From Rosetta Code
Content added Content deleted
(Bugfix)
m (Fixed syntax highlighting.)
 
(2 intermediate revisions by one other user not shown)
Line 1: Line 1:
<math>Insert formula here</math>{{collection|Go Fish}}
{{collection|Go Fish}}


<lang PicoLisp>(de *Ranks
<syntaxhighlight lang="picolisp">(de *Ranks
Ace 2 3 4 5 6 7 8 9 10 Jack Queen King )
Ace 2 3 4 5 6 7 8 9 10 Jack Queen King )

(de goFish ()
(de goFish ()
(let
(let
Line 18: Line 18:
(loop
(loop
(prin "Your Books: ")
(prin "Your Books: ")
(flush)
(println YourBooks)
(println YourBooks)
(prin "My Books: ")
(prin "My Books: ")
(flush)
(println MyBooks)
(println MyBooks)
(T (nor Your Mine Ocean)
(T (nor Your Mine Ocean)
Line 29: Line 31:
(T "I won!") ) ) ) )
(T "I won!") ) ) ) )
(prin "You have ")
(prin "You have ")
(println Your)
(flush)
(println (sort Your))
(prinl "I have " (length Mine) " cards")
(prinl "I have " (length Mine) " cards")
(loop
(loop
Line 36: Line 39:
"Ask for a rank, lay down a book, or 'draw' a card: "
"Ask for a rank, lay down a book, or 'draw' a card: "
"Ask for a rank or lay down a book: " ) )
"Ask for a rank or lay down a book: " ) )
(flush)
(T (member (setq Reply (read)) *Ranks)
(T (member (setq Reply (read)) *Ranks)
(ifn (filter = Mine (circ Reply))
(ifn (filter = Mine (circ Reply))
Line 42: Line 46:
(push 'YouHave Reply) )
(push 'YouHave Reply) )
(prin " I give you ")
(prin " I give you ")
(flush)
(println @)
(println @)
(setq
(setq
Line 54: Line 59:
((atom Reply)
((atom Reply)
(prin " The rank must be one of ")
(prin " The rank must be one of ")
(flush)
(println *Ranks) )
(println *Ranks) )
((and (cdddr Reply) (member (car Reply) *Ranks) (not (cdr (uniq Reply))) (= (length Your) (length (append (diff Your Reply) Reply))))
((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 ")
(prin " You lay down the book ")
(flush)
(println (push 'YourBooks Reply))
(println (push 'YourBooks Reply))
(setq
(setq
Line 76: Line 83:
(loop
(loop
(prin "Please give me all your " Request "s (or NIL): ")
(prin "Please give me all your " Request "s (or NIL): ")
(flush)
(NIL (setq Reply (read))
(NIL (setq Reply (read))
(push 'YouDont Request)
(push 'YouDont Request)
Line 95: Line 103:
(let B (need 4 @)
(let B (need 4 @)
(prin " I lay down the book ")
(prin " I lay down the book ")
(flush)
(println (push 'MyBooks B))
(println (push 'MyBooks B))
(setq Mine (diff Mine B)) ) )
(setq Mine (diff Mine B)) ) )
(prinl) ) ) )</lang>
(prinl) ) ) )</syntaxhighlight>

Latest revision as of 08:31, 31 August 2022

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