[lnkForumImage]
TotalShareware - Download Free Software

Confronta i prezzi di migliaia di prodotti.
Asp Forum
 Home | Login | Register | Search 


 

Forums >

comp.lang.lisp

A small dice game: Ship, Captain, Crew

Udyant Wig

9/27/2015 5:24:00 PM


Here is an implementation of the dice game /Ship, Captain, and Crew/[0]
in Common Lisp.


;;; scc.cl begins

;;; -*- mode: common-lisp; encoding: utf-8 -*-
(defpackage :scc
(:use :cl)
(:export :new-game
:hold-onto
:roll))
(in-package :scc)

;;; Utilities
(defun d6 ()
"Return an integer between 1 and 6."
(1+ (random 6)))

(defun drop-first (seq elt)
"Return a copy of SEQ after removing the first ELT."
(let ((elt-at (position elt seq)))
(append (subseq seq 0 elt-at)
(subseq seq (1+ elt-at)))))


;; Core
(defvar *ship-p* nil)
(defvar *captain-p* nil)
(defvar *crew-p* nil)
(defvar *scoring* nil)
(defvar *rolls* 3)
(defvar *score* 0)
(defvar *roll* ())
(defvar *held-onto* ())


(defun roll-fresh (n)
"Collect N six-sided dice."
(loop for i from 1 to n collecting (d6)))

(defun found-ship ()
"Return T when a ship was found, signaled by a 6."
(when (member 6 *roll*)
(and (not *ship-p*) (setf *ship-p* t))))

(defun found-captain ()
"Return T when a captain was found, signaled by a 5."
(when (member 5 *roll*)
(and *ship-p* (not *captain-p*) (setf *captain-p* t))))

(defun found-crew ()
"Return T when a crew was found, signaled by a 4."
(when (member 4 *roll*)
(and *ship-p* *captain-p* (not *crew-p*) (setf *crew-p* t))))

(defun start-scoring-p ()
"Return T when a ship, a captain, and a crew were all found. Begin keeping score."
(when (and *ship-p* *captain-p* *crew-p*)
(setf *scoring* t)))

(defun new-game ()
"Start a new game. Set variables to default values."
(setf *ship-p* nil
*captain-p* nil
*crew-p* nil
*scoring* nil
*rolls* 3
*score* 0
*roll* (roll-fresh 5)
*held-onto* ()))

(defun new-roll (n)
"Try producing a new roll of dice, unless the player cannot roll anymore."
(unless (zerop *rolls*)
(decf *rolls*)
(setf *roll* (roll-fresh n))))

(defun hold-onto (x)
"Keep aside the first die showing the number X."
(push x *held-onto*)
(setf *roll* (drop-first *roll* x)))

(defun roll-play ()
"Roll the dice, checking for ship, captain, or crew. Keep score on finding all three.
Show the state of play."
(format t "You rolled: ~a ~%" *roll*)
(and (found-ship) (setf *roll* (drop-first *roll* 6))
(format t "~%We have ourselves a ship!"))
(and (found-captain) (setf *roll* (drop-first *roll* 5))
(format t "~%Captain on the bridge!"))
(and (found-crew) (setf *roll* (drop-first *roll* 4))
(format t "~%All hands on deck!"))
(and (start-scoring-p) (setf *score* (apply #'+ (append *roll* *held-onto*))))
(format t "~%Current roll (post checking) : ~a ~%Rolls remaining: ~d ~%Current score: ~d ~%" *roll* *rolls* *score*))

(defun roll ()
"Throw a new roll of dice for the player."
(cond ((zerop *rolls*)
(write-string "You are done playing."))
(t
(new-roll (length *roll*))
(roll-play))))


;;; scc.cl ends


I would appreciate general comments regarding readability, better
expressions, idioms, etc. But any commentary in general would also be
highly valued.

I do not believe efficiency or raw performance is of much concern here.

A question: Is is bad form to not initialize *random-state*?

--
Udyant Wig

[0] https://en.wikipedia.org/wiki/Ship,_captain...
4 Answers

Pascal J. Bourguignon

9/27/2015 10:22:00 PM

0

Udyant Wig <udyantw@gmail.com> writes:

> Here is an implementation of the dice game /Ship, Captain, and Crew/[0]
> in Common Lisp.
> [â?¦]

> (defun drop-first (seq elt)
> "Return a copy of SEQ after removing the first ELT."
> (let ((elt-at (position elt seq)))
> (append (subseq seq 0 elt-at)
> (subseq seq (1+ elt-at)))))

remove :count 1 does the same.

> ;; Core
> (defvar *ship-p* nil)
> (defvar *captain-p* nil)
> (defvar *crew-p* nil)
> (defvar *scoring* nil)
> (defvar *rolls* 3)
> (defvar *score* 0)
> (defvar *roll* ())
> (defvar *held-onto* ())

DANG! With those global variables, I can't play two games at the same
time!

Instead:

;;; -*- mode: common-lisp; encoding: utf-8 -*-
(defpackage "SCC"
(:use "CL")
(:export "NEW-GAME" "HOLD-ONTO" "ROLL" "PLAY"))
(in-package "SCC")

;;; Utilities

(defun d6 ()
"Return an integer between 1 and 6."
(1+ (random 6)))

;;; The game

(defconstant +ship+ 6)
(defconstant +captain+ 5)
(defconstant +crew+ 4)

(defstruct scc-game
(ship-p nil)
(captain-p nil)
(crew-p nil)
(scoring nil)
(rolls 3)
(score 0)
(roll ())
(held-onto ()))

(defun roll-fresh (n)
"Collect N six-sided dice."
(loop for i from 1 to n collecting (d6)))

(defun found-ship (game)
"Return T when a ship was found, signaled by a 6."
(when (member +ship+ (scc-game-roll game))
(setf (scc-game-ship-p game) t)))

(defun found-captain (game)
"Return T when a captain was found, signaled by a 5."
(when (and (member +captain+ (scc-game-roll game))
(scc-game-ship-p game))
(setf (scc-game-captain-p game) t)))

(defun found-crew (game)
"Return T when a crew was found, signaled by a 4."
(when (and (member +crew+ (scc-game-roll game))
(scc-game-captain-p game))
(setf (scc-game-crew-p game) t)))

(defun start-scoring-p (game)
"Return T when a ship, a captain, and a crew were all found. Begin keeping score."
(when (scc-game-crew-p game)
(setf (scc-game-scoring game) t)))

(defun new-game ()
"Start a new game. Set variables to default values."
(make-scc-game :roll (roll-fresh 5)))

(defun new-roll (game n)
"Try producing a new roll of dice, unless the player cannot roll anymore."
(unless (zerop (scc-game-rolls game))
(decf (scc-game-rolls game))
(setf (scc-game-roll game) (roll-fresh n))))

(defun drop-first-in-roll (game x)
"Drops the first roll of the game."
(setf (scc-game-roll game) (remove x (scc-game-roll game) :count 1)))

(defun hold-onto (game x)
"Keep aside the first die showing the number X."
(push x (scc-game-held-onto game))
(drop-first-in-roll game x))

(defun roll-play (game)
"Roll the dice, checking for ship, captain, or crew. Keep score on finding all three.
Show the state of play."
(format t "You rolled: ~a ~%" (scc-game-roll game))
(when (found-ship game)
(drop-first-in-roll game +ship+)
(format t "~%We have ourselves a ship!"))
(when (found-captain game)
(drop-first-in-roll game +captain+)
(format t "~%Captain on the bridge!"))
(when (found-crew game)
(drop-first-in-roll game +crew+)
(format t "~%All hands on deck!"))
(when (start-scoring-p game)
(setf (scc-game-score game)
(apply #'+ (append (scc-game-roll game) (scc-game-held-onto game)))))
(format t "~%Current roll (post checking) : ~a ~%Rolls remaining: ~d ~%Current score: ~d ~%"
(scc-game-roll game)
(scc-game-rolls game)
(scc-game-score game)))


(defun play ()
(let ((game (new-game)))
(loop
:until (zerop (scc-game-rolls game))
:do (new-roll game (length (scc-game-roll game)))
(roll-play game)
(finish-output)
:finally (write-line "You are done playing.")
(finish-output))))

(defun multi-play (&rest names)
(let ((ngames (mapcar (lambda (name) (cons name (new-game))) names)))
(loop
:until (every (function zerop)
(mapcar (lambda (ngame)
(scc-game-rolls (cdr ngame)))
ngames))
:do (loop
:for (name . game) :in ngames
:unless (zerop (scc-game-rolls game))
:do (format t "~%~V@{-~}~%~*~A~0@*~%~V@{-~}~%" (length name) '() name)
(new-roll game (length (scc-game-roll game)))
(roll-play game)
(finish-output))
:finally (write-line "You are all done playing.")
(finish-output))))

;;; scc.cl ends
#|

cl-user> (scc:play)
You rolled: (3 2 4 3 4)

Current roll (post checking) : (3 2 4 3 4)
Rolls remaining: 2
Current score: 0
You rolled: (4 4 2 5 1)

Current roll (post checking) : (4 4 2 5 1)
Rolls remaining: 1
Current score: 0
You rolled: (6 3 3 3 4)

We have ourselves a ship!
Current roll (post checking) : (3 3 3 4)
Rolls remaining: 0
Current score: 0
You are done playing.
nil

;; And now, we can have several games at the same time:

cl-user> (scc:multi-play "Udyant" "Pascal")

------
Udyant
------
You rolled: (3 3 2 6 3)

We have ourselves a ship!
Current roll (post checking) : (3 3 2 3)
Rolls remaining: 2
Current score: 0

------
Pascal
------
You rolled: (2 3 1 2 5)

Current roll (post checking) : (2 3 1 2 5)
Rolls remaining: 2
Current score: 0

------
Udyant
------
You rolled: (2 1 6 5)

We have ourselves a ship!
Captain on the bridge!
Current roll (post checking) : (2 1)
Rolls remaining: 1
Current score: 0

------
Pascal
------
You rolled: (6 2 4 5 6)

We have ourselves a ship!
Captain on the bridge!
All hands on deck!
Current roll (post checking) : (2 6)
Rolls remaining: 1
Current score: 8

------
Udyant
------
You rolled: (5 2)

Captain on the bridge!
Current roll (post checking) : (2)
Rolls remaining: 0
Current score: 0

------
Pascal
------
You rolled: (6 2)

We have ourselves a ship!
Current roll (post checking) : (2)
Rolls remaining: 0
Current score: 2
You are all done playing.
nil
cl-user>
|#

> I would appreciate general comments regarding readability, better
> expressions, idioms, etc. But any commentary in general would also be
> highly valued.
>
> I do not believe efficiency or raw performance is of much concern here.
>
> A question: Is is bad form to not initialize *random-state*?

Is it a bad form to say "the sky is red"?
https://www.google.fr/search...
It's a question of semantics.
What PSEUDO random sequence do you want?

--
__Pascal Bourguignon__ http://www.informat...
â??The factory of the future will have only two employees, a man and a
dog. The man will be there to feed the dog. The dog will be there to
keep the man from touching the equipment.� -- Carl Bass CEO Autodesk

Kaz Kylheku

9/27/2015 11:16:00 PM

0

On 2015-09-27, Pascal J. Bourguignon <pjb@informatimago.com> wrote:
> Udyant Wig <udyantw@gmail.com> writes:
>
>> Here is an implementation of the dice game /Ship, Captain, and Crew/[0]
>> in Common Lisp.
>> [â?¦]
>
>> (defun drop-first (seq elt)
>> "Return a copy of SEQ after removing the first ELT."
>> (let ((elt-at (position elt seq)))
>> (append (subseq seq 0 elt-at)
>> (subseq seq (1+ elt-at)))))
>
> remove :count 1 does the same.
>
>> ;; Core
>> (defvar *ship-p* nil)
>> (defvar *captain-p* nil)
>> (defvar *crew-p* nil)
>> (defvar *scoring* nil)
>> (defvar *rolls* 3)
>> (defvar *score* 0)
>> (defvar *roll* ())
>> (defvar *held-onto* ())
>
> DANG! With those global variables, I can't play two games at the same
> time!

Surely, you jest!

(defmacro with-new-ship-captain-crew-game (&body forms)
`(let ((*ship-p* nil)
(*captain-p* nil)
(*crew-p* nil)
(*scoring* nil)
(*rolls* 3)
(*score* 0)
(*roll* ())
(*held-onto* ()))
,@body))

Pascal J. Bourguignon

9/28/2015 1:22:00 AM

0

Kaz Kylheku <kaz@kylheku.com> writes:

> Surely, you jest!
>
> (defmacro with-new-ship-captain-crew-game (&body forms)
> `(let ((*ship-p* nil)
> (*captain-p* nil)
> (*crew-p* nil)
> (*scoring* nil)
> (*rolls* 3)
> (*score* 0)
> (*roll* ())
> (*held-onto* ()))
> ,@body))

This macro doesn't reify the game.

--
__Pascal Bourguignon__ http://www.informat...
â??The factory of the future will have only two employees, a man and a
dog. The man will be there to feed the dog. The dog will be there to
keep the man from touching the equipment.� -- Carl Bass CEO Autodesk

William James

9/28/2015 7:09:00 AM

0

Udyant Wig wrote:

> Here is an implementation of the dice game /Ship, Captain, and Crew/[0]
> in Common Lisp.
>
>
> ;;; scc.cl begins
>
> ;;; -*- mode: common-lisp; encoding: utf-8 -*-
> (defpackage :scc
> (:use :cl)
> (:export :new-game
> :hold-onto
> :roll))
> (in-package :scc)
>
> ;;; Utilities
> (defun d6 ()
> "Return an integer between 1 and 6."
> (1+ (random 6)))
>
> (defun drop-first (seq elt)
> "Return a copy of SEQ after removing the first ELT."
> (let ((elt-at (position elt seq)))
> (append (subseq seq 0 elt-at)
> (subseq seq (1+ elt-at)))))
>
>
> ;; Core
> (defvar *ship-p* nil)
> (defvar *captain-p* nil)
> (defvar *crew-p* nil)
> (defvar *scoring* nil)
> (defvar *rolls* 3)
> (defvar *score* 0)
> (defvar *roll* ())
> (defvar *held-onto* ())
>
>
> (defun roll-fresh (n)
> "Collect N six-sided dice."
> (loop for i from 1 to n collecting (d6)))
>
> (defun found-ship ()
> "Return T when a ship was found, signaled by a 6."
> (when (member 6 *roll*)
> (and (not *ship-p*) (setf *ship-p* t))))
>
> (defun found-captain ()
> "Return T when a captain was found, signaled by a 5."
> (when (member 5 *roll*)
> (and *ship-p* (not *captain-p*) (setf *captain-p* t))))
>
> (defun found-crew ()
> "Return T when a crew was found, signaled by a 4."
> (when (member 4 *roll*)
> (and *ship-p* *captain-p* (not *crew-p*) (setf *crew-p* t))))
>
> (defun start-scoring-p ()
> "Return T when a ship, a captain, and a crew were all found. Begin keeping score."
> (when (and *ship-p* *captain-p* *crew-p*)
> (setf *scoring* t)))
>
> (defun new-game ()
> "Start a new game. Set variables to default values."
> (setf *ship-p* nil
> *captain-p* nil
> *crew-p* nil
> *scoring* nil
> *rolls* 3
> *score* 0
> *roll* (roll-fresh 5)
> *held-onto* ()))
>
> (defun new-roll (n)
> "Try producing a new roll of dice, unless the player cannot roll anymore."
> (unless (zerop *rolls*)
> (decf *rolls*)
> (setf *roll* (roll-fresh n))))
>
> (defun hold-onto (x)
> "Keep aside the first die showing the number X."
> (push x *held-onto*)
> (setf *roll* (drop-first *roll* x)))
>
> (defun roll-play ()
> "Roll the dice, checking for ship, captain, or crew. Keep score on finding all three.
> Show the state of play."
> (format t "You rolled: ~a ~%" *roll*)
> (and (found-ship) (setf *roll* (drop-first *roll* 6))
> (format t "~%We have ourselves a ship!"))
> (and (found-captain) (setf *roll* (drop-first *roll* 5))
> (format t "~%Captain on the bridge!"))
> (and (found-crew) (setf *roll* (drop-first *roll* 4))
> (format t "~%All hands on deck!"))
> (and (start-scoring-p) (setf *score* (apply #'+ (append *roll* *held-onto*))))
> (format t "~%Current roll (post checking) : ~a ~%Rolls remaining: ~d ~%Current score: ~d ~%" *roll* *rolls* *score*))
>
> (defun roll ()
> "Throw a new roll of dice for the player."
> (cond ((zerop *rolls*)
> (write-string "You are done playing."))
> (t
> (new-roll (length *roll*))
> (roll-play))))
>
>
> ;;; scc.cl ends


Gauche Scheme:

(use srfi-27 :only (random-integer))
(use gauche.generator :only (generator->list))

(define needed (list 6 5 4))
(define rolls-left 3)
(define score 0)
(define (new)
(set! rolls-left 3) (set! needed '(6 5 4)) (set! score 0))
(define (roll-n-dice n)
(sort (generator->list (cut + 1 (random-integer 6)) n) >))

(define (roll)
(unless (zero? rolls-left)
(unless (null? needed) (print "You need " needed))
(let1 dice (roll-n-dice (+ 2 (length needed)))
(print "You rolled " dice)
(set! dice
(remove
(lambda (die)
(and (eq? die (ref needed 0 #f))
(print "You rolled a " (pop! needed) "!")))
dice))
(print "Dice left: " dice)
(when (= 2 (length dice)) (set! score (apply + dice)))
(print "Score: " score))
(dec! rolls-left)
(print "Rolls left: " rolls-left)))



gosh> (new)
0
gosh> (roll)
You need (6 5 4)
You rolled (6 3 2 2 1)
You rolled a 6!
Dice left: (3 2 2 1)
Score: 0
Rolls left: 2
#<undef>
gosh> (roll)
You need (5 4)
You rolled (6 6 2 2)
Dice left: (6 6 2 2)
Score: 0
Rolls left: 1
#<undef>
gosh> (roll)
You need (5 4)
You rolled (6 5 4 3)
You rolled a 5!
You rolled a 4!
Dice left: (6 3)
Score: 9
Rolls left: 0


gosh> (new)
0
gosh> (roll)
You need (6 5 4)
You rolled (6 5 5 3 1)
You rolled a 6!
You rolled a 5!
Dice left: (5 3 1)
Score: 0
Rolls left: 2
#<undef>
gosh> (roll)
You need (4)
You rolled (4 4 4)
You rolled a 4!
Dice left: (4 4)
Score: 8
Rolls left: 1
#<undef>
gosh> (roll)
You rolled (6 5)
Dice left: (6 5)
Score: 11
Rolls left: 0

--
You have politicians saying that ... as many Africans as want to come into
Sweden should be able to come.... I think there's a billion Africans now.
They've already said that everybody from Syria can come to Sweden because they
have a civil war there.... They have a huge housing crisis; they are actually
thinking of commandeering people's vacation homes because they need more housing
for immigrants. --- Kevin MacDonald (http://lnrlive.com/tpc/tpc201...)