The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Weaving::Tablet::Card;
use strict;
use warnings;
use Carp;
use Moose;
use namespace::autoclean;

has 'number_of_holes' => (isa => 'Int', is => 'ro', default => 4);
has 'number_of_turns' => (isa => 'Int', is => 'ro', writer => '_set_turns');
has 'SZ' => (isa => 'Str', is => 'rw', default => 'S');
has 'turns' => (isa => 'ArrayRef[Str]', is => 'ro', default => sub { [] });
has 'threading' => (isa => 'ArrayRef[Int]', is => 'ro', default => sub { [0,1,2,3] });
has 'start' => (isa => 'Int', is => 'rw', default => '0');
has 'color' => (isa => 'ArrayRef[Int]', is => 'ro', default => sub { [] });
has 'twist' => (isa => 'ArrayRef[Int]', is => 'ro', default => sub { [] });
has 'floats' => (isa => 'ArrayRef', is => 'ro', default => sub { [] });

our $VERSION = '0.9.2';

around BUILDARGS => sub {
    my $orig = shift;
    my $class = shift;
    my $args = @_ == 1 ? shift : {@_};
    
    if (exists $args->{turns})
    {
        if (!ref $args->{turns})
        {
            $args->{turns} = [split(//, $args->{turns})];
        }
        $args->{number_of_turns} =  @{$args->{turns}};
    }
    elsif (exists $args->{number_of_turns})
    {
        $args->{turns} = [('/') x $args->{number_of_turns}];
    }
    else
    {
        die 'Must specify number_of_turns or turns';
    }
    if (exists $args->{start})
    {
        $args->{start} =~ tr/ABCDEFGH/01234567/;
    }
    return $class->$orig($args);
};

sub BUILD
{
    my $self = shift;
    $self->color_card;
    $self->twist_card;
}

sub set_threading
{
    my $self = shift;
    my ($threading) = @_;
    for my $hole (0 .. $self->number_of_holes-1)
    {
        $self->threading->[$hole] = $threading->[$hole];
    }
}

sub insert_picks
{
    my $self = shift;
    my ($after, $picks) = @_;
    my @picks = split(//, $picks);
    splice @{$self->turns}, $after+1, 0, @picks;
	$self->_set_turns(scalar @{$self->turns});
}

sub delete_picks
{
    my $self = shift;
    my @picks = reverse sort { $a <=> $b } @_;
	splice @{$self->turns}, $_, 1 for @picks;
	$self->_set_turns(scalar @{$self->turns});
}

sub color_card
{
    my $self = shift;
    my $color = $self->start;
    my $pos = $color;
    my $holes = $self->number_of_holes;
    for my $pick (0 .. $self->number_of_turns-1)
    {
        my $turn = $self->turns->[$pick];
        if ($turn ne '|')
        {
            $color = ($turn eq '/' ? $pos : $pos+1) % $holes;
            $pos = ($turn eq '/' ? $pos-1 : $pos+1) % $holes;
        }
        $self->color->[$pick] = $color;
    }
}

sub twist_card
{
    my $self = shift;
    my $twist = 0;
    my $sign = $self->SZ eq 'S' ? 1 : -1;
    for my $pick (0 .. $self->number_of_turns-1)
    {
        $twist++ if $self->turns->[$pick] eq '/';
        $twist-- if $self->turns->[$pick] eq '\\';
        $self->twist->[$pick] = $twist * $sign;
    }
}

sub float_card
{
    my $self = shift;
    $self->color_card;
    my $top = $self->color->[0];
    my $float_start = 0;
    pop @{$self->floats} while @{$self->floats};
    for my $pick (1 .. $self->number_of_turns-1)
    {
        next if $self->color->[$pick] == $top;
        push @{$self->floats}, [ $float_start, $pick ];
        $top = $self->color->[$pick];
        $float_start = $pick;
    }
    push @{$self->floats}, [ $float_start, $self->number_of_turns ];
}

__PACKAGE__->meta->make_immutable;
1;