pre { line-height: 125%; }
td.linenos .normal { color: inherit; background-color: transparent; padding-left: 5px; padding-right: 5px; }
span.linenos { color: inherit; background-color: transparent; padding-left: 5px; padding-right: 5px; }
td.linenos .special { color: #000000; background-color: #ffffc0; padding-left: 5px; padding-right: 5px; }
span.linenos.special { color: #000000; background-color: #ffffc0; padding-left: 5px; padding-right: 5px; }
.highlight .hll { background-color: #ffffcc }
.highlight .c { color: #888888 } /* Comment */
.highlight .err { color: #a61717; background-color: #e3d2d2 } /* Error */
.highlight .k { color: #008800; font-weight: bold } /* Keyword */
.highlight .ch { color: #888888 } /* Comment.Hashbang */
.highlight .cm { color: #888888 } /* Comment.Multiline */
.highlight .cp { color: #cc0000; font-weight: bold } /* Comment.Preproc */
.highlight .cpf { color: #888888 } /* Comment.PreprocFile */
.highlight .c1 { color: #888888 } /* Comment.Single */
.highlight .cs { color: #cc0000; font-weight: bold; background-color: #fff0f0 } /* Comment.Special */
.highlight .gd { color: #000000; background-color: #ffdddd } /* Generic.Deleted */
.highlight .ge { font-style: italic } /* Generic.Emph */
.highlight .ges { font-weight: bold; font-style: italic } /* Generic.EmphStrong */
.highlight .gr { color: #aa0000 } /* Generic.Error */
.highlight .gh { color: #333333 } /* Generic.Heading */
.highlight .gi { color: #000000; background-color: #ddffdd } /* Generic.Inserted */
.highlight .go { color: #888888 } /* Generic.Output */
.highlight .gp { color: #555555 } /* Generic.Prompt */
.highlight .gs { font-weight: bold } /* Generic.Strong */
.highlight .gu { color: #666666 } /* Generic.Subheading */
.highlight .gt { color: #aa0000 } /* Generic.Traceback */
.highlight .kc { color: #008800; font-weight: bold } /* Keyword.Constant */
.highlight .kd { color: #008800; font-weight: bold } /* Keyword.Declaration */
.highlight .kn { color: #008800; font-weight: bold } /* Keyword.Namespace */
.highlight .kp { color: #008800 } /* Keyword.Pseudo */
.highlight .kr { color: #008800; font-weight: bold } /* Keyword.Reserved */
.highlight .kt { color: #888888; font-weight: bold } /* Keyword.Type */
.highlight .m { color: #0000DD; font-weight: bold } /* Literal.Number */
.highlight .s { color: #dd2200; background-color: #fff0f0 } /* Literal.String */
.highlight .na { color: #336699 } /* Name.Attribute */
.highlight .nb { color: #003388 } /* Name.Builtin */
.highlight .nc { color: #bb0066; font-weight: bold } /* Name.Class */
.highlight .no { color: #003366; font-weight: bold } /* Name.Constant */
.highlight .nd { color: #555555 } /* Name.Decorator */
.highlight .ne { color: #bb0066; font-weight: bold } /* Name.Exception */
.highlight .nf { color: #0066bb; font-weight: bold } /* Name.Function */
.highlight .nl { color: #336699; font-style: italic } /* Name.Label */
.highlight .nn { color: #bb0066; font-weight: bold } /* Name.Namespace */
.highlight .py { color: #336699; font-weight: bold } /* Name.Property */
.highlight .nt { color: #bb0066; font-weight: bold } /* Name.Tag */
.highlight .nv { color: #336699 } /* Name.Variable */
.highlight .ow { color: #008800 } /* Operator.Word */
.highlight .w { color: #bbbbbb } /* Text.Whitespace */
.highlight .mb { color: #0000DD; font-weight: bold } /* Literal.Number.Bin */
.highlight .mf { color: #0000DD; font-weight: bold } /* Literal.Number.Float */
.highlight .mh { color: #0000DD; font-weight: bold } /* Literal.Number.Hex */
.highlight .mi { color: #0000DD; font-weight: bold } /* Literal.Number.Integer */
.highlight .mo { color: #0000DD; font-weight: bold } /* Literal.Number.Oct */
.highlight .sa { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Affix */
.highlight .sb { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Backtick */
.highlight .sc { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Char */
.highlight .dl { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Delimiter */
.highlight .sd { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Doc */
.highlight .s2 { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Double */
.highlight .se { color: #0044dd; background-color: #fff0f0 } /* Literal.String.Escape */
.highlight .sh { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Heredoc */
.highlight .si { color: #3333bb; background-color: #fff0f0 } /* Literal.String.Interpol */
.highlight .sx { color: #22bb22; background-color: #f0fff0 } /* Literal.String.Other */
.highlight .sr { color: #008800; background-color: #fff0ff } /* Literal.String.Regex */
.highlight .s1 { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Single */
.highlight .ss { color: #aa6600; background-color: #fff0f0 } /* Literal.String.Symbol */
.highlight .bp { color: #003388 } /* Name.Builtin.Pseudo */
.highlight .fm { color: #0066bb; font-weight: bold } /* Name.Function.Magic */
.highlight .vc { color: #336699 } /* Name.Variable.Class */
.highlight .vg { color: #dd7700 } /* Name.Variable.Global */
.highlight .vi { color: #3333bb } /* Name.Variable.Instance */
.highlight .vm { color: #336699 } /* Name.Variable.Magic */
.highlight .il { color: #0000DD; font-weight: bold } /* Literal.Number.Integer.Long */
#!/usr/bin/env zsh
# Make building various versions of the Crenshaw compiler even more convenient.

gen crenshaw$1

<HTML>
<HEAD>
<TITLE>Computer Science Logo Style vol 2 ch 4: Example: Solitaire</TITLE>
</HEAD>
<BODY>
<CITE>Computer Science Logo Style</CITE> volume 2:
<CITE>Advanced Techniques</CITE> 2/e Copyright (C) 1997 MIT
<H1>Example: Solitaire</H1>

<TABLE width="100%"><TR><TD>
<IMG SRC="../csls2.jpg" ALT="cover photo">
<TD><TABLE>
<TR><TD align="right"><CITE><A HREF="http://www.cs.berkeley.edu/~bh/">Brian
Harvey</A><BR>University of California, Berkeley</CITE>
<TR><TD align="right"><BR>
<TR><TD align="right"><A HREF="../pdf/v2ch04.pdf">Download PDF version</A>
<TR><TD align="right"><A HREF="../v2-toc2.html">Back to Table of Contents</A>
<TR><TD align="right"><A HREF="https://people.eecs.berkeley.edu/~bh/v2ch3/v2ch3.html"><STRONG>BACK</STRONG></A>
chapter thread <A HREF="../v2ch5/v2ch5.html"><STRONG>NEXT</STRONG></A>
<TR><TD align="right"><A HREF="https://mitpress.mit.edu/books/computer-science-logo-style-second-edition-volume-2">MIT
Press web page for <CITE>Computer Science Logo Style</CITE></A>
</TABLE></TABLE>

<HR>

<P>Program file for this chapter: <A HREF="solitaire.lg"><CODE>solitaire</CODE></A>

<P>
This program deals out a hand of solitaire and maintains a picture of
the card layout as you play the game by entering commands to move cards.  It
doesn't try to provide help with strategy, but it does know the rules for
legal moves.

<P>
This chapter follows Chapter 3 because the solitaire program uses
<CODE>catch</CODE> and <CODE>throw</CODE> for three kinds of nonlocal exit.
The program is an infinite loop that plays games repeatedly, so there is an
exit command that is implemented as a <CODE>throw</CODE>.  Each game is
itself an infinite loop, processing user commands repeatedly until either
the game is won or the user asks to start a new game.  The command to start
a new game is also implemented as a <CODE>throw</CODE>.  Finally, if the
program detects an error in a user command, such as asking to move a card
that isn't playable, the program rings a bell and <CODE>throw</CODE>s back
to the command-reading loop.

<PRE>
to solitaire
<EM>...initialization...</EM>
catch "exit [forever [onegame]]
end

to onegame
<EM>...initialization...</EM>
catch "endgame [forever [catch "bell [parsecmd]]]
end
</PRE>

<H2>The User Interface</H2>

<P>
But what I actually find most interesting about this program is the way
in which it interacts with the user.  By now, most people have seen
computer solitaire programs in which the cards are drawn graphically on
the screen, and the user moves cards by dragging with a mouse.  (A program
of that kind is included with Microsoft Windows, and versions are also
available for most other computer systems.)  The advantage of the mouse
interface is that it's very easy to learn.  Once you've seen how dragging
an object with the mouse works in a painting program or a word processor,
it's immediately obvious how to drag cards in the solitaire program, without
reading an instruction manual.

<P>
This Logo solitaire program doesn't use a mouse.  Instead, you move cards
with keyboard commands.  Most of the time it takes a single keystroke to
tell the program which card to move, and where to move it.  The trouble
is that you have to learn the command keys!  Given the choice, I think that
most people would rather start playing right away with a mouse-driven
program than take the time to learn to use mine.  But I actually find
the Logo program <EM>easier</EM> to use.  Typing a single key is faster
and easier on the wrist than moving the mouse to where the card is,
holding down the mouse button, moving the mouse to where you want to put
the card, and then releasing the button.

<P>
There's no question that mouse-based graphical user interfaces
have vastly increased the acceptance and use of computers by people who
are not technical experts.  And I was happy to have a mouse-based drawing
program to produce many of the illustrations in these books!  But I did
the word processing with a keyboard-controlled text editor; I find it
easier to use and more flexible than the mouse-based word processors.
Maybe it's just incipient old age, but I'm still a holdout against the
idea that <EM>everything</EM> is better done with a mouse.

<P>
Play several games using this program, and several using a mouse-based
solitaire program, and see what you think.

<H2>The Game of Solitaire</H2>

<P>
Here is a picture of a solitaire game in progress.


<P><CENTER><IMG SRC="cards.gif" ALT="<P>figure: cards"></CENTER>

<P>
In the center of the picture are seven <EM>stacks</EM> of cards.
Each stack may include some <EM>hidden</EM> cards and some <EM>shown</EM>
cards.  The hidden cards, if any, are beneath the shown cards.  If there are
any cards at all in a stack, at least one must be shown.  Cards that are not
part of this layout are held in the <EM>hand</EM> and dealt from the hand
onto the <EM>pile</EM>; the cards in the hand are hidden, while the top card
of the pile is visible.  At the top of the picture are four more piles of
cards, one for each suit; I'll call these piles &quot;the <EM>top</EM>&quot; so that
I can reserve the name <EM>pile</EM> for the one at the bottom.

<P>
Here is how the same layout would be represented by the program:


<P><CENTER><IMG SRC="https://people.eecs.berkeley.edu/~bh/v2ch4/solitaire.gif" ALT="<P>figure: solitaire"></CENTER>

<P>
Shown cards are represented on the screen by the rank and suit of
the card.  Several cards may be shown in each stack, while only one card is
shown in the pile, and one of each suit in the top.  Each stack has a dash
at the top of its display if there are any hidden cards in that stack; the
hand is represented by the number of cards in it.

<P>
In playing solitaire it's important to distinguish black cards from red
cards, so the program does its best to present the color information to
you.  The facilities for color display vary tremendously between computer
models, both in what capabilities are available and in the means by which
a program can use them.  Berkeley Logo sacrifices versatility for
uniformity; there is a <CODE>standout</CODE> primitive operation that can
be used to print text in &quot;reverse video,&quot; whichever of black-on-white
and white-on-black isn't the usual presentation.


<P><CENTER><IMG SRC="standout.gif" ALT="<P>figure: standout"></CENTER>

<P>
The <CODE>solitaire</CODE> program displays red cards in normal text
and black cards in reverse video.  The DOS version normally displays white
text on a black background, while the Macintosh version normally displays
black text on a white background, so the effect looks different on each
kind of computer.

<P>
There are many variations in the rules of solitaire, so I should describe
in detail the version this program knows.  In the initial layout, there are
seven stacks.  The first stack (on the left) has one shown card.  The second
has one shown and one hidden.  The third has one shown and two hidden.  Each
stack has one more hidden card than the one before it, so the seventh stack,
at the right, has one shown card and six hidden cards.  There are 28 cards
altogether on the board; the remaining 24 cards are in the hand.

<P>
Here are the legal moves:

<OL>
<LI>Three cards at a time may be dealt from the hand to the pile.  The
cards are turned face up, so that the last one dealt is shown.  If there are
fewer than three cards in the hand, however many cards are left may be dealt
in this way.  If there are no cards in the hand at all, the entire pile may
be picked up and turned upside down, so that they return to the hand in the
same order they were in at the beginning.

<LI>The top card of the pile, or the topmost card of any stack, may be
moved to the top if (a) it is an ace, <EM>or</EM> (b) the card of the same
suit and the immediately preceding rank is visible at the top.  For example,
the four of clubs can be played onto the three of clubs at the top.

<LI>The top card of the pile, or any shown card in any stack, may be
moved onto a stack if the topmost card of that stack is (a) of the opposite
color, <EM>and</EM> (b) of the immediately following rank as the card you are
moving.  For example, the four of clubs can be played onto the five of
hearts or the five of diamonds on a stack.

<LI> When a card is moved onto a stack, it is placed so that it does not
completely cover any other shown cards on that stack.  Any such shown cards
remain shown.

<LI>When moving a shown card from a stack, any other cards that are
above it (partly covering it, because they were moved onto it earlier) must
be moved along with it.

<LI>When all shown cards are removed from a stack, the topmost hidden
card is turned over so that it becomes a shown card.  If there are no hidden
cards in that stack, the stack becomes empty.  (At the beginning of the
game, there are no empty stacks.)

<LI>Any king that is the top card of the pile, or a shown card in any
stack, may be moved onto an empty stack.

<LI>The game is won if all cards are moved to the top.  The game is
lost if there are no legal moves and not all cards are moved to the top.
</OL>

<P>
I've expressed these rules in more formal language than would usually be
used.  Card players have shorthand ways of speaking, like &quot;play up in the
same suit at the top&quot; or &quot;play down in the opposite color on the stacks.&quot;
I wanted to be very precise in stating the rules because each part of a rule
must be reflected in the computer program.  Even so, I've left out some
details.  For example, my list of rules talks about concepts like &quot;suit&quot; and
&quot;rank&quot; without defining them.  I haven't specified the rank order, namely
ace-low.  (That is, ace comes before two, not after king.)  What other
details, if any, have I forgotten?

<H2>Running the Program</H2>

<P>
To use the program, invoke the command <CODE>solitaire</CODE> with no inputs.
(Being as I am a lazy typist, I've also defined an abbreviation <CODE>s</CODE>
for this command.)  The program prints an initial screenful of instructions,
and then repeatedly deals solitaire hands until you give the exit command.
Here are the instructions:

<PRE>
Welcome to solitaire

Here are the commands you can type:
    <U>+ =</U>  Deal three cards onto pile
    <U>P</U>    Play top card from pile
    <U>R</U>    Redisplay the board
    <U>?</U>    Retype these instructions
    <U>card</U> Play that card
    <U>M</U>    Move same card again
    <U>W</U>    Play up as much as possible (Win)
    <U>G</U>    Give up (start a new game)
    <U>X</U>    Exit to Logo

A card consists of a rank:
   <U>A 2 3 4 5 6 7 8 9 10 J Q K</U>  or <U>T</U> for 10
followed by a suit:
   <U>H S D C</U>
or followed by <U>.</U> to play all possible suits up

If you make a mistake, hit delete or backspace.

To move an entire stack,
   hit the shifted stack number:
     <U>! @ # $ % ^ &</U> for stacks
     1 2 3 4 5 6 7
</PRE>

<P>
My goal in designing the &quot;human interface&quot; for this program was that most
moves should require typing only a single character.  My idea is that the
most common moves are to play a card from the pile and to move an entire
stack (that is, the entire shown part of a stack) at once.  There are
one-character commands for all these.  If you want to move only part of a
stack, then you must type the name of the card, in the form <CODE>8S</CODE>
for the eight of spades.

<P>
As it turns out, in this case what's easy for the user is also easiest for
the program.  When you refer to a card by its position, it's easy for the
program to look up which card you mean.  For example, when you say
<CODE>P</CODE> to play the top card from the pile, it's easy for the program
to find out what card that is.  But when you specify a card by typing its
rank and suit, it's harder for the program to know <EM>where</EM> that card
is.  The program must check the pile and all the stacks to see if your card
is a member of each one.  So the program runs faster if you use the
single-keystroke commands.

<P>
The instructions don't say how to let the program know where you want to
move the chosen card <EM>onto.</EM> The reason is that in most cases there is
only one possible place, and the program finds that place itself.  (This is
the most complicated part of the program.)  Sometimes the chosen card can be
moved to two different places.  If so, the program picks a stack to move the
card onto, and if you don't like the program's choice, you can type
<CODE>M</CODE> to move the same card again until it ends up where you wanted
it.

<P>
The program makes no effort to help you with strategic decisions. For
example, some people like to play cards to the top as soon as possible,
while other people prefer to keep cards visible on the stacks as long as
possible.  Such choices are up to you.  Also, the program does not detect
losing the game.  (Detecting winning is easy--all four tops have kings
showing--but you haven't lost the game until no further moves are possible,
which is harder for the program to figure out.)  When you decide the game is
over, you just type <CODE>G</CODE> to start another game.

<H2>Program Structure</H2>

<P>
There are about 60 procedures in this program.  These procedures can be
roughly divided into several purposes:

<UL>
<LI>initialization
<LI>reading and interpreting keyboard commands
<LI>finding the chosen card in the layout
<LI>finding where the chosen card can move
<LI>moving the card
<LI>displaying the card layout
<LI>miscellaneous user commands
<LI>data abstraction
</UL>

<P>
In the procedures that move cards, the most interesting part of
the program, a few important variables are used to communicate what moves
should be made:

<DL>
<DT><CODE>card</CODE><DD>The card that the user asked to move.
<DT><CODE>cards</CODE><DD>All the cards that must be moved.  (There may be more
than one if the requested card is in the middle of a stack.)
<DT><CODE>where</CODE><DD>The location (before moving) of the chosen card.
<DT><CODE>onto</CODE><DD>A list of all possible locations to which the card
can be moved.
</DL>

<P>
As we'll see later in more detail, the card locations in <CODE>:where</CODE>
and <CODE>:onto</CODE> are represented in the form of Logo instructions that
can be <CODE>run</CODE> to perform the desired move.

<P>
The overall program structure is two nested loops.  The top-level procedure
<A HREF="solitaire.html#solitaire"><CODE>solitaire</CODE></A>
repeatedly invokes <CODE>onegame</CODE>.  As its name
suggests, each invocation of <A HREF="solitaire.html#onegame"><CODE>onegame</CODE></A>
plays one solitaire game.
It shuffles and deals the cards, then repeatedly invokes
<A HREF="solitaire.html#parsecmd"><CODE>parsecmd</CODE></A>,
which reads a character from the keyboard and chooses
the appropriate procedure to carry out the user's command.

<P>
(Most user commands require only one character.  The situation is a little
more complicated if the user types the name of a card, such as
<CODE>10H</CODE> for the ten of hearts, as a command.  <CODE>Parsecmd</CODE>
actually treats this as three separate commands.  The <CODE>1</CODE> and the
<CODE>0</CODE> merely record the card's rank in a variable named
<CODE>digit</CODE>.  When <CODE>parsecmd</CODE> sees the letter
<CODE>H</CODE>, which selects the card's suit, it invokes
<CODE>play.by.name</CODE>, which combines the remembered rank with the
just-typed suit to determine the desired card.)

<H2>Initialization</H2>

<P>
Both <CODE>solitaire</CODE> and <CODE>onegame</CODE> include initialization
instructions.  That's because some actions are only required once, such as
computing the 52 names of cards in the deck, while others are required for
each game, such as shuffling those cards.

<P>
Many initialization actions use the Berkeley Logo primitive command
<CODE>localmake</CODE>, which is an abbreviation for a <CODE>local</CODE>
command followed by a <CODE>make</CODE> command.  The program uses no global
variables, although the variables that are local to these top-level
procedures are available to any procedure within the solitaire program.

<P>
For most purposes, the most convenient representation of the deck of cards
is as a list.  That's because what the program most often does with the deck
is to deal a card from it to somewhere else.  If the deck is represented as
a list in the variable <CODE>hand</CODE>, then dealing a card is roughly
equivalent to these instructions:

<PRE>
do.something.with first :hand
make "hand butfirst :hand
</PRE>

<P>
A list is convenient because <CODE>butfirst</CODE> can be used to remove a
card from the deck.  It turns out, however, that <EM>shuffling</EM> the deck
is easiest if it's represented as an array.  That's because the technique
used to shuffle the deck is to exchange pairs of cards repeatedly.  In the
first step, we swap the 52nd card of the deck with a randomly chosen card
(perhaps itself).  The newly chosen last card is now exempt from further
exchanges.  In the second step, the 51st card of the deck is swapped with
some card in the remainder of the deck, and so on, for 51 steps.  The
<CODE>setitem</CODE> primitive makes it easy to change the value of a member
partway through an array.  If the deck were represented as a list, each
exchange would require making a (slightly changed) copy of the entire list.

<P>
The solution to this problem is that both representations, list and array,
are used in the program.  The <CODE>solitaire</CODE> procedure creates an
array containing the 52 cards.  For each game, <CODE>onegame</CODE> invokes
<CODE>shuffle</CODE>, which shuffles the cards in the array and then uses
the primitive <CODE>arraytolist</CODE> to output a list containing the cards
in their new order.  That list is used by the other parts of the program.

<PRE>
to shuffle :len :array
if :len=0 [output arraytolist :array]
localmake "choice random :len
localmake "temp item :choice :array
setitem :choice :array (item :len-1 :array)
setitem :len-1 :array :temp
output shuffle :len-1 :array
end
</PRE>

<H2>Data Abstraction</H2>

<P>
As in most large programs, the solitaire program uses selectors like
<CODE>first</CODE> and <CODE>last</CODE> for several different purposes in
different contexts.  To make the program easier to read and maintain, more
meaningful names are used in each context.

<P>
For example, cards are represented in the program as words containing the
rank and the suit, so the word <CODE>8C</CODE> represents the eight of
clubs.  To find the rank of a card, the program must take the
<CODE>butlast</CODE> of the word, and to find the suit, it must take the
<CODE>last</CODE> of the word.  (Why not use <CODE>first</CODE> instead of
<CODE>butlast</CODE> to get the rank?  Because if the card happens to be a
ten, there are two digits in its rank.  The suit is always a single
character.)  Instead of using these primitive selectors directly, I've
defined synonyms:

<PRE>
to rank :card
output butlast :card
end

to suit :card
output last :card
end
</PRE>

<P>
When considering playing a card onto a stack, the program does
not have to know the precise suit of the card, but must know whether it's
red or black:

<PRE>
to redp :card
output memberp (suit :card) :reds
end
</PRE>

<P>
One complication in dealing with cards is that the program wants to use a
card's rank in two different ways.  For user interaction (reading commands
and displaying cards on the screen) the ranks should be represented using
the names for aces and picture cards (<CODE>A</CODE>, <CODE>J</CODE>,
<CODE>Q</CODE>, and <CODE>K</CODE>).  But for comparison purposes (such as
deciding whether a card can be played on top of another card), it's more
convenient to represent all ranks as numbers: 1 for ace, 11 for jack, 12 for
queen, and 13 for king.  A conversion function <CODE>ranknum</CODE> makes
this possible:

<PRE>
to ranknum :rank
if emptyp :rank [output 0]
if numberp :rank [output :rank]
if :rank = "A [output 1]
if :rank = "J [output 11]
if :rank = "Q [output 12]
if :rank = "K [output 13]
end
</PRE>

<P>
(When would a rank be empty?  The <CODE>emptyp</CODE> test is useful in
the case of deciding whether a card can be played onto an empty &quot;top.&quot;
In general, the only card that can be played onto a top is the rank after
the one that's already visible there; for example, if a five is showing,
then a six can be played.  Treating an empty top as having a rank of zero
means that the following rank, an ace, is permitted, just as the rules
require.)

<P>
In an actual solitaire game, a top is a pile of several cards of the same
suit, with an ace on the bottom and other cards over it in sequence.  But in
the program, there is no need to represent any but the topmost card, since
the lower cards have no further role in the game.  In this program, the tops
are represented by four variables <CODE>toph</CODE>, <CODE>tops</CODE>,
<CODE>topd</CODE>, and <CODE>topc</CODE>.  (The last letter indicates the
suit.)  The value of each variable is the empty word if that top is empty,
or the rank of the topmost card if not.  Instead of using these variables
directly, the program uses data abstraction procedures <CODE>top</CODE> and
<CODE>settop</CODE> to examine and modify the values:

<PRE>
to top :suit
output thing word "top :suit
end

to settop :suit :value
make (word "top :suit) :value
end
</PRE>

<P>
For example, part of the initialization in <CODE>onegame</CODE> is to
make all four tops empty:

<PRE>
foreach :suits [settop ? "]
</PRE>

<H2>Stacks</H2>

<P>
A <EM>stack</EM> (also called a <EM>pushdown list</EM>) is a data
structure that is used to remember things and recall them later.  A stack
uses the rule &quot;Last In, First Out.&quot; That is, when you take something out
of a stack, the one you get is the one you put in most recently.  The name
&quot;stack&quot; is based on the metaphor of the spring-loaded stack of trays you
find in a self-service cafeteria.  You add a tray to the stack by pushing
down the trays that were already there, adding the new tray at the top of
the pile.  When you remove a tray, you take the one at the top of the
pile--the one most recently added to the stack.

<P>
A pile of cards in a solitaire game works just like a pile of trays in a
cafeteria.  You add cards to the top of the pile, and you remove cards from
the top of the pile.  I've used the name &quot;stack&quot; for some of the piles of
cards in this project partly because those groups of cards are represented
in the program by stacks in the technical sense.

<P>
Berkeley Logo provides primitive procedures <CODE>push</CODE> and
<CODE>pop</CODE> to implement stacks.  Each stack is represented as a list.
To push something onto the stack, Logo uses <CODE>fput</CODE>; to pop
something off the stack, it uses <CODE>first</CODE>.  (Actually, it's
slightly more complicated, as you'll see in a moment.  But this is
essentially true.)  For example, each of the seven numbered card stacks in
the solitaire layout is represented by two lists, one for the shown cards
and one for the hidden cards.  The lists for the third stack are kept in
variables named <CODE>shown3</CODE> and <CODE>hidden3</CODE>.  To
<EM>push</EM> a new card onto the hidden stack without using the
<CODE>push</CODE> primitive, you could say

<PRE>
make "hidden3 fput :card :hidden3
</PRE>

<P>
To <EM>pop</EM> a card from that stack, you'd say

<PRE>
make "card first :hidden3
make "hidden3 butfirst :hidden3
</PRE>

<P>
In this case, the first instruction reads the top of the stack,
while the second removes that entry from the stack.

<P>
Berkeley Logo provides <CODE>push</CODE> and <CODE>pop</CODE> as a data
abstraction mechanism.  <CODE>Push</CODE> is a command that takes two
inputs.  The first input is a word, the <EM>name</EM> of a stack.  The
second input is any Logo datum.  <CODE>Pop</CODE> is an operation with one
input, the name of a stack.  Its output is the first datum on the stack.  It
also has the effect of removing that datum from the stack.  Instead of the
instructions above, you can say

<PRE>
push "hidden3 :card
make "card pop "hidden3
</PRE>

<P>
If Berkeley Logo didn't already provide these procedures, it would be easy
to write them:

<PRE>
to push :stack :thing
make :stack fput :thing (thing :stack)
end

to pop :stack
local "result
make "result first thing :stack
make :stack butfirst thing :stack
output :result
end
</PRE>

<P>
Within the definition of <CODE>push</CODE>, the expression
<CODE>:stack</CODE> represents the name of the stack, while the expression
<CODE>thing :stack</CODE> represents the stack itself.  The
<CODE>make</CODE> instruction is an example of indirect assignment; it does
not give a new value to the variable <CODE>stack</CODE> but rather to the
variable whose name is contained in <CODE>stack</CODE>.

<P>
<CODE>Pop</CODE> is an unusual Logo procedure in that it's an operation that
also has an effect.  Most operations don't have effects.  They compute
some value, but they don't make any permanent change in the state of the
computer.  Another way of looking at this is to say that for most
operations, if you apply the same operation to the same inputs repeatedly,
you'll get the same result every time.

<PRE>
? <U>make "cards [AH 5C 10S]</U>
? <U>print first :cards</U>
AH
? <U>print first :cards</U>
AH
? <U>print first :cards</U>
AH
</PRE>

<P>
But if you apply <CODE>pop</CODE> to the same input repeatedly, you'll
get a different output each time.

<PRE>
? <U>print pop "cards</U>
AH
? <U>print pop "cards</U>
5C
? <U>print pop "cards</U>
10S
</PRE>

<P>
The combination of output and effect in <CODE>pop</CODE> is a powerful
technique, but a potentially confusing one.  It's important for anyone who
tries to read this program to be aware that <CODE>pop</CODE> has an effect.
Fortunately, the concept of a stack is a standard, well-known convention in
computer science, and the names <CODE>push</CODE> and <CODE>pop</CODE> are
the traditional ones for this purpose, so <CODE>pop</CODE> is somewhat
self-documenting.

<P>
Before a stack can be used, it must be initialized.  Generally a stack
starts out with no data in it.  That is, it's initially an empty list.  This
initialization could be done with an explicit <CODE>make</CODE> instruction,
but instead I invented a procedure for the purpose:

<PRE>
to setempty :stack
make :stack []
end
</PRE>

<P>
I think this makes the program slightly more elegant.

<P>
It is an error to try to pop more items from a stack than you've pushed onto
it.  If you try to do this, you'll get an error message something like

<PRE>
First doesn't like [] as input
</PRE>

<P>
Often the logic of a program ensures automatically that you never
try to overpop a stack.  But in the solitaire program I sometimes have to
check for this possibility explicitly, with an instruction like

<PRE>
if not emptyp :hidden3 [make "card pop "hidden3]
</PRE>

<P>
I've been using the name <CODE>hidden3</CODE> as an example in this
discussion, typing <CODE>"hidden3</CODE> when the name of the stack was
needed or <CODE>:hidden3</CODE> when its value was needed.  In fact, such
names do not appear explicitly in the program.  There are no instructions
that are directed exclusively to the third stack.  Instead, stack
instructions are applied either to all seven stacks or to a stack chosen by
the user through keyboard commands.  The name of a stack must be
<EM>computed</EM> using an expression like

<PRE>
word "hidden :num
</PRE>

<P>
The contents of the stack would be examined by applying <CODE>thing</CODE>
to that expression.  To make the program cleaner I created procedures to
generate these variable names.

<PRE>
to shown :num
output word "shown :num
end

to hidden :num
output word "hidden :num
end
</PRE>

<P>
Remember that these operations output the <EM>name</EM> of a stack
variable, not the contents of a stack.  So, for example, you can use them in
instructions like these:

<PRE>
push (shown 5) :card
make "card pop shown 5
setempty shown 5
</PRE>

<P>
There are only a few places in the program where a procedure needs to refer
to the entire contents of a stack, rather than just pushing or popping a
single datum at a time.  (One such place, for example, is
<CODE>remshown</CODE>, which has the job of removing perhaps several cards
from a stack.)  In those places, there is an explicit use of
<CODE>thing</CODE> to examine the contents of a stack selected by
<CODE>shown</CODE> or <CODE>hidden</CODE>.  An expression that occurred
often in the program was

<PRE>
emptyp thing shown :num
</PRE>

<P>
to see if a stack is empty; I cleaned up these expressions
somewhat by inventing a special procedure for this test.

<PRE>
to stackemptyp :name
output emptyp thing :name
end
</PRE>

<P>
This is used in an expression like

<PRE>
stackemptyp shown :num
</PRE>

<P>
Note that when a stack <EM>is</EM> mentioned explicitly by name in the
program, like <CODE>:hand</CODE> or <CODE>:pile</CODE>, it is tested for
emptiness with the ordinary <CODE>emptyp</CODE>.  In this case the colon
abbreviates the invocation of <CODE>thing</CODE>; for the <CODE>shown</CODE>
or <CODE>hidden</CODE> names, <CODE>stackemptyp</CODE> abbreviates the
invocation of <CODE>thing</CODE>.

<P>
One small detail that's easy to miss is that in a non-computer game of
solitaire, when a hand is completely dealt out, you pick up the pile from
the table and <EM>turn it over</EM> to form a new hand.  What was the top
card of the pile becomes the bottom card of the hand.  The program achieves
the same effect while dealing cards:

<PRE>
to deal 
if emptyp :hand [make "hand <U>reverse</U> :pile setempty "pile]
if emptyp :hand [output []]
output pop "hand
end
</PRE>

<P>
The Berkeley Logo primitive operation <CODE>reverse</CODE> is used
to reverse the order of the cards as they are moved from the pile to
the hand.

<H2>Program as Data</H2>

<P>
In order for the program to move a card, it must first make sure that the
requested move is legal.  The first step is to find the card's current
position.  (That's easy if the move is requested by position, using the
<CODE>P</CODE> command to play the card at the top of the pile, or a shifted
stack number to move the entire shown stack; it's a little harder if the
card is requested by its rank and suit.  Even then, in order to be playable
the card must be either on top of the pile or somewhere in a shown stack.)
The next step is to look for another position into which the card can be
moved; the only possibilities are a stack or a top.  Only after both old and
new positions have been verified can the program actually modify its data
structures (and the screen display) to move the card.

<P>
When you type a card-moving command, <CODE>parsecmd</CODE> invokes one of
three procedures: <CODE>playpile</CODE> for the <CODE>P</CODE> command,
<CODE>playstack</CODE> for one of the shifted stack numbers (such as
<CODE>#</CODE> for stack 3), or <CODE>play.by.name</CODE> for a rank and
suit (such as <CODE>7D</CODE>).  The first two of these must figure out
which card is desired, and ensure that there is in fact a card in the
requested position; <CODE>play.by.name</CODE> has the opposite job, since it
already knows the card and must determine that it's in a playable position.
But in either case, these procedures do not actually move the card.  They
ensure that the variable <CODE>card</CODE> has the desired card as its
value, and that the variable <CODE>where</CODE> has as its value a
representation of the card's current position.  Then they call
<CODE>playcard</CODE>, whose job is to ensure that there is a valid
destination for the card, and if so, to move it:

<PRE>
to playcard
setempty "onto
if not coveredp [checktop]
if and not :upping ~
       or (emptyp :onto) (not upsafep rank :card) ~
   [checkonto]
if emptyp :onto [bell]
run :where
run first :onto
end
</PRE>

<P>
Subprocedures <CODE>checktop</CODE> and <CODE>checkonto</CODE> determine
whether the requested card can be moved to the top or to a stack.  (Each of
these is called only if certain conditions are met.  For
<CODE>checktop</CODE>, the condition is that the desired card must not be in
the middle of a shown stack; it must be either the bottommost card of a
shown stack or visible on the pile.  The condition for calling
<CODE>checkonto</CODE> is more complicated.  If the user's command was
<CODE>.</CODE> or <CODE>W</CODE>, then cards are played only into the top,
so there is no need to check the stacks.  In other cases, to make the game
move more quickly, the program will always move the card to the top if it is
both possible and <EM>safe</EM> to do so.  Such a move is considered safe if
every card whose rank is less than that of the requested card by two or more
is already in the top, because then any card of rank one less than the
chosen card can be played to the top, and so the chosen card is not needed
in the stacks.)

<P>
Just as <CODE>:where</CODE> identifies the card's current position,
<CODE>:onto</CODE> will hold all of the possible destination positions.
<CODE>Checktop</CODE> and <CODE>checkonto</CODE> add possible positions to
this variable, which is a list.  If <CODE>:onto</CODE> is empty after
<CODE>checktop</CODE> and <CODE>checkonto</CODE> have been invoked, then
there is no legal way to move this card.

<P>
I want to focus attention on the two <CODE>run</CODE> instructions.  They
are the ones that actually do the work of moving a card from one place to
another; the first removes the card from its original position and the
second inserts the card at its new position.

<P>
The value of the variable <CODE>where</CODE> is not merely a number or word
indicating where the card is to be found, but a Logo instruction that
invokes the procedure needed to remove the card.  For example, suppose you
type the letter <CODE>P</CODE> to play a card from the top of the pile.
<CODE>Parsecmd</CODE> then invokes <CODE>playpile</CODE>:

<PRE>
to playpile 
if emptyp :pile [bell]
if not emptyp :digit [bell]
make "card first :pile
make "where [rempile]
carddis :card
playcard
end
</PRE>

<P>
The first two instructions check for errors.  The first checks for trying to
play a card from the pile when there are no cards in the pile.  The second
checks for the <EM>syntax</EM> error of typing a rank and then typing
<CODE>P</CODE> instead of a suit.  Having cleared those hurdles, the next
instruction finds the actual card (rank and suit) you want to play from the
pile.  The interesting part for the present discussion is that the variable
<CODE>where</CODE> is given as its value the list

<PRE>
[rempile]
</PRE>

<P>
<CODE>Rempile</CODE> is the name of a procedure with no inputs, so this
list contains a valid Logo instruction.  The corresponding instruction in
<CODE>playstack1</CODE> is

<PRE>
make "where sentence "remshown :num
</PRE>

<P>
which gives <CODE>where</CODE> a value like

<PRE>
[remshown 4]
</PRE>

<P>
if you've selected stack four.  In either case, <CODE>playcard</CODE> can
later remove the card from its original location just by <CODE>run</CODE>ning
<CODE>:where</CODE>.  At the same time, this Logo <EM>instruction</EM> can
be examined as a <EM>datum.</EM> For example, <CODE>coveredp</CODE> contains
the instruction

<PRE>
if equalp :where [rempile] [output "false]
</PRE>

<P>
Most programming languages don't have a facility like Logo's
<CODE>run</CODE> command.  In those languages, the variable
<CODE>where</CODE> would have to contain, for example, a number indicating
where the card is to be found.  <CODE>Playcard</CODE> would then use this
number to choose a course of action with a series of instructions like this:

<PRE>
if :where = 0 [rempile]
if :where = 1 [remshown 1]
if :where = 2 [remshown 2]
</PRE>

<P>
... and so on.

<P>
The situation concerning the variable <CODE>onto</CODE> is similar, except
that there is a slight complication because there may be more than one legal
destination for a card.  (By contrast, every card starts out in exactly one
place!)  Therefore, <CODE>checktop</CODE> and <CODE>checkonto</CODE> set up
<CODE>:onto</CODE> as a <EM>list</EM> of Logo instructions, one for every
possible destination.  If a card could be played onto stack 3, stack 6, or
the top, <CODE>:onto</CODE> will be

<PRE>
[[playonto 3] [playonto 6] [playtop]]
</PRE>

<P>
<CODE>Playcard</CODE> runs the first member of this list.  Why bother saving
the other members?  After a successful move, the user can type
<CODE>M</CODE> to move the same card to a different destination.  Here's how
that is done:

<PRE>
to again
if not emptyp :digit [bell]
if emptyp :onto [bell]
make "where list "remshown last pop "onto
if emptyp :onto [bell]
carddis :card
run :where
run first :onto
end
</PRE>

<P>
This procedure uses the values that are still left over in
<CODE>:card</CODE> and <CODE>:onto</CODE> from the last move.  The first
member of <CODE>:onto</CODE> is the instruction that moved the card onto a
stack.  (If the card was moved to the top, it's because there were no
alternatives in <CODE>:onto</CODE>, because <CODE>playtop</CODE> is always
the last choice in the list.)  That stack is now the card's position of
origin!  If <CODE>:onto</CODE> was

<PRE>
[[playonto 3] [playonto 6] [playtop]]
</PRE>

<P>
then the instruction

<PRE>
make "where list "remshown last pop "onto
</PRE>

<P>
will give <CODE>where</CODE> the value

<PRE>
[remshown 3]
</PRE>

<P>
and, because <CODE>pop</CODE> removes the first datum from the stack,
leaves <CODE>onto</CODE> with the value

<PRE>
[[playonto 6] [playtop]]
</PRE>

<P>
The chosen card will be moved from stack three to stack six.  If the user
types <CODE>M</CODE> again, then the card will be moved from stack six to
the top.

<H2>Multiple Branching</H2>

<P>
Consider the procedure that interprets what you type at the keyboard while
running the solitaire program:

<PRE>
to parsecmd                ;; abbreviated version
local "char
make "char uppercase readchar
if equalp :char "T [parsedigit 1 parsezero stop]
if memberp :char [1 2 3 4 5 6 7 8 9 A J Q K] [parsedigit :char stop]
if equalp :char "0 [parsezero stop]
if memberp :char :suits [play.by.name :char stop]
if equalp :char ". [allup stop]
if equalp :char "W [wingame stop]
if equalp :char "M [again stop]
; several more possibilities omitted...
bell
end
</PRE>

<P>
This sort of thing is common in Logo programming: a string of
<CODE>if</CODE>s in which each conditional instruction list ends with
<CODE>stop</CODE> because the choices are mutually exclusive.

<P>
Some people find this use of <CODE>stop</CODE> offensive because it doesn't
make it graphically apparent when reading the program that the choices are
exclusive.  The form of the program makes it seem that each decision (that
is, each <CODE>if</CODE> instruction) is independent of the others.

<P>
It would be possible to meet this objection by using <CODE>ifelse</CODE>,
putting each new test in the false part of the previous one:

<PRE>
to parsecmd
local "char
make "char uppercase readchar
ifelse equalp :char "T ~
       [parsedigit 1 parsezero]
       [ifelse memberp :char [1 2 3 4 5 6 7 8 9 A J Q K]
               [parsedigit :char]
               [ifelse equalp :char "0 [parsezero]
                       ; ...
                                       bell]]
end
</PRE>

<P>
It's not clear that this is an improvement, although the use of
<CODE>ifelse</CODE> makes more sense as an alternative to
<CODE>stop</CODE> when only a single decision is involved.

<P>
Some programming languages provide a special representation for such a
<EM>multiple branching</EM> decision.  A Logo equivalent might look like this:

<PRE>
to parsecmd
local "char
make "char uppercase readchar
branch [
  [[equalp :char "T] [parsedigit 1 parsezero]]
  [[memberp :char [1 2 3 4 5 6 7 8 9 A J Q K]] [parsedigit :char]]
  [[equalp :char "0] [parsezero]]
  [[memberp :char :suits] [play.by.name :char]]
  [[equalp :char ".] [allup]]
  [[equalp :char "W] [wingame]]
  [[equalp :char "M] [again]]
  ; several more possibilities omitted...
  [["true] [bell]] ]
end
</PRE>

<P>
<CODE>Branch</CODE> is a hypothetical command that takes a single input, a
list of lists.  Each member of the input is a list with two members.  The
first member must be a Logo predicate expression; the second must be a Logo
instruction.  <CODE>Branch</CODE> evaluates the first half of each pair.  If
the value is <CODE>true</CODE>, <CODE>branch</CODE> then carries out the
instruction in the second half of that pair, and then stops without
evaluating the remaining pairs.  If the value is <CODE>false</CODE>,
<CODE>branch</CODE> goes on to the next pair.  <CODE>Branch</CODE> is not a
Logo primitive, but it can easily be written in Logo:

<PRE>
to branch :conditions
if emptyp :conditions [stop]
if (run first first :conditions) [run last first :conditions stop]
branch butfirst :conditions
end
</PRE>

<P>
Inventing control structures like this is the sort of thing Logo
makes easy and other languages make impossible.

<P>
The trouble with this particular control structure in Logo is that the input
to <CODE>branch</CODE> is typically a very long list, extending over several
lines on the screen.  Traditional Logo dialects have not done a good job of
presenting such long lists with clear formatting.  More recent versions can,
however, handle instructions like that multi-line <CODE>branch</CODE>
invocation.

<H2>Further Explorations</H2>

<P>
I keep thinking of new features I'd like in this program.  I think the most
important is an Undo command, which would undo the effect of the previous
user command.  This should be pretty easy to implement; every time the
program changes the value of a variable that represents card positions, it
should make a list of the variable's name and its old value, and push that
onto a changes list.  For example, here's the procedure that removes a card
from the pile:

<PRE>
to rempile 
make "cards (list (pop "pile))
dispile
end
</PRE>

<P>
And here's how I'd change it for the undo command:

<PRE>
to rempile 
<U>push "undo.list (list "pile :pile)</U>
make "cards (list (pop "pile))
dispile
end
</PRE>

<P>
The undo command itself would go through the list, restoring the values of
all the variables it finds, and then call <CODE>redisplay</CODE> to make the
display match the program's state.  <CODE>Playcard</CODE> would
<CODE>setempty</CODE> the undo list before moving any cards.

<P>
Another possibility is to improve the display.  One person who tried this
program commented that it's not enough to indicate whether the hidden part
of a stack is empty or nonempty; he wanted to see exactly how many cards
are present.  Novice users might be helped by keeping an abbreviated command
list in the empty space toward the right side of the screen.

<P>
A more ambitious direction you could pursue is to write a similar program
for a different solitaire game.  There are books of card games that include
several variations on this kind of solitaire as well as versions of
solitaire that are totally different in their rules and layouts.

<P>
Another direction would be to try to have the program offer strategic
suggestions, or even play the game entirely by itself.  As with any strategy
game, you would have to choose between determining the strategy for the
program in advance and letting it learn from its experience and modify its
strategy.  Which is better, playing cards to the top quickly or saving them
in the stacks as long as possible?  Which is better, playing a card from the
pile or playing a card of the same rank and color from the stacks?  You
could research these questions by writing versions of the program with
different strategies and collecting statistics on their performance.

<P>
Another possibility would be to abandon solitaire and program the computer
to play one side of a two-player game with you.  Blackjack is a simple
example; poker is a harder one.

<P>
A different kind of exploration would be to try to speed up the running of
this program.  Earlier I suggested the possibility that the program might
benefit from remembering explicitly the position of each card.  You could
find out whether or not that would really help.  (It would speed up the
searching process for a card, but it would also slow down the moving of
cards because the program would have to remember the new location instead of
the old one.  My guess is that the speedup would be substantial and the
slowdown minimal, but I'm not sure.)  What other bottlenecks can you find in
this program, and how can you improve them?

<P>
<TABLE width="100%"><TR><TD><A HREF="../v2-toc2.html">(back to Table of Contents)</A>
<TD align="right"><A HREF="https://people.eecs.berkeley.edu/~bh/v2ch3/v2ch3.html"><STRONG>BACK</STRONG></A>
chapter thread <A HREF="../v2ch5/v2ch5.html"><STRONG>NEXT</STRONG></A>
</TABLE>

<H2>Program Listing</H2>

<P>
If you trace the progress of a user command, let's say <CODE>P</CODE> to
play from the pile, from <CODE>parsecmd</CODE> through <CODE>playpile</CODE>
and <CODE>playcard</CODE> to <CODE>rempile</CODE> and then either
<CODE>playtop</CODE> or <CODE>playonto</CODE>, you'll understand most of the
program.  There are a few slightly complicated details in moving several
cards from one stack to another (<CODE>remshown</CODE> and
<CODE>playonto</CODE>) but nothing really hard to understand.

<PRE>
to <A NAME="solitaire">solitaire</A>
print [Welcome to solitaire]
instruct
localmake "allranks [A 2 3 4 5 6 7 8 9 10 J Q K]
localmake "numranks map "ranknum :allranks
localmake "suits [H S D C]
localmake "reds [H D]
localmake "deckarray (listtoarray (crossmap "word :allranks :suits) 0)
localmake "upping "false
catch "exit [forever [onegame cleartext]]
cleartext
end

to s
solitaire
end

to <A NAME="onegame">onegame</A>
print [Shuffling, please wait...]
local [card cards digit pile where]
localmake "onto []
local map [word "top ?] :suits
local cascade 9 [(sentence (word "shown #) (word "hidden #) ?)] []
localmake "ranks :allranks
localmake "numstacks 7
local map [word "num ?] :numranks
foreach :numranks [make word "num ? 4]
localmake "hand shuffle 52 :deckarray
setempty "pile
initstacks
foreach :suits [settop ? "]
redisplay
catch "endgame [forever [catch "bell [parsecmd]]]
end

;; Initialization

to instruct 
print [] print [Here are the commands you can type:]
type "|    | type (sentence standout "+ standout "=)
type "|  | print [Deal three cards onto pile]
instruct1 "P [Play top card from pile]
instruct1 "R [Redisplay the board]
instruct1 "? [Retype these instructions]
instruct1 "card [Play that card]
instruct1 "M [Move same card again]
instruct1 "W [Play up as much as possible (Win)]
instruct1 "G [Give up (start a new game)]
instruct1 "X [Exit to Logo]
print [A card consists of a rank:]
type "|   | print (sentence standout [A 2 3 4 5 6 7 8 9 10 J Q K]
                            "or standout "T [for 10])
print [followed by a suit:]
type "|   | print standout [H S D C]
print (sentence [or followed by] standout ".
                [to play all possible suits up])
print [] print [If you make a mistake, hit delete or backspace.]
print [] print [To move an entire stack,]
type "|   | print [hit the shifted stack number:]
type "|     | print (sentence standout [! @ # $ % ^ &] [for stacks])
type "|     | print [1 2 3 4 5 6 7]
print []
end

to instruct1 :key :meaning
type "|    |
type standout :key
repeat 5-count :key [type "| |]
print :meaning
end

to shuffle :len :array
if :len=0 [output arraytolist :array]
localmake "choice random :len
localmake "temp item :choice :array
setitem :choice :array (item :len-1 :array)
setitem :len-1 :array :temp
output shuffle :len-1 :array
end

to initstacks
for [num 1 7] [inithidden :num
               turnup :num]
end

to inithidden :num
localmake "name hidden :num
setempty :name
repeat :num [push :name deal]
end

;; Reading and interpreting user commands

to <A NAME="parsecmd">parsecmd</A>
if emptyp :digit [setcursor [1 22] type "|      | setcursor [1 22]]
local "char
make "char uppercase readchar
if equalp :char "T [parsedigit 1 parsezero stop]
if memberp :char [1 2 3 4 5 6 7 8 9 A J Q K] [parsedigit :char stop]
if equalp :char "0 [parsezero stop]
if memberp :char :suits [play.by.name :char stop]
if equalp :char ". [allup stop]
if equalp :char "W [wingame stop]
if equalp :char "M [again stop]
if memberp :char [+ =] [hand3 stop]
if equalp :char "R [redisplay stop]
if equalp :char "? [helper stop]
if equalp :char "P [playpile stop]
if and equalp :char "|(| not emptyp :digit [cheat stop]
if and equalp :char "|)| not emptyp :digit [newstack stop]
if memberp :char [! @ # $ % ^ & * ( )] ~
   [playstack :char [! @ # $ % ^ & * ( )] stop]
if memberp :char (list "| | char 8 char 127) [rubout stop]
if equalp :char "G [throw "endgame]
if equalp :char "X [throw "exit]
bell
end

to parsedigit :char
if not emptyp :digit [bell]
make "digit :char
type :digit
end

to parsezero 
if not equalp :digit 1 [bell]
make "digit 10
type 0
end

to rubout 
setcursor [1 22]
type "|    |
setcursor [1 22]
setempty "digit
end

to bell
if not :upping [type char 7]
setempty "digit
throw "bell
end

;; Deal three cards from the hand

to hand3 
if not emptyp :digit [bell]
if and emptyp :hand emptyp :pile [bell]
push "pile deal
repeat 2 [if not emptyp :hand [push "pile deal]]
dispile dishand
end

to deal 
if emptyp :hand [make "hand reverse :pile setempty "pile]
if emptyp :hand [output []]
output pop "hand
end

;; Select card to play by position (pile or stack) or by name

to playpile 
if emptyp :pile [bell]
if not emptyp :digit [bell]
make "card first :pile
make "where [rempile]
carddis :card
playcard
end

to playstack :which :list
if not emptyp :digit [bell]
foreach :list [if equalp :which ? [playstack1 # stop]]
end

to playstack1 :num
if greaterp :num :numstacks [bell]
if stackemptyp shown :num [bell]
make "card last thing shown :num
make "where sentence "remshown :num
carddis :card
playcard
end

to play.by.name :char
if emptyp :digit [bell]
if equalp :digit 1 [make "digit "a]
type :char
wait 0
make "card word :digit :char
setempty "digit
findcard
if not emptyp :where [playcard]
end

to findcard 
if findpile [stop]
make "where findshown
if emptyp :where [bell]
end

to findpile 
if emptyp :pile [output "false]
if equalp :card first :pile [make "where [rempile] output "true]
output "false
end

to findshown
for [num 1 :numstacks] ~
    [if memberp :card thing shown :num [output sentence "remshown :num]]
output []
end

;; Figure out all possible places to play card, then pick one

to playcard
setempty "onto
if not coveredp [checktop]
if and not :upping ~
       or (emptyp :onto) (not upsafep rank :card) ~
   [checkonto]
if emptyp :onto [bell]
run :where
run first :onto
end

to coveredp 
if equalp :where [rempile] [output "false]
output not equalp :card first thing shown last :where
end

to upsafep :rank
if memberp :rank [A 2] [output "true]
output equalp 0 thing word "num ((ranknum :rank)-2)
end

to checktop 
if (ranknum rank :card) = 1 + (ranknum top suit :card) ~
   [push "onto (list "playtop word "" suit :card)]
end

to checkonto
for [num :numstacks 1] ~
    [ifelse stackemptyp shown :num
            [checkempty :num]
            [checkfull :num thing shown :num]]
end

to checkempty :num
if equalp rank :card "k [push "onto (list "playonto :num)]
end

to checkfull :num :stack
if equalp (redp :card) (redp first :stack) [stop]
if ((ranknum rank first :stack) = 1 + (ranknum rank :card)) ~
   [push "onto (list "playonto :num)]
end

;; Play card, step 1: remove from old position

to rempile 
make "cards (list (pop "pile))
dispile
end

to remshown :num
setempty "cards
remshown1 :num (count thing shown :num)
if stackemptyp shown :num [turnup :num disstack :num]
end

to remshown1 :num :length
do.until [push "cards (pop shown :num)] ~
         [equalp :card first :cards]
for [i 1 [count :cards]] ~
    [setcursor list (5*:num - 4) (5+:length-:i) type "|   |]
end

to turnup :num
setempty shown :num
if stackemptyp hidden :num [stop]
push (shown :num) (pop hidden :num)
end

;; Play card, step 2: put in new position 

to playtop :suit
localmake "var word "num ranknum rank :card
settop :suit rank :card
distop :suit
make :var (thing :var)-1
if (thing :var)=0 [make "ranks butfirst :ranks]
end

to playonto :num
localmake "row 4+count thing shown :num
localmake "col 5*:num-4
for [i 1 [count :cards]] ~
    [localmake "card pop "cards
     push (shown :num) :card
     setcursor list :col :row+:i
     carddis :card]
end

;; Update screen display

to redisplay 
cleartext
for [num 1 :numstacks] [disstack :num]
foreach :suits "distop
dispile
dishand
setcursor [1 22]
setempty "digit
end

to disstack :num
setcursor list (-3 + 5 * :num) 4
type ifelse stackemptyp hidden :num ["| |] ["-]
if stackemptyp shown :num [setcursor list (-4 + 5 * :num) 5
                           type "|   | stop]
localmake "stack (thing shown :num)
localmake "col 5*:num-4
for [i [count :stack] 1] ~
    [setcursor list :col :i+4
     carddis pop "stack]
end

to distop :suit
if emptyp top :suit [stop]
if equalp :suit "H [distop1 4 stop]
if equalp :suit "S [distop1 11 stop]
if equalp :suit "D [distop1 18 stop]
distop1 25
end

to distop1 :col
setcursor list :col 2
carddis word (top :suit) :suit
end

to dispile 
setcursor [32 23]
ifelse emptyp :pile [type "|   |] [carddis first :pile]
end

to dishand 
setcursor [27 23]
type count :hand
type "| |
end

to carddis :card
ifelse memberp suit :card :reds [redtype :card] [blacktype :card]
type "| |
end

to redtype :word
type :word
end

to blacktype :word
type standout :word
end


;; Miscellaneous user commands

to again
if not emptyp :digit [bell]
if emptyp :onto [bell]
make "where list "remshown last pop "onto
if emptyp :onto [bell]
carddis :card
run :where
run first :onto
end

to allup
if emptyp :digit [bell]
if equalp :digit 1 [make "digit "a]
localmake "upping "true
type ". wait 0
foreach map [word :digit ?] [H S D C] ~
        [catch "bell [make "card ?
                      findcard
                      if not emptyp :where [playcard]]]
setempty "digit
end

to helper
cleartext 
instruct
print standout [type any key to continue]
ignore rc
redisplay
end

to wingame
type "W
localmake "cursor cursor
foreach :ranks [if not upsafep ? [stop]
                make "digit ? ~
                allup ~
                setempty "digit ~
                setcursor :cursor]
if equalp (map "top [H S D C]) [K K K K] ~
   [ct print [you win!] wait 120 throw "endgame]
end

to newstack
localmake "num :numstacks+1
setcursor [1 22] type "|   |
if not equalp :digit 9 [bell]
setempty hidden :num
setempty shown :num
make "numstacks :num
setempty "digit
end

to cheat 
setcursor [1 22] type "|   |
if not equalp :digit 8 [bell]
if and emptyp :hand emptyp :pile [bell]
push "pile deal
dispile
dishand
setempty "digit
end

;; Data abstraction (ranks)

to rank :card
output butlast :card
end

to ranknum :rank
if emptyp :rank [output 0]
if numberp :rank [output :rank]
if :rank = "A [output 1]
if :rank = "J [output 11]
if :rank = "Q [output 12]
if :rank = "K [output 13]
end

;; Data abstraction (suits)

to suit :card
output last :card
end

to redp :card
output memberp (suit :card) :reds
end

;; Data abstraction (tops)

to top :suit
output thing word "top :suit
end

to settop :suit :value
make (word "top :suit) :value
end

;; Data abstraction (card stacks)

to shown :num
output word "shown :num
end

to hidden :num
output word "hidden :num
end

;; Data abstraction (pushdown stacks)

to stackemptyp :name
output emptyp thing :name
end

to setempty :stack
make :stack []
end
</PRE>

<P><A HREF="../v2-toc2.html">(back to Table of Contents)</A>
<P><A HREF="https://people.eecs.berkeley.edu/~bh/v2ch3/v2ch3.html"><STRONG>BACK</STRONG></A>
chapter thread <A HREF="../v2ch5/v2ch5.html"><STRONG>NEXT</STRONG></A>

<P>
<ADDRESS>
<A HREF="../index.html">Brian Harvey</A>, 
<CODE>bh@cs.berkeley.edu</CODE>
</ADDRESS>
</BODY>
</HTML>