#!/usr/bin/perl -w

# klondike.tk - Play Klondike (standard solitaire)
#
# Copyright 1999 Amir Karger (karger@post.harvard.edu)
#
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#

use strict;
use Games::Cards;
use Getopt::Std;

srand();

use vars qw($opt_g);

getopts('g');
my $Is_GUI = 0;
if ($opt_g) {
    eval "use Tk";
    die "$@\nGUI is not possible. Fix above error or use text mode.\n\n" if $@;

    # Otherwise, use Tk worked!
    $Is_GUI = 1;
    require Tk::Dialog;
    require Tk::DialogBox;
    require Tk::ROText;
    require Games::Cards::Tk;
}

# Main variables
my $Klondike; # the game object
my $Save_Deck; # $Deck is copied from this; used for restart
my $Deck; # the deck we're using in the game
my %Foundations; # the four piles we're trying to fill
my @Tableau; # the table, where most of the play happens
my $Tableau_Size = 7; # number of piles in tableau
my $Stock; # cards in our hand
my $Waste; # cards go from stock to waste
my $Cards_From_Stock = 3; # how many stock cards to take at a time
my $Undo; # Games::Cards::Undo object

my ($mw, $c); # GUI Main window, Canvas

my $Error; # current error message

######################################################################
# SETUP THE GAME
# Create the game and the game deck
# Use the default deck (standard suits, cards, & card values)
my $class_prefix = $Is_GUI ? "Games::Cards::Tk::" : "Games::Cards::";
my $class = $class_prefix . "Game";
$Klondike = $class->new;

$class = $class_prefix . "Deck";
$Save_Deck = $class->new($Klondike, "Save Deck");

# Initialize lots of stuff (including GUI if nec.)
&New_Game;

######################################################################
# Now play

if ($Is_GUI) {
    # This automatically implements a turn-loop
    &MainLoop;

} else { # TUI
    while (1) {
	&print_game;

	# If we got an error on the last turn, print the game status *first*,
	# then print the error right before the prompt (so that the reader will
	# see it)
	if ($Error) { print "$Error\n\n"; }

	# Ask player what to do
	print "Command (h for help) : ";
	my $input = <STDIN>; chomp($input); $input =~ s/\s*//g;

	# Do it
	&do_command ($input);
    } #end while (loop over turns)
}

exit;

######################################################################
# Create the deck, columns, etc.
# Called with arg "restart" if we're restarting the same game (i.e. we
# don't want the deck shuffled)
sub setup_game
{
    my $restart = shift;

    # use Tk stuff?
    my $class_prefix = $Is_GUI ? "Games::Cards::Tk::" : "Games::Cards::";

    unless ($restart) {
	print "Shuffling the deck.\n";
	$Save_Deck->shuffle;
    }

    $Deck = $Save_Deck->clone($Klondike, "Deck");

    # Deal out the Tableau
    my $s = $class_prefix . "Stack";
    @Tableau = (); # erase Tableau from last game, if any
    foreach my $i (1 .. $Tableau_Size) {
	my $column = $s->new ($Klondike, "Column $i", $i);
	$Deck->give_cards($column, $i);
	# Make sure all columns are face down, with top card face-up
	$column->face_down;
	$column->top_card->face_up;
	push @Tableau, $column;
    }

    # Create the empty Foundations
    foreach (@{$Klondike->{"suits"}}) {
	$Foundations{$_} = $s->new ($Klondike, ucfirst($_) . " Pile", lc $_); 
    }

    # Stock has what's left in the deck, wastepile starts out empty
    my $q = $class_prefix . "Queue";
    $Stock = $q->new ($Klondike, "Stock", "s");
    $Deck->give_cards($Stock, "all");
    $Stock->face_down;

    $Waste = $s->new ($Klondike, "Waste", "w");

    # Initialize the Undo engine with infinite size (no size arg. given to new)
    $Undo = new Games::Cards::Undo;
} # end sub setup_game

sub do_command {
    my $command = shift;
    $Error = "";
    for ($command) {

	# Move top card of the waste pile to a column OR move one or
	# more cards from a column to another column
        if (/^([w\d])(\d)$/i) {
	    &move_to_column($1, $2);
	    $Undo->end_move;

	# Move a card to (correct) foundation from waste or from a column
        } elsif (/^([w\d])f$/i) {
	    &move_to_foundation($1);
	    $Undo->end_move;
	    &check_win();

	# waste to stock
	} elsif (/^ws$/i) {
	    if ($Stock->size) {
	        $Error = "ERROR! Stock isn't empty yet!";
		return;
	    }
	    $Waste->give_cards($Stock, "all");
	    $Stock->face_down;
	    $Undo->end_move;

	# stock to waste
	# Take three cards
	} elsif (/^sw?$/i) {
	    #print $Stock->print("short");
	    my $size = $Stock->size or
	        $Error = "ERROR! Stock is empty.", return;
	    # Take 3 cards at a time. But just take 2 if only two are left
	    my $number = ($size < $Cards_From_Stock) ?
	                  $size : 
			  $Cards_From_Stock;
	    $Stock->give_cards($Waste, $number);
	    $Waste->face_up; # really only need to face_up last $number cards
	    $Undo->end_move;

	# finish the game?
	} elsif (/^z/i) {
	    &Finish;

	# restart
	} elsif (/^o/i) {
	    &New_Game("restart") if &New_Game_Prompt;

	# undo
	} elsif (/^u/i) {
	    &Undo;

	# redo
	} elsif (/^r/i) {
	    &Redo;

	# help
	} elsif (/^h/i) {
	    &Help;

	# start a new game (abandon this one)
	} elsif (/^n/i) {
	    &New_Game if &New_Game_Prompt;

	# quit game
	} elsif (/^q/i) {
	    &Quit;

	# Handle some errors
	} elsif (/^.s/) {
	    $Error = "You can only transfer from the waste pile to the stock";
	} elsif (/^.w/) {
	    $Error = "You can only transfer to the waste pile from the stock";
	} else {
	    $Error = "ERROR! unknown command. Try again (h for help)"
	} # end case if

    } # end big case statement
}

######################################################################

sub move_to_column {
# Move a card from Stack arg0 to column arg1
# Arg0 can be a column number or "w" for the waste pile
#
# Return 1, or 0 for error
    my ($from, $to) = @_;
    my ($donor, $receiver);

    # From which Stack are we taking cards?
    if ($from =~ /w|\d/) {
	$donor = $Klondike->get_cardset_by_nickname($from);
	die "illegal column $from in sub move_to_column\n" unless $donor;
    } else {die "Unknown first arg '$from' to sub move_to_column!\n";}
    unless ($donor->size) { $Error = "ERROR! No cards to move!"; return 0; }

    # To which Stack are we transferring cards?
    die "Unknown second arg '$to' to sub move!\n" unless $to =~ /\d/;
    $receiver = $Klondike->get_cardset_by_nickname($to);
    unless ($receiver) { $Error = "ERROR! Illegal column $to!"; return 0; }


    # If we're going column to column, search through the (face-up cards
    # in the) column for the card that can legally move to the other column,
    # then transfer that card and all cards below it.
    #    If we're going from the waste pile to a column, just take the top card
    # and confirm that it's allowed to transfer
    my @cards;
    if ($from =~ /\d/) {
	# Reverse so that we go from the lowest number on the pile upward. This
	# allows us to count the number of cards we're transferring
        @cards = reverse(grep {$_->is_face_up} @{$donor->cards});
    } else {
        @cards = ($donor->top_card);
    }

    my $allowed = 0; # are we allowed to transfer?
    my $transferred = 0; # number of cards to transfer
    my $receiver_card = $receiver->top_card;
    foreach my $card (@cards) {
	$transferred++;
	# card must be different color & next lower card
	# Or a king can go onto an empty column
	if ($receiver_card) {
	    $allowed = ($receiver_card->value == $card->value + 1 &&
			$receiver_card->color ne $card->color);
	} else {
	    $allowed = $card->name("long") eq "King";
	}

	last if $allowed;
    }

    unless ($allowed) { $Error = "ERROR! Illegal move!"; return 0; }

    # Now actually transfer the card(s)
    $donor->give_cards($receiver, $transferred);

    # After removing a card from a column, make sure the next card in
    # that column is face up
    my $a;
    if ($from =~ /\d/ && ($a = $donor->top_card)) {$a->face_up}

    return 1;
} # end sub move_to_column

sub move_to_foundation {
# Move a card from arg0 to the correct foundation for that suit
# Arg0 can be a column number or "w" for the waste pile
#
# Return 1, or 0 for error
    my ($from) = @_;
    my ($donor, $receiver);

    # From which Stack are we taking cards?
    if ($from =~ /w|\d/) {
	$donor = $Klondike->get_cardset_by_nickname($from);
	die "illegal column $from in sub move_to_foundation\n" unless $donor;
    } else {warn "Unknown first arg '$from' to sub move_to_foundation!\n";}
    unless ($donor->size) { $Error = "ERROR! No cards to move!"; return 0; }

    my $donor_card = $donor->top_card;

    # To which Stack are we transferring cards?
    my $to = lc($donor_card->suit("long"));
    $receiver = $Klondike->get_cardset_by_nickname($to);
    die "Unknown suit in sub move_to_foundation!\n" unless $receiver;

    my $allowed = 0; # are we allowed to transfer?
    my $receiver_card = $receiver->top_card;
    if ($receiver_card) {
	$allowed = ($receiver_card->value == $donor_card->value - 1);
    } else { # empty foundation
	$allowed = $donor_card->name("long") eq "Ace";
    }

    unless ($allowed) { $Error = "ERROR! Illegal move!"; return 0; }

    # Now actually transfer the card
    $donor->give_cards($receiver, 1);

    # After removing a card from a column, make sure the next card in
    # that column is face up
    my $a;
    if ($from =~ /\d/ && ($a = $donor->top_card)) {$a->face_up}

    return 1;
} # end sub move_to_foundation

# Try to place all remaining cards on the foundation
sub Finish {
    if ($Stock->size) {
	$Error = "ERROR! Stock must be empty to finish";
	return;
    }
    foreach my $col (@Tableau) {
	if (grep {$_->is_face_down} @{$col->cards}) {
	    $Error = "ERROR! All cards must be face up to finish";
	    return;
	}
    }

    my $did_move;
    do {
	$did_move = 0;
	foreach my $j (1..@Tableau, "w") {
	    if (&move_to_foundation($j)) {
		$did_move = 1;
		$Undo->end_move;
		# GUI will print 'illegal move' since we're trying
		# to do lots of illegal moves. Erase the error.
		$Error = "";
	    }
	}
	if ($Is_GUI) {
	    $c->update;
	} else {
	    &print_game; 
	}
	sleep(1);
	&check_win;
    } while $did_move == 1;

    # If we got here, we didn't win
    $Error = "ERROR! Unable to finish!\n";
} # end sub Finish

sub check_win {
    my $a;
    
    if ((grep {$a=$_->top_card and $a->name("long") eq "King"} 
        (values %Foundations)) == 4) {
	if ($Is_GUI) {
	    # TODO change this to use &New_Game_Prompt
	    my $button = $mw->Dialog(
		-text => "You have won! Play another game?",
		-buttons => ["New game", "Quit"],
		-default_button => 'New game')->Show;
	    &Quit(qw/-prompt no/) if $button eq 'Quit';

	    # Otherwise, start a new game
	    &New_Game;
	    return;
	} else {
	    print "You have won!\n";
	    if (&New_Game_Prompt) {
	        &New_Game;
	    } else {
	        exit;
	    }
	}
    }
}

######################################################################
# Game actions other than moving cards around
# Returns true if you should start a new game
sub New_Game_Prompt {
    if ($Is_GUI) {
	return 1 unless defined $mw; # very first game

	return ($mw->Dialog(-text => "Start new game?",
		-buttons => [qw/OK Cancel/],
		-default_button => 'OK')->Show
		ne 'Cancel');
    } else {
	print "Start a new game? (y/n): ";
	my $a = <STDIN>;
	return ($a =~ /^\s*y/i);
    }
}

sub New_Game {
    my $restart = shift;
    die "setup_game called with unknown arg $restart\n" if defined $restart
        && $restart ne "restart";
    &erase_mark if $Is_GUI and defined $mw;

    # Create new deck
    &setup_game ($restart);

    $Error = $Is_GUI ? "Welcome!" : "Welcome! Type h for help, q to quit";

    if ($Is_GUI) {
	if (defined $mw) {
	    # delete all the cards prior to creating a new deck
	    $c->delete('card'); 
	} else { # very first game
	    &init_GUI; # note that this must be called *after* setup_game
	}

	# Redraw all the cards, put them where they belong...
	&setup_GUI;
    }
}

sub Undo
{
    &erase_mark if $Is_GUI;
    if ($Undo->undo) {
	# if no error, make sure to erase any existing error message (like
	# "can't redo any more")
	$Error = ""; 
    } else {
        $Error = "ERROR! Can't undo any more";
    }
}

sub Redo
{ 
    &erase_mark if $Is_GUI;
    if ($Undo->redo) {
	# if no error, make sure to erase any existing error message (like
	# "can't redo any more")
	$Error = ""; 
    } else {
        $Error = "ERROR! Can't redo any more";
    }
}

sub Help {
my $Usage =<<"ENDUSAGE";
  $0 - play "klondike", aka standard solitaire

  - Columns are 1 to 7, plus the Waste pile, Foundations and Stock

  - Try to build piles of Ace through King of each suit in the Foundations.

  - You can move the top card from the Waste pile onto the
  corresponding Foundation pile or onto another column. Alternatively, you
  can move all, some, or one of the cards in a column onto another column.

  - You can move a card onto the next highest card of a different color, so,
  e.g. a red ten can go on a black Jack. Only a King can be moved onto an
  empty column.

  - Take cards 3 at a time from the Stock into the Waste pile.

  - Commands are one or two letters or numbers (from 1 to 7)

    23 moves one or more cards from column 2 to 3
    2f moves a card from column 2 to the foundation pile of the right suit
    wf moves a card from the waste pile to the foundation pile of the right suit
    w2 moves a card from the waste pile to column 2
    ws moves the whole waste pile back into the stock
    sw (or just s) moves from the stockpile to the waste pile
    z attempts to finish the game. The stock must be empty.

    u  undo last move (multiple undo/redo works)
    r  redo the last move you undid
    o  start the game Over with the same deck
    n  start a new game with a new deck

    q  quits
    h  prints this help
ENDUSAGE

    if ($Is_GUI) {

my $GUI_Usage = <<GUIUSAGE;
- Of course, you can click on things instead in the GUI version. Click:

    a card and then the column, or foundation you want to move the card to
    the stock pile to move cards to the waste pile
    buttons at the bottom of the window to do things

- To replenish the stock when empty, click on waste, then stock
GUIUSAGE

	my $small_font = "-*-Times-Medium-R-Normal--*-120-*-*-*-*-*-*";

	# Partially copied from tktk
	# Note that I have no idea if this is a good way to do this,
	# but it works!
	my $di = $mw->DialogBox(-title => "Help",
		-buttons => [qw/OK/],
		-default_button => 'OK');
	my $f = $di->add('Frame')->pack();
	my $text = $f->Scrolled('ROText',
	    -scrollbars => 'e',
	    -wrap       => 'word',
	    -width      => 60,
	    -height     => 25,
	    -font       => $small_font,
	    -setgrid    => 1,
	)->pack(-expand => 1, -fill => 'both');
	$text->tagConfigure('title',
	    -font => '-*-Times-Bold-R-Normal--*-180-*-*-*-*-*-*',
	);
	my $instr = "$Usage\n$GUI_Usage";
	my @lines = split(/(\n{2,})/,$instr);
	my $concat = 0;
	# make the paragraphs into one long line
	$instr = join("",map {s/\n\s*/ /g if /^\s*-/; $_} @lines);

	$text->insert('end', "Free Cell Instructions\n", 'title');
	$text->insert('end', $instr);

	$di->Show;
    } else {
	print $Usage;
	print "\nType RETURN to continue\n";
	<STDIN>;
    }
} # end sub Help

sub Quit
{
    if ($Is_GUI) {
	my %args = @_;
	$args{-prompt} ||= 'yes';
	if ($args{-prompt} eq 'no' ||
		$mw->Dialog(-text => "Abandon game?",
		    -buttons => [qw/OK Cancel/],
		    -default_button => 'OK')->Show
		eq 'OK') {
	    $mw->destroy;
	} # else return
    } else {
	print "Are you sure you want to quit? (y/n): ";
	my $a = <STDIN>;
	if ($a =~ /^\s*y/i) {
	    print "Bye!\n";
	    exit;
	}
    }
}

######################################################################
# GUI-specific stuff
sub init_GUI {

    $mw = new MainWindow;
    $mw->title("Klondike");
    {
	my $f = $mw->Frame(-labelVariable => \$Error,
	    -labelPack => [qw/-side top -anchor w -fill x -expand 0/],
	    )->pack(qw/-side bottom -expand 0 -fill x/);
	$f->Button(-text => 'New Game', -command => sub {&do_command("n")},
	    )->pack(qw/-side left/);
	$f->Button(-text => 'Start Over', -command => sub {&do_command("o")},
	    )->pack(qw/-side left/);
	$f->Button(-text => 'Finish', -command => sub {&do_command("z")},
	    )->pack(qw/-side left/);
	$f->Button(-text => 'Undo', -command => sub {&do_command("u")},
	    )->pack(qw/-side left/);
	$f->Button(-text => 'Redo', -command => sub {&do_command("r")},
	    )->pack(qw/-side left/);
	$f->Button(-text => 'Help', -command => sub {&do_command("h")},
	    )->pack(qw/-side left/);
	$f->Button(-text => 'Quit', -command => sub {&do_command("q")},
	    )->pack(qw/-side right/);
    }

    # Create the canvas everything sits on
    $c = $mw->Scrolled('Canvas', -scrollbars => 'osoe',);
    $Klondike->set_canvas($c);

    # Get the card gifs
    $Klondike->load_card_images;

    # TODO get rid of constants, use multiples of card size
    $c->configure(
	-scrollregion => ['0','0','750','600'],
	-height => 450,
	-width => 680,
    );
    $c->pack(qw/-side top -expand y -fill both/);

    # Card with bounding rectangle
    # TODO cards don't HAVE bounding rectangles any more!
    my $Card_Border = 2;
    my $Card_Rect_X = $Klondike->card_width + $Card_Border;
    my $Card_Rect_Y = $Klondike->card_height + $Card_Border;
    # Columns 1-8
    # Add width between cards
    my $Column_X = $Card_Rect_X + 10;
    # Y coordinate where Columns start
    my $Column_Start_Y = $Card_Rect_Y + 20;

    my $Pile_Size_X = $Card_Rect_X + 4;
    my $Pile_Size_Y = $Card_Rect_Y + 4;

    # Print tableau
    my $i = 0;
    foreach my $col (@Tableau) {
	my $s = $col->name;
	my ($x1, $y1) = ($i*$Column_X + 2, $Column_Start_Y); 
        my ($x2, $y2) = ($i*$Column_X + 2 + $Card_Rect_X, 820);
	$c->createRectangle($x1, $y1, $x2, $y2,
	    -outline => 'seagreen',
	    -fill => 'green3',
	    -tags => ["column", "set:$s"]);
	$i++;
    }

    # print stock
    my ($x1, $y1, $x2, $y2) = (2,2, $Pile_Size_X-1, $Pile_Size_Y-1);
    my $s = $Stock->name;
    $c->createRectangle($x1, $y1, $x2, $y2,
	    -outline => 'seagreen', -fill => 'green3', 
	    -tags => ['stock', "set:$s"],
	    );

    # Draw waste pile (big enough for 24 cards)
    $x1 += $Column_X;
    $x2 = $i*$Column_X;
    $s = $Waste->name;
    $c->createRectangle($x1, $y1, $x2, $y2,
	    -outline => 'seagreen', -fill => 'green3', 
	    -tags => ['waste', "set:$s"],
	    );

    # Draw foundations
    $x1 = $i*$Column_X+10; $x2 = $x1 + $Pile_Size_X;
    $y1 = 2; $y2 = $y1+$Pile_Size_Y;
    foreach my $col (values %Foundations) {
	my $s = $col->name;
	$c->createRectangle($x1, $y1, $x2, $y2,
		-outline => 'seagreen', -fill => 'green3', 
		-tags => ['foundation', "set:$s"],
		);
	$y1 += $Pile_Size_Y + 8;
	$y2 += $Pile_Size_Y + 8;
    }

    # All these clickings just lead to calling sub click with correct argument
    $c->bind('card', '<1>', \&click_pile);
    $c->bind('column', '<1>', \&click_pile);
    $c->bind('foundation', '<1>', \&click_pile);
    $c->bind('stock', '<1>', \&click_pile);

    $mw->bind('<Key-f>', sub {click('spades');});
    foreach my $k (qw(1 2 3 4 5 6 7 w s)) {
	$mw->bind("<Key-$k>", sub {click($k);})
    }
    
    $mw->bind('<Key-KP_Add>', sub {click('spades');});
    $mw->bind('<Key-F33>', sub {click('1');});
    $mw->bind('<Key-Down>', sub {click('2');});
    $mw->bind('<Key-F35>', sub {click('3');});
    $mw->bind('<Key-Left>', sub {click('4');});
    $mw->bind('<Key-F31>', sub {click('5');});
    $mw->bind('<Key-Right>', sub {click('6');});
    $mw->bind('<Key-F27>', sub {click('7');});

    foreach my $k (qw(h n o q r u z)) {
	$mw->bind("<Key-$k>", sub {&do_command($k)})
    }
}

# Called (after init_GUI) each time a new game is started
sub setup_GUI {
    # How many pixels show in covered-up card
    my $Delta_Y = 30; # For columns
    my $Delta_X = 18; # For waste pile

    # Border around cards in the column
    my $Border_X = 2;
    my $Border_Y = 2;

    foreach my $col (@Tableau) {
	$col->attributes({
	    "delta_y" => $Delta_Y,
	    "border_y" => $Border_Y,
	    "border_x" => $Border_X,
	});

	# Draw all the cards in the column
	foreach my $card (@{$col->cards}) {
	    $card->draw;
	}
	$col->redraw;
    }

    # Draw cards in the stock
    $Stock->attributes({
	"border_y" => $Border_Y,
	"border_x" => $Border_X,
    });
    foreach my $card (@{$Stock->cards}) {
	$card->draw;
    }
    $Stock->redraw;

    foreach my $col (values %Foundations) {
	$col->attributes({
	    "border_y" => $Border_Y,
	    "border_x" => $Border_X,
	});
    }

    $Waste->attributes({
	    "delta_x" => $Delta_X,
	    "border_y" => $Border_Y,
	    "border_x" => $Border_X,
    });
}


# process a "click" on the specified column/freecell/foundation
sub click {
    my $col = shift;
    $Error = '';
    my $marked = $Klondike->get_marked_card;
    if (defined $marked) { # a card is already selected
	# which column has the marked card in it?
	my $set = $marked->owning_cardset;
	my $old_col = $set->nickname;
	$marked->unmark;
	if ($old_col ne $col) { # clicking on marked card just unmarks it
	    if ($col =~ /spades|clubs|hearts|diamonds/) {
	        $col = "f"; # move to foundation
	    }
	    my $command = "$old_col$col";
	    &do_command("$command");
	}
    } else { # select a card to move
	if ($col =~ /spades|clubs|hearts|diamonds/) {
	    $Error = "You may not move a card from the foundation";
	    return;
	} elsif ($col eq 's') {
	    &do_command("s");
	} else {
	    my $stack = $Klondike->get_cardset_by_nickname($col);
	    unless ($stack) { $Error = "Weird column '$col'."; return; }
	    my $top = $stack->top_card;
	    unless ($top) { $Error = "No cards in that column."; return; }
	    $top->mark;
	}
    }
}

sub click_pile
{
    my $set = $Klondike->get_clicked_cardset;
    my $col = $set->nickname;
    &click($col);
}

sub erase_mark {
    my $marked = $Klondike->get_marked_card;
    $marked->unmark if defined $marked;
}

######################################################################
# TUI stuff
sub print_columns {
# print the columns in rows (2-D display)
# args are a list of CardSets
    my @columns = @_;
    # Print from bottom to top...
    my $index = (sort {$a <=> $b} (map {$_->size} @columns))[-1] -1;
    print " ",join("     ",(1..@columns)),"\n";
    print join("   ",("---") x @columns),"\n";
    foreach (0 .. $index) {
	my $to_print = "";
        foreach my $column (@columns) {
	    my $a = ${$column->cards}[$_];
	    my $p = defined $a ? $a->print("short") : "    ";
	    $to_print .= "$p  ";
	} # end loop over one row of each column
	print "$to_print\n";
    } # end loop over all rows
    print "\n";
} # end sub print_columns

sub print_game {
# print out the current status in solitaire
    print "\n\n\n", "-" x 50,"\n";
    print "Stock: ", "*" x $Stock->size, "\n";
    print $Waste->print("short"),"\n";
    print "Foundations:   ";
    foreach (keys %Foundations) {
	my $set = $Foundations{$_};
        my $to_print = $set->size ? 
	    $set->top_card->print("short") :
	    "(none)"; 
	print "$to_print   ";
    }
    print "\n\n";

    &print_columns(@Tableau);
} # end sub print_game