#!/usr/bin/perl

# TODO:
# change way we redraw cards...
# timer
# better UI (toolbar?)
# clean up code
# make a better squiggle
# make better cards
# more status bar stuff
# client/server

# BUGS:
# some times the blinks stick if another timer is set before the other
# one expires... make blinks faster? -> .1 second

use Tk;

my $title = "Perl/Tk SET";
my $version = "0.1";

# UI components
my $top;
my $canvas;
my $menu_bar;
my $menu_file;
my $menu_play;
my $menu_debug;
my $table_frame;
my $status_bar;
my $status_cards_left;

my @all_cards;
my @all_shapes;
my @all_coords;
my @in_play_cards;
my $deck_index = 0;

my %selected;
my $set_count = 0;

my $hintsP;
my $blink_timer;

create_ui();
create_all_cards();
MainLoop();

sub get_color_idx($) { return int(shift() / 27); }
sub get_shape_idx($) { return int((shift() % 27) / 9); }
sub get_count_idx($) { return int(((shift() % 27) % 9) / 3); }
sub get_shade_idx($) { return int(((shift() % 27) % 9) % 3); }

sub get_color($) {
    return ("red", "green", "purple")[get_color_idx(shift)];
}
sub get_shape($) {
    return ("squiggle", "oval", "diamond")[get_shape_idx(shift)];
}
sub get_count($) {
    return get_count_idx(shift) + 1;
}
sub get_shade($) {
    return ("solid", "clear", "shaded")[get_shade_idx(shift)];
}

sub get_pos($) {
    my $n = shift;
    my ($i, $match_idx);
    for ($i = 0; $i < @in_play_cards; $i++) {
	if ($in_play_cards[$i] == $n) {
	    $match_idx = $i;
	    last;
	}
    }

    if (defined $match_idx) {
	return $match_idx;
    } else {
	return -1;
    }
}

sub num_cards_left {
    return @all_cards - $deck_index;
}

sub fisher_yates_shuffle(@) {
    my @arrays = @_;
    my $i;
    my $k;
    my $r = $arrays[0];
    
    for ($i = @$r; --$i; ) {
        my $j = int rand ($i+1);
        next if $i == $j;

	for ($k = 0; $k < @arrays; $k++) {
	    my $r = $arrays[$k];
	    @$r[$i, $j] = @$r[$j, $i];
	}
    }
}

sub blink_cards($@) {
    my @oldcolors;
    my $newcolor = shift;
    foreach (@_) {
	push @oldcolors, $canvas->itemcget("card back $_", '-fill');
	$canvas->itemconfigure("card back $_", '-fill' => $newcolor);
    }
    if ($blink_timer) { $blink_timer->cancel(); }
    $blink_timer = $canvas->after(100, [ sub {
	my ($roldcolors, $rcards) = @_;
	my $i;
	for ($i = 0; $i <= $#$roldcolors; $i++) {
	    $canvas->itemconfigure("card back " . $rcards->[$i],
				   '-fill' => $roldcolors->[$i]);
	}
    }, \@oldcolors, \@_]);
}

sub handle_click(@) {
    my $n = $_[1];
#    printf("clicked card %2i: %-6s %-8s %-6s %i at %i\n", $n, get_color($n),
#	   get_shape($n), get_shade($n), get_count($n), get_pos($n));

    if (get_pos($n) == -1) {
	print "DANG YOU... HOW DID YOU CLICK THIS CARD???\n";
	return;
    }
    if ($blink_timer) { $blink_timer->cancel(); }
    if ($selected{$n}) {
	delete $selected{$n};
	$canvas->itemconfigure("card back $n", '-fill' => 'white');
    } else {
	$selected{$n} = 1;
	$canvas->itemconfigure("card back $n", '-fill' => 'light blue');
    }

    my @sel = keys %selected;

    if ($hintsP && @sel == 2) {
	my %in_play;
	my $third;
	foreach (@in_play_cards) { $in_play{$_} = 1; }
	$third = third_card(@sel);
	if ($in_play{$third}) {
	    blink_cards("salmon1", $third);
	}
    }

    # if we've selected 3 cards, check them...
    if (@sel == 3) {

	if (is_set(@sel)) {
	    # set found

	    # increment set count and update status
	    $set_count++;
	    $status_num_sets->configure('-text' => 'Sets: ' . $set_count);

	    # hide the cards that were in the set
	    foreach (@sel) {
		$canvas->itemconfigure("card back $_", '-fill' => 'white');
		$canvas->itemconfigure("card $_", '-state' => 'hidden');
		$canvas->dtag("card $_", "dealt");
	    }

	    if (@in_play_cards != 12 || num_cards_left() < 3 ||
		draw_cards(3) == -1) {

		# if we currently have > 12 cards, we don't want to
		# draw any more

		# if we have < 12 cards, then we must not have any
		# more cards anyway...

		# else, try to draw cards... if fails, then there are
		# no more cards to draw

		# so, we just remove the selected cards from
		# @in_play_cards

		my @new_in_play_cards = ();
		foreach (@in_play_cards) {
		    next if $selected{$_};
		    push @new_in_play_cards, $_;
		}
		@in_play_cards = @new_in_play_cards;
	    } else {

		# drawing 3 cards succeeded, so move those cards in
		# the place of the 3 selected cards.

		blink_cards("gold1", @in_play_cards[($#in_play_cards-2)..
						    $#in_play_cards]);
		foreach (map { get_pos($_) } @sel) {
		    $in_play_cards[$_] = pop @in_play_cards;
		}
	    }

	    # redraw cards... CHANGE THIS
	    home_all_cards();
	    layout_cards(0, scalar(@in_play_cards));

	    if (!find_sets() && num_cards_left() == 0) {
		game_over();
	    }
	} else {
	    # not a set
	    foreach (@sel) {
		$canvas->itemconfigure("card back $_", '-fill' => 'white');
	    }
	}
	%selected = ();
    }
}

sub is_set(@) {
    ($c1, $c2, $c3) = @_;
    return $c3 == third_card($c1, $c2);
}

sub is_set_slow(@) {
    ($c1, $c2, $c3) = @_;
    return (compare_three(map { get_shape($_) } @_) &&
	    compare_three(map { get_color($_) } @_) &&
	    compare_three(map { get_count($_) } @_) &&
	    compare_three(map { get_shade($_) } @_));
}

sub compare_three(@) {
    ($v1, $v2, $v3) = @_;
    return ((($v1 eq $v2) && ($v1 eq $v3) && ($v2 eq $v3)) ||
	    (($v1 ne $v2) && ($v1 ne $v3) && ($v2 ne $v3)))
}

sub create_ui {
    $top = MainWindow->new();
    $top->title("$title version $version");

    $menu_bar = $top->Frame()->pack('-side' => 'top', '-fill' => 'x');

    $menu_file = $menu_bar->Menubutton('-text' => 'File',
				       '-relief' => 'raised',
				       '-borderwidth' => 2);
    $menu_file->pack('-side' => 'left',
		     '-padx' => 2);
    $menu_file->command('-label' => 'New',
			'-command' => \&new_game);
    $menu_file->separator();
    $menu_file->command('-label' => 'Quit',
			'-command' => sub { exit(0); });

    $menu_play = $menu_bar->Menubutton('-text' => 'Play',
				       '-relief' => 'raised',
				       '-borderwidth' => 2,
				       '-state' => 'disabled');
    $menu_play->pack('-side' => 'left',
		     '-padx' => 2);
    $menu_play->command('-label' => 'Deal 3 More',
			'-command' => \&draw_more_cards);

    $menu_debug = $menu_bar->Menubutton('-text' => 'Debug',
					'-relief' => 'raised',
					'-borderwidth' => 2);
    $menu_debug->pack('-side' => 'left',
		     '-padx' => 2);
    $menu_debug->command('-label' => 'in play?',
			 '-command' => sub {
			     foreach (@in_play_cards) { print "[$_] "; }
			     print "\n";
			 });
    $menu_debug->command('-label' => 'deck',
			 '-command' => sub {
			     foreach (@all_cards) { print "[$_] "; }
			     print "\n";
			     print "index: $deck_index\n";
			 });

    $menu_debug->command('-label' => '3rd card',
			 '-command' => sub {
			     my @sel = keys(%selected);
			     if (@sel == 2) {
				 print "third card: ";
				 print_card_text(third_card(@sel));
			     }
			 });
    $menu_debug->command('-label' => 'turn on hints',
			 '-command' => sub {
			     $hintsP = $hintsP ? 0 : 1;
			     print "hints $hintsP\n";
			 });
    $menu_debug->command('-label' => 'show a set',
			 '-command' => sub {
			     my @found = find_sets();
			     return if !@found;
			     my @first = @{$found[0]};
			     blink_cards("salmon1",
					 $first[0]->[0],
					 $first[1]->[0],
					 $first[2]->[0]);
			 });
    $menu_debug->command('-label' => 'show selected',
			 '-command' => sub {
			     print "selected:\n";
			     foreach (keys(%selected)) {
				 print_card_text($_);
			     }
			 });

    $status_bar = $top->Frame()->pack('-fill' => 'x',
				      '-side' => 'top');

    $status_cards_left = $status_bar->Label('-text' => ' ');
    $status_cards_left->pack('-fill' => 'none',
			     '-side' => 'left');
    $status_num_sets = $status_bar->Label('-text' => ' ');
    $status_num_sets->pack('-fill' => 'none',
			   '-side' => 'left');
    $status_misc = $status_bar->Label('-text' => ' ');
    $status_misc->pack('-fill' => 'x',
		       '-side' => 'right');

    $table_frame = $top->Frame()->pack('-fill' => 'both',
				       '-side' => 'top');

    $canvas = $table_frame->Canvas('-width' => 600,
				   '-height' => 360);
    $canvas->pack('-fill' => 'x');

}

sub create_card($) {

    my $n = shift;
    my $count = get_count($n);
    my $shape_type = get_shape($n);
    my $shade_type = get_shade($n);
    my $rshapes = [];
    my $rcoords = [];
    my $i;

    for ($i = 0; $i < 3; $i++) {
	my $shape;
	my $rshape_coords = [];

	if ($shape_type eq "oval") {
	    my ($y1, $y2);
	    if ($count == 1) {
		$y1 = 43;
		$y2 = 77;
	    } elsif ($count == 2) {
		$y1 = 20 + ($i * 46);
		$y2 = 54 + ($i * 46);
	    } elsif ($count == 3) {
		$y1 = 7 + ($i * 36);
		$y2 = 41 + ($i * 36);
	    }
	    
	    $shape = $canvas->createOval(7, $y1, 93, $y2,
					 '-outline' => get_color($n));
	} elsif ($shape_type eq "diamond") {
	    my ($y1, $y2, $y3);

	    if ($count == 1) {
		$y1 = 43;
		$y2 = 60;
		$y3 = 77;
	    } elsif ($count == 2) {
		$y1 = 20 + ($i * 46);
		$y2 = 37 + ($i * 46);
		$y3 = 54 + ($i * 46);
	    } elsif ($count == 3) {
		$y1 = 7 + ($i * 36);
		$y2 = 24 + ($i * 36);
		$y3 = 41 + ($i * 36);
	    }

	    $shape = $canvas->createPolygon(7, $y2, 50, $y1, 93, $y2, 50, $y3,
					    '-outline' => get_color($n));
	} elsif ($shape_type eq "squiggle") {
	    my ($y1, $y2, $y3, $y4, $y5);

	    if ($count == 1) {
		$y1 = 7 + 36;
		$y2 = 16 + 36;
		$y3 = 24 + 36;
		$y4 = 32 + 36;
		$y5 = 41 + 36;
	    } elsif ($count == 2) {
		$y1 = 20 + ($i * 46);
		$y2 = 29 + ($i * 46);
		$y3 = 37 + ($i * 46);
		$y4 = 45 + ($i * 46);
		$y5 = 54 + ($i * 46);
	    } elsif ($count == 3) {
		$y1 = 7 + ($i * 36);
		$y2 = 16 + ($i * 36);
		$y3 = 24 + ($i * 36);
		$y4 = 32 + ($i * 36);
		$y5 = 41 + ($i * 36);
	    }

	    $shape = $canvas->createPolygon(7, $y2, 29, $y1, 50, $y2, 60, $y3,
					    71, $y2, 82, $y2, 93, $y3, 93, $y4,
					    71, $y5, 50, $y4, 40, $y3, 29, $y4,
					    18, $y4, 7, $y3,
					    '-outline' => get_color($n));
	}

	if ($shade_type eq "solid") {
	    $canvas->itemconfigure($shape, '-fill' => get_color($n));
	} elsif ($shade_type eq "shaded") {
	    $canvas->itemconfigure($shape, '-fill' => get_color($n),
				   '-stipple' => 'gray25');
	} elsif ($shade_type eq "clear") {
	    $canvas->itemconfigure($shape, '-fill' => 'white');
	} 

	$canvas->addtag("card front $n", 'withtag', $shape);
	@$rshape_coords = $canvas->coords($shape);
	push @$rcoords, $rshape_coords;
	push @$rshapes, $shape;

	last if ($i + 1) == $count;
    }

    return ($rshapes, $rcoords);
}

sub create_all_cards {

    my $n;

    for ($n = 0; $n < 81; $n++) {
	my $card_back = $canvas->createRectangle(5, 5, 95, 115,
						 '-fill' => 'white',
						 '-outline' => 'black');

	$canvas->addtag("card back $n", 'withtag', $card_back);

	my ($rshapes, $rcoords) = create_card($n);

	$canvas->addtag("card $n", 'withtag', "card back $n");
	$canvas->addtag("card $n", 'withtag', "card front $n");

	$canvas->addtag("card", 'withtag', "card $n");

	$canvas->bind("card $n", "<ButtonPress>", [\&handle_click, $n]);

	push @all_cards, $n;
	push @all_shapes, $rshapes;
	push @all_coords, $rcoords;
    }

    $canvas->itemconfigure("card", '-state' => 'hidden');
}

sub new_game {
    my $i;
    my $tag;

    $deck_index = 0;
    @in_play_cards = ();
    @selected = ();
    $set_count = 0;

    fisher_yates_shuffle(\@all_cards, \@all_shapes, \@all_coords);

    # delete "dealt" tag from all cards
    $canvas->dtag("dealt");

    # make all cards hidden
    $canvas->itemconfigure("card", '-state' => 'hidden');

    draw_cards(12);
    home_all_cards();
    layout_cards(0, scalar(@in_play_cards));

    $menu_play->configure('-state' => 'normal');
    $status_cards_left->configure('-text' => 'Cards Left: ' .
				  num_cards_left());
    $status_num_sets->configure('-text' => 'Sets: ' . $set_count);
    $status_misc->configure('-text' => ' ');
}

sub home_all_cards {
    my $i;

    # send all cards to home position
    for ($i = 0; $i < @all_cards; $i++) {
	move_card_to_home($i);
    }
}

sub draw_cards($) {
    my $n = shift;

    if (num_cards_left() < 3) {
	print "ERROR: deck_index is $deck_index\n";
	return -1;
    }

    while ($n--) {
	push @in_play_cards, $all_cards[$deck_index++];
	$canvas->addtag("dealt", 'withtag',
			"card $in_play_cards[$#in_play_cards]");
    }
    $status_cards_left->configure('-text' => 'Cards Left: ' .
				  num_cards_left());
    return 0;
}

sub draw_more_cards {
    my $i = @in_play_cards;

    # TODO: SET CHECKING HERE...
    if (find_sets()) { return; }

    (num_cards_left() < 3) || (draw_cards(3) == 0 &&
			       layout_cards($i, scalar(@in_play_cards)));
}

sub layout_cards($$) {
    my ($i, $end) = @_;
    my $tag;

    for (; $i < $end; $i++) {
	$tag = "card $in_play_cards[$i]";
	$canvas->itemconfigure($tag, '-state' => 'normal');
	$canvas->move($tag, int($i/3)*100, ($i%3)*120);
    }
    return 1;
}

sub move_card_to_home($) {
    my $n = shift;
    my $i;
    $canvas->coords("card back $n", 5, 5, 95, 115);
    for ($i = 0; $i < @{$all_shapes[$n]}; $i++) {
	my @c = @{$all_coords[$n]->[$i]};

	# stupid temporary sanity check.....
#	if ("@c" ne "7 20 93 54" and
#	    "@c" ne "7 66 93 100" and
#	    "@c" ne "7 7 93 41" and
#	    "@c" ne "7 43 93 77" and
#	    "@c" ne "7 79 93 113" and
#	    "@c" ne "") {
#	    print "@c fucked up\n";
#	    exit(1);
#	}

#	print ("card front $n " . $canvas->gettags($all_shapes[$n]->[$i]) .
#	       " will be at @c\n");
	$canvas->coords($all_shapes[$n]->[$i],
			@{$all_coords[$n]->[$i]});
    }
}

sub print_card_text($) {
    my $n = shift;
    my ($color, $shape, $count, $shade);
    $color = get_color($n);
    $shape = get_shape($n);
    $count = get_count($n);
    $shade = get_shade($n);
    print "card $n: $color $shape $count $shade\n";
}

sub third_card($$) {
    my ($n, $m) = @_;
    my $color, $shape, $count, $shade;
    my @n = (get_color_idx($n), get_shape_idx($n),
	     get_count_idx($n), get_shade_idx($n));
    my @m = (get_color_idx($m), get_shape_idx($m),
	     get_count_idx($m), get_shade_idx($m));

    # if the two cards are different, require the 3rd trait.
    # otherwise, require the same trait.
    $color = $n[0] != $m[0] ? ~($n[0] ^ $m[0]) & 3 : $n[0];
    $shape = $n[1] != $m[1] ? ~($n[1] ^ $m[1]) & 3 : $n[1];
    $count = $n[2] != $m[2] ? ~($n[2] ^ $m[2]) & 3 : $n[2];
    $shade = $n[3] != $m[3] ? ~($n[3] ^ $m[3]) & 3 : $n[3];

#    print "$n[0] $n[1] $n[2] $n[3]\n";
#    print "$m[0] $m[1] $m[2] $m[3]\n";
#    print "$color $shape $count $shade\n";
#    printf("third card: %s %s %s %i\n",
#	   ("red", "green", "purple")[$color],
#	   ("squiggle", "oval", "diamond")[$shape],
#	   ("solid", "clear", "shaded")[$shade],
#	   $count+1);

    return ($color * 27) + ($shape * 9) + ($count * 3) + $shade;
}

sub find_sets {
    my ($i, $j, $k);
    my %in_play;
    my @found;
    foreach (@in_play_cards) {
	$in_play{$_} = 1;
    }

    for ($i = 0; $i < $#in_play_cards; $i++) {
	for ($j = $i + 1; $j < @in_play_cards; $j++) {
	    $k = third_card($in_play_cards[$i],
			    $in_play_cards[$j]);
	    if ($in_play{$k}) {
		push @found, [[$in_play_cards[$i],
			       get_pos($in_play_cards[$i])],
			      [$in_play_cards[$j],
			       get_pos($in_play_cards[$j])],
			      [$k,
			       get_pos($k)]];
	    }
	}
    }
    return @found;
}

sub game_over {
    $status_misc->configure('-text' => 'game over');
}