#!/usr/bin/perl
use strict;
use warnings;
use List::Util 'sum';

my %straight = (3 => \&straight_3, 4 => \&straight_4, 5 => \&straight_5);
my @deck = map { ($_) x 4 } 1 .. 9;
push @deck, (10) x 16;

my $iter = combo(5, @deck);
my %seen;

open(my $fh, '>', 'crib.dat') or die $!;
my $n;
while (my @hand = $iter->()) {
    next if $seen{"@hand"}++;
    my %card;
    ++$card{$_} for @hand;
    my $score = 0;

    # Determine if last card is 10
    my $is_10 = $hand[-1] == 10 ? 1 : 0;

    # if every card is < 10, calculate 2/3/4 of a kind
    if (! $is_10) {
        $score += $_ * ($_ - 1) for values %card;        
    }

    # Can't possibly be a flush if 2/3/4 of a kind exceeds 1 pair
    my $check_flush = $score > 2 ? 0 : 1;
    # if every card is < 10, calculate straights
    if (! $is_10) {
        my @val = sort {$a <=> $b} keys %card;
        my ($len, $beg, $end) = $straight{@val}->(@val) if @val > 2; # my and if together
        if ($len) { $len *= $card{$_} for @val[$beg .. $end] }
        $score += $len || 0;
    }
    # Calculate 15s
    my $fifteen = 0;
    for (2 .. 5) {
        my $next = combo($_, @hand);
        while (my $sum = sum($next->())) {
            ++$fifteen if $sum == 15;
        }
    }
    $score += 2 * $fifteen;
    $_ = $_ == 10 ? 'T' : $_ for @hand;
    my $flags = ! $is_10 && ! $check_flush ? 0 : $is_10 && $check_flush ? 3 : $is_10 ? 1 : 2;
    $score = sprintf("%.2d", $score);
    print $fh join "", @hand, $flags, $score;
    print $fh "\n" if not ++$n % 10;
}


sub straight_3 {
    return (3, 0, 2) if $_[1] - $_[0] == 1 && $_[2] - $_[1] == 1;
}

sub straight_4 {
    return (4, 0, 3) if $_[1] - $_[0] == 1 && $_[2] - $_[1] == 1 && $_[3] - $_[2] == 1;
    return (3, 0, 2) if $_[1] - $_[0] == 1 && $_[2] - $_[1] == 1;
    return (3, 1, 3) if $_[2] - $_[1] == 1 && $_[3] - $_[2] == 1;
}

sub straight_5 {
    return (5, 0, 4) if $_[1] - $_[0] == 1 && $_[2] - $_[1] == 1 && $_[3] - $_[2] == 1 && $_[4] - $_[3] == 1;
    return (4, 0, 3) if $_[1] - $_[0] == 1 && $_[2] - $_[1] == 1 && $_[3] - $_[2] == 1;
    return (4, 1, 4) if $_[2] - $_[1] == 1 && $_[3] - $_[2] == 1 && $_[4] - $_[3] == 1;
    return (3, 0, 2) if $_[1] - $_[0] == 1 && $_[2] - $_[1] == 1;
    return (3, 1, 3) if $_[2] - $_[1] == 1 && $_[3] - $_[2] == 1;
    return (3, 2, 4) if $_[3] - $_[2] == 1 && $_[4] - $_[3] == 1;
}

sub combo {
    my $by = shift;
    return sub { () } if ! $by || $by =~ /\D/ || @_ < $by;
    my @list = @_;

    my @position = (0 .. $by - 2, $by - 2);
    my @stop     = @list - $by .. $#list;
    my $end_pos  = $#position;
    my $done     = undef;

    return sub {
        return () if $done;
        my $cur = $end_pos;
        {
            if ( ++$position[ $cur ] > $stop[ $cur ] ) {
                $position[ --$cur ]++;
                redo if $position[ $cur ] > $stop[ $cur ];
                my $new_pos = $position[ $cur ];
                @position[ $cur .. $end_pos ] = $new_pos .. $new_pos + $by;
            }
        }
        $done = 1 if $position[0] == $stop[0];
        return @list[ @position ];
    }
}