Goban.pm

package Goban;
use strict;
use warnings;
use parent 'Games::Go::SimpleBoard';
use Games::Go::SimpleBoard;
use Goban::Image;

sub new {
    my $class = shift;
    my $size  = shift || 19;
    my $self  = $class->SUPER::new( $size );

    if ( $size == 19 ) {
        $self->update([
            [ 3,   3, -1, MARK_HOSHI ],
            [ 3,   9, -1, MARK_HOSHI ],
            [ 3,  15, -1, MARK_HOSHI ],
            [ 9,   3, -1, MARK_HOSHI ],
            [ 9,   9, -1, MARK_HOSHI ],
            [ 9,  15, -1, MARK_HOSHI ],
            [ 15,  3, -1, MARK_HOSHI ],
            [ 15,  9, -1, MARK_HOSHI ],
            [ 15, 15, -1, MARK_HOSHI ],
        ]);
    }
    elsif ( $size == 13 ) {
        $self->update([
            [ 3,  3,  -1, MARK_HOSHI ],
            [ 3,  9,  -1, MARK_HOSHI ],
            [ 6,  6,  -1, MARK_HOSHI ],
            [ 9,  3,  -1, MARK_HOSHI ],
            [ 9,  9,  -1, MARK_HOSHI ],
        ]);
    }
    elsif ( $size == 9 ) {
        $self->update([
            [ 2,  2,  -1, MARK_HOSHI ],
            [ 2,  6,  -1, MARK_HOSHI ],
            [ 4,  4,  -1, MARK_HOSHI ],
            [ 6,  2,  -1, MARK_HOSHI ],
            [ 6,  6,  -1, MARK_HOSHI ],
        ]);
    }

    $self;
}

sub size {
    $_[0]->{size};
}

sub markers {
    $_[0]->{board};
}

sub each_index {
    my ( $self, $code ) = @_;

    for my $y ( 0 .. $self->{max} ) {
        for my $x ( 0 .. $self->{max} ) {
            $code->( $x, $y );
        }
    }

    $self;
}

sub as_text {
    my $self = shift;

    my @lines;
    $self->each_index(sub {
        my ( $x, $y ) = @_;
        my $markers = $self->markers->[$x][$y];

        if ( $markers & MARK_B ) {
            $lines[$y] .= 'X';
        }
        elsif ( $markers & MARK_W ) {
            $lines[$y] .= 'O';
        }
        elsif ( $markers & MARK_HOSHI ) {
            $lines[$y] .= '+';
        }
        else {
            $lines[$y] .= '.';
        }

        $lines[$y] .= ' ';
    });

    join "\n", @lines, q{};
}

sub as_image {
    my ( $self, @args ) = @_;

    my $image = Goban::Image->new(
        goban => $self,
        @args
    );

    $image->finalize;
}

1;

Image.pm

package Goban::Image;
use strict;
use warnings;
use Games::Go::SimpleBoard;
use Imager;
use Imager::Color;
use Imager::Fill;
use Imager::Fountain;

sub new {
    my $class = shift;
    my %args = @_ == 1 ? %{$_[0]} : @_;
    bless \%args, $class;
}

sub goban {
    $_[0]->{goban};
}

sub size {
    $_[0]->{size} ||= 300;
}

sub image {
    my $self = shift;
    $self->{image} ||= $self->_build_image;
}

sub _build_image {
    my $self = shift;

    Imager->new(
        xsize    => $self->size,
        ysize    => $self->size,
        channels => 4,
    );
}

sub cell_size {
    my $self = shift;
    $self->{cell_size} ||= $self->size / ( $self->goban->size + 0.5 );
}

sub stone_radius {
    my $self = shift;
    $self->{stone_radius} ||= $self->cell_size / 2;
}

sub intersections {
    my $self = shift;
    $self->{intersections} ||= $self->_build_intersections;
}

sub _build_intersections {
    my $self = shift;

    my @intersections;
    $self->goban->each_index(sub {
        my ( $x, $y ) = @_;

        $intersections[ $x ][ $y ] = {
            x => 1.5 * $self->stone_radius + $x * $self->cell_size,
            y => 1.5 * $self->stone_radius + $y * $self->cell_size,
        };
    });

    \@intersections;
}

sub grid_color {
    my $self = shift;
    $self->{grid_color} ||= $self->_build_grid_color;
}

sub _build_grid_color {
    my $self = shift;

    my $opacity = 255 * $self->stone_radius / 15;
       $opacity = 255 if $opacity > 255;

    Imager::Color->new( 0, 0, 0, $opacity );
}

sub markup_color {
    my ( $self, $x, $y ) = @_;

    $self->{markup_color} ||= {
        white => Imager::Color->new( 255, 255, 255, 200 ),
        black => Imager::Color->new( 0, 0, 0, 200 ),
    };

    if ( $self->goban->markers->[$x][$y] & MARK_B ) {
        return $self->{markup_color}->{white};
    }
    elsif ( $self->goban->markers->[$x][$y] & MARK_W ) {
        return $self->{markup_color}->{black};
    }

    return;
}

sub render_grid {
    my $self = shift;

    for my $i ( 0 .. $self->goban->size - 1 ) {
        # horizontal line
        $self->image->line(
            color => $self->grid_color,
            x1    => $self->intersections->[0][$i]->{x},
            y1    => $self->intersections->[0][$i]->{y},
            x2    => $self->intersections->[$self->goban->size-1][$i]->{x},
            y2    => $self->intersections->[$self->goban->size-1][$i]->{y},
        );

        # vertical line
        $self->image->line(
            color => $self->grid_color,
            x1    => $self->intersections->[$i][0]->{x},
            y1    => $self->intersections->[$i][0]->{y},
            x2    => $self->intersections->[$i][$self->goban->size-1]->{x},
            y2    => $self->intersections->[$i][$self->goban->size-1]->{y},
        );
    }

    $self;
}

sub render_black_stone {
    my ( $self, $x, $y ) = @_;
    my $position = $self->intersections->[$x][$y];

    my $shadow = Imager::Fill->new(
        solid   => Imager::Color->new( 32, 32, 32, 127 ),
        combine => "normal",
    );

    $self->image->arc(
        fill => $shadow,
        x    => $position->{x} + $self->size / 600,
        y    => $position->{y} + $self->size / 600,
        r    => $self->stone_radius - 0.5,
        aa   => 1,
    );

    my $segments = Imager::Fountain->simple(
        colors => [
            Imager::Color->new( 64, 64, 64, 255 ),
            Imager::Color->new( 0, 0, 0 )
        ],
        positions => [ 0, 1 ],
    );

    my $fill = Imager::Fill->new(
        fountain => "radial",
        segments => $segments,
        xa       => $position->{x} - 0.45 * $self->stone_radius,
        ya       => $position->{y} - 0.45 * $self->stone_radius,
        xb       => $position->{x} - $self->stone_radius,
        yb       => $position->{y} + 0.5 * $self->stone_radius,
        combine  => "normal",
    );

    $self->image->arc(
        fill  => $fill,
        x     => $position->{x} - 0.5,
        y     => $position->{y} - 0.5, 
        r     => $self->stone_radius - 0.5,
        aa    => 1,
    );

    $self;
}

sub render_white_stone {
    my ( $self, $x, $y ) = @_;
    my $position = $self->intersections->[$x][$y];

    my $shadow = Imager::Fill->new(
        solid   => Imager::Color->new( 32, 32, 32, 127 ),
        combine => "normal",
    );

    $self->image->arc(
        fill => $shadow,
        x    => $position->{x} + $self->size / 600,
        y    => $position->{y} + $self->size / 600,
        r    => $self->stone_radius - 0.5,
        aa   => 1,
    );

    my $segments = Imager::Fountain->simple(
        colors    => [ '#fff', '#bbb' ],
        positions => [ 0, 1 ],
    );

    my $fill = Imager::Fill->new(
        fountain => "radial",
        segments => $segments,
        xa       => $position->{x} - 0.4 * $self->stone_radius,
        ya       => $position->{y} - 0.4 * $self->stone_radius,
        xb       => $position->{x} - $self->stone_radius,
        yb       => $position->{y} + 0.5 * $self->stone_radius,
        combine  => "normal",
    );

    $self->image->arc(
        fill => $fill,
        x    => $position->{x} - 0.5,
        y    => $position->{y} - 0.5,
        r    => $self->stone_radius - 0.5,
        aa   => 1,
    );

    $self;
}

sub render_hoshi {
    my ( $self, $x, $y ) = @_;
    my $position = $self->intersections->[$x][$y];

    $self->image->arc(
        color => 'black',
        x     => $position->{x},
        y     => $position->{y},
        r     => $self->size > 300 ? 2 : 1.5,
        aa    => 1,
    );

    $self;
}

sub render_circle {
    my ( $self, $x, $y ) = @_;
    my $position = $self->intersections->[$x][$y];

    $self->image->circle(
        color  => $self->markup_color( $x, $y ),
        r      => $self->stone_radius / 1.9,
        x      => $position->{x} - 0.5,
        y      => $position->{y} - 0.5,
        aa     => 1,
        filled => 0,
    );

    $self;
}

sub render_markers {
    my $self = shift;
  
    $self->goban->each_index(sub {
        my ( $x, $y ) = @_;
        my $markers = $self->goban->markers->[$x][$y];

        if ( $markers & MARK_B ) {
            $self->render_black_stone( $x, $y );
        }
        elsif ( $markers & MARK_W ) {
            $self->render_white_stone( $x, $y );
        }
        elsif ( $markers & MARK_HOSHI ) {
            $self->render_hoshi( $x, $y );
        }

        if ( $markers & MARK_CIRCLE ) {
            $self->render_circle( $x, $y );
        }
    });

    $self;
}

sub finalize {
    my $self = shift;

    $self->render_grid
         ->render_markers
         ->image;
}

1;