The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
package SDL::Tutorial::Tetris::Model::Pieces;

use strict;
use warnings;

use Carp;

my %pieces  = (
    SQUARE => [
        [
            [0, 0, 0, 0, 0],
            [0, 0, 0, 0, 0],
            [0, 0, 2, 1, 0],
            [0, 0, 1, 1, 0],
            [0, 0, 0, 0, 0]
        ],
        [
            [0, 0, 0, 0, 0],
            [0, 0, 0, 0, 0],
            [0, 0, 2, 1, 0],
            [0, 0, 1, 1, 0],
            [0, 0, 0, 0, 0]
        ],
        [
            [0, 0, 0, 0, 0],
            [0, 0, 0, 0, 0],
            [0, 0, 2, 1, 0],
            [0, 0, 1, 1, 0],
            [0, 0, 0, 0, 0]
        ],
        [
            [0, 0, 0, 0, 0],
            [0, 0, 0, 0, 0],
            [0, 0, 2, 1, 0],
            [0, 0, 1, 1, 0],
            [0, 0, 0, 0, 0]
        ]
    ],
    LINE => [
        [
            [0, 0, 0, 0, 0],
            [0, 0, 0, 0, 0],
            [0, 1, 2, 1, 1],
            [0, 0, 0, 0, 0],
            [0, 0, 0, 0, 0]
        ],
        [
            [0, 0, 0, 0, 0],
            [0, 0, 1, 0, 0],
            [0, 0, 2, 0, 0],
            [0, 0, 1, 0, 0],
            [0, 0, 1, 0, 0]
        ],
        [
            [0, 0, 0, 0, 0],
            [0, 0, 0, 0, 0],
            [1, 1, 2, 1, 0],
            [0, 0, 0, 0, 0],
            [0, 0, 0, 0, 0]
        ],
        [
            [0, 0, 1, 0, 0],
            [0, 0, 1, 0, 0],
            [0, 0, 2, 0, 0],
            [0, 0, 1, 0, 0],
            [0, 0, 0, 0, 0]
        ]
    ],
    L_SHAPE => [
        [
            [0, 0, 0, 0, 0],
            [0, 0, 1, 0, 0],
            [0, 0, 2, 0, 0],
            [0, 0, 1, 1, 0],
            [0, 0, 0, 0, 0]
        ],
        [
            [0, 0, 0, 0, 0],
            [0, 0, 0, 0, 0],
            [0, 1, 2, 1, 0],
            [0, 1, 0, 0, 0],
            [0, 0, 0, 0, 0]
        ],
        [
            [0, 0, 0, 0, 0],
            [0, 1, 1, 0, 0],
            [0, 0, 2, 0, 0],
            [0, 0, 1, 0, 0],
            [0, 0, 0, 0, 0]
        ],
        [
            [0, 0, 0, 0, 0],
            [0, 0, 0, 1, 0],
            [0, 1, 2, 1, 0],
            [0, 0, 0, 0, 0],
            [0, 0, 0, 0, 0]
        ]
    ],
    L_SHAPE_MIRROR => [
        [
            [0, 0, 0, 0, 0],
            [0, 0, 1, 0, 0],
            [0, 0, 2, 0, 0],
            [0, 1, 1, 0, 0],
            [0, 0, 0, 0, 0]
        ],
        [
            [0, 0, 0, 0, 0],
            [0, 1, 0, 0, 0],
            [0, 1, 2, 1, 0],
            [0, 0, 0, 0, 0],
            [0, 0, 0, 0, 0]
        ],
        [
            [0, 0, 0, 0, 0],
            [0, 0, 1, 1, 0],
            [0, 0, 2, 0, 0],
            [0, 0, 1, 0, 0],
            [0, 0, 0, 0, 0]
        ],
        [
            [0, 0, 0, 0, 0],
            [0, 0, 0, 0, 0],
            [0, 1, 2, 1, 0],
            [0, 0, 0, 1, 0],
            [0, 0, 0, 0, 0]
        ]
    ],
    N_SHAPE => [
        [
            [0, 0, 0, 0, 0],
            [0, 0, 0, 1, 0],
            [0, 0, 2, 1, 0],
            [0, 0, 1, 0, 0],
            [0, 0, 0, 0, 0]
        ],
        [
            [0, 0, 0, 0, 0],
            [0, 0, 0, 0, 0],
            [0, 1, 2, 0, 0],
            [0, 0, 1, 1, 0],
            [0, 0, 0, 0, 0]
        ],
        [
            [0, 0, 0, 0, 0],
            [0, 0, 1, 0, 0],
            [0, 1, 2, 0, 0],
            [0, 1, 0, 0, 0],
            [0, 0, 0, 0, 0]
        ],
        [
            [0, 0, 0, 0, 0],
            [0, 1, 1, 0, 0],
            [0, 0, 2, 1, 0],
            [0, 0, 0, 0, 0],
            [0, 0, 0, 0, 0]
        ]
    ],
    N_SHAPE_MIRROR => [
        [
            [0, 0, 0, 0, 0],
            [0, 0, 1, 0, 0],
            [0, 0, 2, 1, 0],
            [0, 0, 0, 1, 0],
            [0, 0, 0, 0, 0]
        ],
        [
            [0, 0, 0, 0, 0],
            [0, 0, 0, 0, 0],
            [0, 0, 2, 1, 0],
            [0, 1, 1, 0, 0],
            [0, 0, 0, 0, 0]
        ],
        [
            [0, 0, 0, 0, 0],
            [0, 1, 0, 0, 0],
            [0, 1, 2, 0, 0],
            [0, 0, 1, 0, 0],
            [0, 0, 0, 0, 0]
        ],
        [
            [0, 0, 0, 0, 0],
            [0, 0, 1, 1, 0],
            [0, 1, 2, 0, 0],
            [0, 0, 0, 0, 0],
            [0, 0, 0, 0, 0]
        ]
    ],
    T_SHAPE => [
        [
            [0, 0, 0, 0, 0],
            [0, 0, 1, 0, 0],
            [0, 0, 2, 1, 0],
            [0, 0, 1, 0, 0],
            [0, 0, 0, 0, 0]
        ],
        [
            [0, 0, 0, 0, 0],
            [0, 0, 0, 0, 0],
            [0, 1, 2, 1, 0],
            [0, 0, 1, 0, 0],
            [0, 0, 0, 0, 0]
        ],
        [
            [0, 0, 0, 0, 0],
            [0, 0, 1, 0, 0],
            [0, 1, 2, 0, 0],
            [0, 0, 1, 0, 0],
            [0, 0, 0, 0, 0]
        ],
        [
            [0, 0, 0, 0, 0],
            [0, 0, 1, 0, 0],
            [0, 1, 2, 1, 0],
            [0, 0, 0, 0, 0],
            [0, 0, 0, 0, 0]
        ]
    ]
);

my %pieces_init = (
    SQUARE => [
        [-2, -3],
        [-2, -3],
        [-2, -3],
        [-2, -3]
    ],
    LINE => [
        [-2, -2],
        [-2, -3],
        [-2, -2],
        [-2, -3]
    ],
    L_SHAPE => [
        [-2, -3],
        [-2, -3],
        [-2, -3],
        [-2, -2]
    ],
    L_SHAPE_MIRROR => [
        [-2, -3],
        [-2, -2],
        [-2, -3],
        [-2, -3]
    ],
    N_SHAPE => [
        [-2, -3],
        [-2, -3],
        [-2, -3],
        [-2, -2]
    ],
    N_SHAPE_MIRROR => [
        [-2, -3],
        [-2, -3],
        [-2, -3],
        [-2, -2]
    ],
    T_SHAPE => [
        [-2, -3],
        [-2, -3],
        [-2, -3],
        [-2, -2]
    ]
);

sub piece {
    my ($self, $piece, $rotation) = @_;
    croak "Invalid piece '$piece'"       if !defined $pieces{$piece} or !defined $piece;
    croak "Invalid rotation '$rotation'" if !defined $pieces{$piece}[$rotation] or !defined $rotation;
    return $pieces{$piece}[$rotation];
}

sub init_xy {
    my ($self, $piece, $rotation) = @_;
    croak "Invalid piece '$piece'"       if !defined $pieces{$piece} or !defined $piece;
    croak "Invalid rotation '$rotation'" if !defined $pieces{$piece}[$rotation] or !defined $rotation;
    return @{ $pieces_init{$piece}[$rotation] };
}

sub block_color {
    my ($self, $piece, $rotation, $x, $y) = @_;
    croak "Invalid piece '$piece'"       if !defined $pieces{$piece} or !defined $piece;
    croak "Invalid rotation '$rotation'" if !defined $pieces{$piece}[$rotation] or !defined $rotation;
    croak "Invalid coordinates ($x,$y)"  if !defined $pieces{$piece}[$rotation][$x][$y] or (!defined $x or !defined $y);
    return $pieces{$piece}[$rotation][$x][$y];
}

sub random {
    my @pieces = keys %pieces;
    my $piece    = $pieces[ rand(@pieces) ];
    my $rotation = int(rand(4));
    return ($piece,$rotation);
}

1;

__END__

=head1 NAME
SDL::Tutorial::Tetris::Model::Pieces - the tetris pieces

=head1 SYNOPSIS

    use SDL::Tutorial::Tetris::Model::Pieces;

    my ($piece, $rotation) = SDL::Tutorial::Tetris::Model::Pieces->random();
    my ($init_x, $init_y)  = SDL::Tutorial::Tetris::Model::Pieces->init_xy($piece,$rotation);

    for my $y (0..4) {
        for my $x (0..4) {
            print SDL::Tutorial::Tetris::Model::Pieces->block_color($piece,$rotation,$x,$y);
        }
        print "\n";
    }

=head1 DESCRIPTION

This modules holds the game data, and the means to interact to it.

Basically, we have a set of named pieces (SQUARE, LINE, T_SHAPE; 
L_SHAPE, N_SHAPE; L_SHAPE_MIRROR, N_SHAPE_MIRROR).

=head2 random

Returns a random piece and rotation.

=head2 init_xy

Returns the initial (x,y) coordinates for each block and rotation.

=head2 block_color

Given a block, rotation, and (x,y) coordinates, it returns the
color of the block in that point.