program solitaire;
{*Yes, it's true: I'm going to teach the computer to play as well as me *}
{*I will emulate the Las Vegas rules: once around, one card at a time*}
{$C-} {*needed to make KeyPressed work *}

const         {*these are hardwired into 'evaluate;'*}
	NUMSTACKS= 7; {*Larger => bum display, too few cards in drawpile *}
	NUMSUITS=4; {*assumed even*}
	NUMRANKS=13;
	NUMCARDS=52; {*has to be NUMSUITS*NUMRANKS *}
	NUMMOVES=20; {*max number of moves possible per turn. Think about it*}
	CARDVALU=5;
	MINSCORE=-260;
	{*also of course lots of things need to be <32768 *}

type
	pile=array[0..NUMCARDS] of integer;
	filename=string[64];

var
	stack, reserv: array[1..NUMSTACKS] of pile;
	build: array[1..NUMSUITS] of pile; 
			{* actually it would suffice to store buildlen[] *}
	draw, discard, rank,suit: pile;
	stacklen, reservlen: array[1..NUMSTACKS] of integer;
	buildlen: array[1..NUMSUITS] of integer;
	poss1, poss2, poss3, poss4: array[1..NUMMOVES] of integer;
	scorestats: array[0..NUMCARDS] of integer;
	drawlen,discardlen,playmode,movesavail,gamesplayed,totscore,newscore: integer;
	needinput,fast:boolean;
	indata, outdata:text;
	outdata_name:filename;

function openx(var fp:text; var Name:filename; mode:char): boolean;
var	proceed: boolean;
begin
{$I-}
	proceed:=TRUE;
	writeln;
	while proceed=TRUE do begin
		Write('Enter filename (hit return to abort): ');
		readln(Name);
		Assign(fp,Name);
		if mode='w' then rewrite(fp) else reset(fp);
		if IOresult <> 0 then begin
			if mode='r' then close(fp);
			Write('ERROR -- ');
			if mode='w' then write('File creation error:  ')
				else write('File not found: ');
			Writeln(Name);
			proceed:=TRUE;
			end
		else proceed:=FALSE;
		if Name='' then begin
			proceed:=FALSE;
			openx:=False
			end
		else openx:=TRUE;
		end;
end;
{$I+}

procedure readdata; {*not yet used*}
var	indata_name:filename;
begin
	Write('Need name of file holding input data: ');
	if not openx(indata, indata_name,'r') then HALT;
	{*then use calls like	readln(indata, numitems);  *}
	close(indata);
end;

procedure labelcards;
var i:integer;
begin
for i:=1 to NUMCARDS do suit[i]:=round((i-0.5)/NUMRANKS+0.5);
for i:=1 to NUMCARDS do rank[i]:=i-NUMRANKS*round((2*i-1)/(2*NUMRANKS)-0.5);
for i:=0 to NUMCARDS do scorestats[i]:=0;
end;

procedure initialize;
begin
ClrScr;
writeln('This is a computer modelling of the card game SOLITAIRE, suggested by');
writeln('the Windows(tm) version. This computer adaptation is by Dave Rusin 6/15/95.');
writeln('The simulation is faithful to the rules as I understand them.');
writeln;
writeln('Several modes of play are available:');
writeln('0. Pedestrian mode: computer lists all moves, pick one.');
writeln('1. Terse mode: computer lists all sensible moves, pick one.');
writeln('2. Prompt mode: computer lists its idea of best move, you consent.');
writeln('3. Automatic mode: computer plays all by itself.');
writeln('4. Like 1, but faster (makes move if only one exists).');
writeln('5. Like 2, but faster (does not let you alter display).');
write('Your choice? ');readln(playmode);
writeln;
fast:=FALSE;
if (playmode=2) then begin
	writeln('You can save to a file cases to mull over later.');
	Write('Need name of file to hold output data: ');
	if not openx(outdata, outdata_name,'w') then HALT;
	end;
if (playmode=4) or (playmode=5) then begin
	needinput:=TRUE;
	playmode:=playmode-3;fast:=TRUE;end;
if playmode=3 then begin
	needinput:=FALSE;
	writeln('We will save data regarding trial runs to a file.');
	Write('Need name of file to hold output data: ');
	if not openx(outdata, outdata_name,'w') then HALT;
	end;
labelcards;
totscore:=0;gamesplayed:=0;
end;

function firstfree(j:integer):integer;
{*locates first (cyclic sense) zero in draw[] after j-th position*}
var i, temp: integer;
begin
if j<1 then j:=1; if j>NUMCARDS then j:=NUMCARDS;
temp:=1;
for i:=1 to j-1 do if draw[j-i]=0 then temp:=j-i;
for i:=0 to NUMCARDS-j do if draw[NUMCARDS-i]=0 then temp:=NUMCARDS-i;
firstfree:=temp;
end;

procedure deal;
var i,j: integer;
begin
for i:=1 to NUMCARDS do draw[i]:=0;
for i:=1 to NUMCARDS do begin
	j:=round(random(NUMCARDS)+0.5);
	draw[firstfree(j)]:=i;
	end;
drawlen:=NUMCARDS;
for j:=1 to NUMSTACKS do begin
	for i:=1 to j-1 do begin reserv[j,i]:=draw[drawlen]; drawlen:=drawlen-1; end;
	reservlen[j]:=j-1;
	stack[j,1]:=draw[drawlen];drawlen:=drawlen-1; stacklen[j]:=1;
	end;
for j:=1 to NUMSUITS do buildlen[j]:=0;
discard[1]:=draw[drawlen];drawlen:=drawlen-1;discardlen:=1;
newscore:=-NUMCARDS;
{*for printing of empty stacks:*}
discard[0]:=0;draw[0]:=0;
for i:=1 to NUMSUITS do build[i,0]:=0;
for i:=1 to NUMSTACKS do stack[i,0]:=0;
for i:=1 to NUMSTACKS do reserv[i,0]:=0;
gamesplayed:=gamesplayed+1;
end;

procedure makebox(i,j:integer);
{*make a box on the screen starting at column i, row j; width 4 *}
{*leave cursor at position i+1,j *}
begin
gotoxy(i,j-1);write(#218);write(#196);write(#196);write(#196);write(#191);
gotoxy(i,j);write(#179);write('   ');write(#179);
gotoxy(i,j+1);write(#192);write(#196);write(#196);write(#196);write(#217);
gotoxy(i+1,j);
end;

procedure showcard(i: integer);
begin
if i=0 then write('   ') else begin
	if (rank[i]>1) AND (rank[i]<10) then write(rank[i],'-');
	if rank[i]=1 then write('A-');{* Ace *}
	if rank[i]=10 then write('T-');{* Ten *}
	if rank[i]=11 then write('J-');{* Jack *}
	if rank[i]=12 then write('Q-');{* Queen *}
	if rank[i]=13 then write('K-');{* King *}
	if suit[i]=1 then write(#3);{*Hearts*}
	if suit[i]=2 then write(#5);{*Clubs*}
	if suit[i]=3 then write(#4);{*Diamonds*}
	if suit[i]=4 then write(#6);{*Spades*}
	end;
end;

procedure nicecard(i,c,r:integer);
begin
makebox(c-1,r);
showcard(i);
gotoxy(c+4,r);
end;

procedure savegame;
begin
write(outdata,'Anomolous game: drawlen=',drawlen,', buildlens are ');
for i:=1 to NUMSUITS do write(outdata,buildlen[i]);
writeln(outdata);
write(outdata,'Discard pile is ');
for i:=1 to discardlen do write(outdata,rank[discard[i]],'-',suit[discard[i]],',');
writeln(outdata);
writeln(outdata,'Stacks:');
for i:=1 to NUMSTACKS do begin
	write(outdata,'(',reservlen[i],') ');
	for j:=1 to stacklen[i] do write(outdata,rank[stack[i,j]],'-',suit[stack[i,j]],',');
	writeln(outdata);
	end;
write(outdata,'(First) suggested move: ',poss1[1],poss2[1],poss3[1],poss4[1]);
end;

procedure displaytableau;
var i,j,temp: integer;
begin
ClrScr;
Gotoxy(1,1);
write('Draw pile size=',drawlen);
Gotoxy(62,1); writeln('Score=' , newscore);
Gotoxy(1,3);write('Discard: ');
nicecard(discard[discardlen], 12, 3);
Gotoxy(18,3);write('(',discardlen,' cards)');
Gotoxy(38,3);write('Build-ups: ');
for i:=1 to NUMSUITS do nicecard(build[i,buildlen[i]], 8*i+40, 3);
for i:=1 to NUMSTACKS do begin
	gotoxy(8*i-4, 5);write('#',i,': ');
	for j:=1 to reservlen[i] do begin
		gotoxy(8*i-4, 5+j); write('?-?');end;
	for j:=1 to stacklen[i]-1 do begin
		gotoxy(8*i-4,5+j+reservlen[i]); showcard(stack[i,j]); end;
	temp:=stacklen[i]+reservlen[i];
	if temp=0 then temp:=1;
	nicecard(stack[i,stacklen[i]],8*i-4, 6+temp);
	end;
end;

procedure showdiscard;
var i:integer;
begin
ClrScr;
for i:=1 to discardlen do begin showcard(discard[i]);writeln;end;
writeln('Newest card on discard pile is here at the bottom.');
writeln('Discard stack has ',discardlen,' cards; draw pile has ',drawlen,'.');
writeln('Hit RETURN to return to ordinary display');readln;
end;

function stackmatch(i,j:integer): boolean;
var temp: boolean;
begin
temp:=FALSE;
if (rank[stack[j,stacklen[j]]]=rank[i]+1) AND ( ((suit[stack[j,stacklen[j]]]+suit[i]) mod 2 ) = 1) then temp:=TRUE;
if (stacklen[j]=0) then begin
	if (rank[i]=NUMRANKS) then temp:=TRUE else temp:=FALSE;
	end;
stackmatch:=temp;
end;

function canraise(i:integer): boolean;
{*test to see if card  i  fits in its buildup pile *}
var temp: boolean;
	j:integer;
begin
j:=suit[i];
temp:=FALSE;
if (buildlen[j]=0) AND (rank[i]=1) then temp:=TRUE;
if (buildlen[j]>0) AND (buildlen[j]=rank[i]-1) then temp:=TRUE;
canraise:=temp;
end;

function existsking:boolean;
var temp: boolean;
	i: integer;
begin
temp:=FALSE;
for i:=1 to NUMSTACKS do 
	if (stacklen[i]>0) and (rank[stack[i,1]]=NUMRANKS) and (reservlen[i]>0) then temp:=TRUE;
if (discardlen>0) AND (rank[discard[discardlen]]=NUMRANKS) then temp:=TRUE;
for i:=1 to NUMSUITS do if buildlen[i]=NUMRANKS then temp:=TRUE;
{*although it's hard to imagine times when you'd need to pull down a king!*}
existsking:=temp;
end;

function existsnext(j:integer):boolean; {* Can we follow up j to B-U? *}
var temp: boolean;
	i: integer;
begin
temp:=FALSE;
for i:=1 to NUMSTACKS do 
	if (stacklen[i]>0) and (rank[stack[i,stacklen[i]]]=rank[j]+1) and (suit[stack[i,stacklen[i]]]=suit[j]) then temp:=TRUE;
if (discardlen>0) AND (rank[discard[discardlen]]=rank[j]+1) and (suit[discard[discardlen]]=suit[j]) then temp:=TRUE;
{*it can't happen that successor is on BU unless j  is too! *}
existsnext:=temp;
end;

{* The six types of moves are: *}
{* 0. move top card from draw pile to top of discard pile (face up) *}
{* 1. move top card from build pile  i  to top of stack  j *}
{* 2. move k-th card from stack  i  to top of stack  j *}
{* 3. move top card from discard pile to top of stack  i  *}
{* 4. move card from stack  i  to appropriate build pile *}
{* 5. move top card from discard pile to appropriate build pile  *}

function move0legal:boolean;
var temp:boolean;
begin
if drawlen=0 then temp:=FALSE else temp:=TRUE;
move0legal:=temp
end;

function move1legal(i,j:integer):boolean;
var temp:boolean;
begin
temp:= stackmatch(build[i,buildlen[i]],j);
if buildlen[i]=0 then temp:=FALSE;
move1legal:=temp;
end;

function move2legal(k,i,j:integer):boolean;
var temp:boolean;
begin
temp:= stackmatch(stack[i,k],j);
if stacklen[i]<k then temp:=FALSE;
move2legal:=temp;
end;

function move3legal(i:integer):boolean;
var temp:boolean;
begin
temp:= stackmatch(discard[discardlen], i);
if discardlen=0 then temp:=FALSE;
move3legal:=temp;
end;

function move4legal(i:integer):boolean;
var temp:boolean;
begin
temp:= canraise(stack[i,stacklen[i]]);
if stacklen[i]=0 then temp:=FALSE;
move4legal:=temp;
end;

function move5legal:boolean;
var temp:boolean;
begin
temp:= canraise(discard[discardlen]);
if discardlen=0 then temp:=FALSE;
move5legal:=temp;
end;

procedure makemove0;
begin
discardlen:=discardlen+1;
discard[discardlen]:=draw[drawlen];
drawlen:=drawlen-1;
end;

procedure makemove1(i,j:integer);
begin
stacklen[j]:=stacklen[j]+1;
stack[j,stacklen[j]]:=build[i,buildlen[i]];
buildlen[i]:=buildlen[i]-1;
newscore:=newscore-CARDVALU;
end;

procedure makemove2(k, i,j:integer);
var l:integer;
begin
for l:=k to stacklen[i] do
	stack[j,stacklen[j]+l-k+1]:=stack[i,l];
stacklen[j]:=stacklen[j]+stacklen[i]-k+1;
stacklen[i]:=k-1;
if (stacklen[i]=0) and (reservlen[i]>0) then begin
	stacklen[i]:=1;
	stack[i,1]:=reserv[i,reservlen[i]];
	reservlen[i]:=reservlen[i]-1;
	end;
end;

procedure makemove3(i:integer);
begin
stacklen[i]:=stacklen[i]+1;
stack[i,stacklen[i]]:=discard[discardlen];
discardlen:=discardlen-1;
end;

procedure makemove4(i:integer);
var j:integer;
begin
j:=suit[stack[i,stacklen[i]]];
buildlen[j]:=buildlen[j]+1;
build[j,buildlen[j]]:=stack[i,stacklen[i]];
stacklen[i]:=stacklen[i]-1;
newscore:=newscore+CARDVALU;
if (stacklen[i]=0) and (reservlen[i]>0) then begin
	stacklen[i]:=1;
	stack[i,1]:=reserv[i,reservlen[i]];
	reservlen[i]:=reservlen[i]-1;
	end;
end;

procedure makemove5;
var j:integer;
begin
j:=suit[discard[discardlen]];
buildlen[j]:=buildlen[j]+1;
build[j,buildlen[j]]:=discard[discardlen];
discardlen:=discardlen-1;
newscore:=newscore+CARDVALU;
end;

procedure findmoves;
var	n,i,j,k:integer;
begin
n:=0;
{*order _is_ relevant in most playmodes as "n:=0" overrules previous *}
if move0legal then begin n:=n+1;poss1[n]:=0;end;
for i:=1 to NUMSUITS do for j:=1 to NUMSTACKS do if move1legal(i,j) then begin
	n:=n+1;
	poss1[n]:=1;poss2[n]:=i;poss3[n]:=j;
	if (playmode>=2) or ((playmode=1) and (buildlen[i]<3)) then n:=n-1;
	end;
for i:=1 to NUMSTACKS do for j:=1 to NUMSTACKS do for k:=1 to stacklen[i] do
	if move2legal(k,i,j) then begin
	if (playmode>=2) then begin
		if (reservlen[i]>0) and (k=1) then n:=0;
		if (rank[stack[i,1]]<NUMRANKS) and existsking and (k=1) then n:=0;
		if (k>1) and canraise(stack[i,k-1]) then n:=0;
		end;
	n:=n+1;
	poss1[n]:=2;poss2[n]:=k;poss3[n]:=i;poss4[n]:=j;
	if (playmode>=1) and (k=1) and (reservlen[i]=0) then 
		if (rank[stack[i,1]]=NUMRANKS) or ((rank[stack[i,1]]<NUMRANKS) and not existsking) then n:=n-1;
	if (playmode>=1) and (k>1) and NOT canraise(stack[i,k-1]) then n:=n-1;
	end;
for i:=1 to NUMSTACKS do if move3legal(i) then begin
	if (playmode>=2) then n:=0;
	n:=n+1;
	poss1[n]:=3;poss2[n]:=i;
	end;
for i:=1 to NUMSTACKS do if move4legal(i) then begin
	if (playmode=1) and (rank[stack[i,stacklen[i]]]<3) then n:=0;
	if (playmode>=2) then n:=0;
	n:=n+1;
	poss1[n]:=4;poss2[n]:=i;
	end;
if move5legal then begin
	if (playmode=1) then n:=0;
	{*  if ... and (rank[discard[discardlen]]<3) ... *}
	if (playmode>=2) then n:=0;
	n:=n+1;
	poss1[n]:=5;
	end;
if move0legal and (discardlen=0) then begin n:=1;poss1[n]:=0;end;
movesavail:=n;
if (playmode<3) then needinput:=TRUE;
if (playmode=1) and fast and (n=1) then needinput:=FALSE; 
end;

procedure displaymoves;
var	n:integer;
begin
gotoxy(1,24-movesavail);
for n:=1 to movesavail do begin
	if poss1[n]=0 then writeln(n,'. Turn over another draw card to discard pile.');
	if poss1[n]=1 then begin
		write(n,'. Bring down ');
		showcard(build[poss2[n],buildlen[poss2[n]]]);
		writeln(' from build-up pile ',poss2[n],' to stack ',poss3[n]);
		end;
	if (poss1[n]=2) AND (poss2[n]>1) then begin
		write(n,'. All cards from ');
		showcard(stack[poss3[n],poss2[n]]);
		writeln(' in stack ',poss3[n],' to stack ',poss4[n]);
		end;
	if (poss1[n]=2) AND (poss2[n]=1) AND (reservlen[poss3[n]]>0) then begin
		write(n,'. All face-up cards (from ');
		showcard(stack[poss3[n],poss2[n]]);
		writeln(') in stack ',poss3[n],' to stack ',poss4[n]);
		end;
	if (poss1[n]=2) AND (poss2[n]=1) AND (reservlen[poss3[n]]=0) then begin
		write(n,'. Empty stack ',poss3[n],' (from ');
		showcard(stack[poss3[n],poss2[n]]);
		writeln(') to stack ',poss4[n]);
		end;
	if poss1[n]=3 then begin
		write(n,'. Put top discard ');
		showcard(discard[discardlen]);
		writeln(' onto stack ',poss2[n]);
		end;
	if poss1[n]=4 then begin
		write(n,'. Raise ');
		showcard(stack[poss2[n],stacklen[poss2[n]]]);
		writeln(' from stack ',poss2[n],' to build-up pile.');
		end;
	if poss1[n]=5 then begin
		write(n,'. Raise top discard ');
		showcard(discard[discardlen]);
		writeln(' to build-up pile.');
		end;
	end;
if movesavail=0 then writeln('You have no valid moves');
write('Choice? (0=Quit, -1=see tableau only, -2=moves only, -3=discard pile, -4=save)');
end;

function requestedmove:integer;
var	n,i:integer;
begin
if fast and (playmode=2) then begin readln; i:=1; end else begin
n:=movesavail;{*will always be >0 in calls to this function*}
i:=n+1;
while ((i<1) or (i>n)) do begin
	readln(i);
	if i=0 then begin
		writeln('OK, Goodbye.');
		movesavail:=0;i:=1;n:=1;
		end;
	if i=-1 then begin
		displaytableau;
		gotoxy(1,22);write('Hit RETURN to return to joint display');readln;
		displaymoves;
		end;
	if i=-2 then begin
		ClrScr;
		displaymoves;
		readln(i);
		if (i<1) or (i>n) then begin displaytableau;displaymoves; end;
		end;
	if i=-3 then begin
		ClrScr;
		showdiscard;
		displaytableau;
		displaymoves;
		end;
	if i=-4 then begin
		if (playmode=2) and not fast then savegame 
			else writeln('Sorry, not available in this mode.');
		displaytableau;
		displaymoves;
		end;
	if (i<-4) or (i>n) then writeln('Invalid move!');
	end;
end;
requestedmove:=i;
end;

procedure makemove(i:integer);
begin
	if poss1[i]=0 then makemove0;
	if poss1[i]=1 then makemove1(poss2[i], poss3[i]);
	if poss1[i]=2 then makemove2(poss2[i], poss3[i],poss4[i]);
	if poss1[i]=3 then makemove3(poss2[i]);
	if poss1[i]=4 then makemove4(poss2[i]);
	if poss1[i]=5 then makemove5;
end;

procedure fitcurve; {*this is a kludge*}
var 	x1,x2,x3,x4,a,b,c:real;
	i:integer;
begin
x1:=0;x2:=0;x3:=0;x4:=0;
for i:=0 to 51 do begin
	if scorestats[i]=0 then x4:=-1 else x4:=ln(scorestats[i]);
	x1:=x1+x4;
	x2:=x2+x4*ln(i+1);
	x3:=x3+x4*(i+1);
	end;
a:=0.43484*x1-0.22354*x2+0.00968*x3;
b:=-0.22354*x1+0.14051*x2-0.00751*x3;
c:=0.00968*x1-0.00751*x2+0.00049*x3;
writeln('Best fit is: constant=',a,', coeff of ln(i+1) is ',b,',');
writeln('coeff of (i+1) is ',c);
writeln;writeln;
for i:=0 to 51 do write(round(exp(a+b*ln(i+1)+c*(i+1))),' ');
end;

procedure tallystats;
var i,temp:integer;
begin
temp:=0;
for i:=1 to NUMSUITS do temp:=temp+buildlen[i]; {*a linear func. of newscore*}
scorestats[temp]:=scorestats[temp]+1;
if temp=NUMCARDS-3 then savegame;
Gotoxy(1,1);
for i:=0 to NUMCARDS do
	if scorestats[i]=0 then write('.') else write(scorestats[i],' ');
Gotoxy(1,5);
writeln(gamesplayed-scorestats[NUMCARDS], ' losses and ',scorestats[NUMCARDS],' wins so far. ');
writeln('Total: ',gamesplayed,'; win ratio: ',scorestats[NUMCARDS]/gamesplayed);
temp:=0;
for i:=0 to NUMCARDS do temp:=temp+i*scorestats[i];
writeln('Net expected game value is ', CARDVALU*(temp/gamesplayed)-NUMCARDS);
writeln('Frequencies are ');
for i:=0 to NUMCARDS do write(scorestats[i]/gamesplayed,' ');
{*fitcurve;*}
writeln;
writeln('Hit  Q  to interrupt');
end;

procedure playagame;
var i:integer;
begin
deal;
if playmode < 3 then begin
	writeln('Beginning new round.');
	writeln('Hit RETURN when ready to see the deal, ^C to quit.');
	readln;
	end;
movesavail:=1;
while movesavail>0 do begin
	findmoves;
	if (movesavail>0) and not needinput then i:=1;
	if (movesavail>0) and needinput then begin
		displaytableau;
		displaymoves;
		i:=requestedmove;
		end;
	if (movesavail>0) then makemove(i);
	end;
if playmode < 3 then begin
	writeln('You are out of moves, the game is over.');
	if newscore=CARDVALU*NUMCARDS then writeln('Congratulations, you won fully');
	totscore:=totscore+newscore;
	writeln('Your total score so far today is ',totscore);
	end;
if playmode=3 then tallystats;
end;

procedure createdata;
var i,j,k:integer;
begin
	ClrScr;
	for i:=0 to NUMCARDS do scorestats[i]:=0;
	gamesplayed:=0;
	while (gamesplayed>=0) and NOT KeyPressed do playagame; {*neg numbers indicate overflow*}
{*	for i:=0 to NUMCARDS do write(outdata,scorestats[i],', ');*}
{*replace with kludge*}
	for j:=0 to 4 do begin
	    write(outdata, 10*j+10,' data ');
	    for k:=0 to 10 do begin
		i:=11*j+k;
		if i<=NUMCARDS then write(outdata,scorestats[i],', ');*}
		end;
	    writeln(outdata);
	    end;
{*end kludge*}
	writeln(outdata);
end;

{*******************************main loop follows***************************}

begin {*main loop*}
initialize;
if playmode < 3 then begin
{$C+} {*needed to make ctrl-C work *}
	while totscore> minscore do playagame;
	writeln('You have used up all the money I trust you with. Sorry.');
	end;
if playmode=3 then begin
	repeat createdata; until KeyPressed;
	close(outdata);
	end;
end.

{****************************************************************************}

Rules synopsis:
	This is a one-player game
	52 cards of four suits (in two colors) are dealt into piles: 
	(a) one each (face up) into 7 stacks
	(b) 0,1,...,6 more (face down) into 7 reserves
	(c) remainder (24) face down into a fraw pile
	(d) none in a discard pile
	(e) none into 4 build piles.
Player makes a sequence of moves until no legitimate moves remain or
none is chosen. Score -52 to begin game, plus +5 for each card in build
piles at end.
	Legal moves are the following:
	(a) move top card from draw pile to top of discard pile (face up)
	(b) move top card from discard pile to top of any stack if either
	  (1) card is a King and stack is empty
	  (2) card rank is one less than the rank of the top card in the stack,
		and is of the opposite color
	(c) move top card from any build pile to top of any stack under either
		of these same conditions
	(d) move any card from any stack to top of any other stack under
		either of these conditions; all cards above it in the stack
		also move
	(e) move top card from any stack to any build pile if either
	   (1) card is an Ace and build pile is empty
	   (2) card rank is one more than the rank of the top card in the
		build pile and is of the same suit
	(f) move top card from discard pile to any build pile in these
		two conditions.
	If moves (d) or (e) are used and the stack becomes empty, the top
	card from the corresponding reserve is turned (face up) into the stack.
	Appropriate statements must be made here if a pile is empty.
Moves are irreversible, although Windows version allows the most recent move
to be undone if it has not involved turning a card face up. This is not
permitted in this program.

TODO list:

There are versions of SOLITAIRE not encoded here.
Strategy not at all honed yet.
Ought to give more data about strategy -- e.g. print evaluations, make
      suggestions for human players, etc.


Experts (playmode=1) know these:
Ace, 2's stay glued to build-up piles
Kings don't move from one empty slot to another
Take the only move if only one exists
Only move partial stacks if the revealed card can be raised to build-up pile.
Discard -> Buildup whenever possible (move to stacks later if nec.)
Don't completely empty a pile if there are no kings around unless it _and its
	successor_ can immediately be put into build-up piles.
(seems a little tricky - might be occasions when we want to move to a B_U early)

A semi-expert (playmode=2 and, mostly, 3) does these:
Always do a partial stack xfer to allow a revealed card to be raised.
Always raise to buildup when possible.
Never bring down -- (hmmm: Almost ?)
Always take an all-faceup transfer between stacks (hmm: which of several?)
	unless it's a base king to an empty spot.
Overriding this last: always take a discard to a stack when possible