view release on metacpan or  search on metacpan

lib/Graphics/GVG/OpenGLRenderer.pm  view on Meta::CPAN

# Redistribution and use in source and binary forms, with or without 
# modification, are permitted provided that the following conditions are met:
# 
#     * Redistributions of source code must retain the above copyright notice, 
#       this list of conditions and the following disclaimer.
#     * Redistributions in binary form must reproduce the above copyright 
#       notice, this list of conditions and the following disclaimer in the 
#       documentation and/or other materials provided with the distribution.
# 
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE 
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 
# POSSIBILITY OF SUCH DAMAGE.
package Graphics::GVG::OpenGLRenderer;
$Graphics::GVG::OpenGLRenderer::VERSION = '0.4';
# ABSTRACT: Turn a GVG file into OpenGL code
use strict;
use warnings;
use Moose;
use namespace::autoclean;
use Data::UUID;
use Imager::Color;
use Math::Trig 'pi';

with 'Graphics::GVG::Renderer::DefaultCode';
with 'Graphics::GVG::Renderer';

has [qw{ circle_segments ellipse_segments }] => (
    is => 'rw',
    isa => 'Int',
    default => 40,
);


sub class_suffix
{
    return 'OpenGL';
}

sub make_opening_code
{
    my ($self, $pack) = @_;

    my $code = 'package ' . $pack . ';';
    $code .= q!
        use strict;
        use warnings;
        use OpenGL qw(:all);

        sub new
        {
            my ($class) = @_;
            my $self = {};
            bless $self => $class;
            return $self;
        }

        sub draw {
    !;
    return $code;
}

sub make_closing_code
{
    my ($self, $pack) = @_;
    my $code = 'return; }';
    $code .= '1;';
    return $code;
}

sub make_line
{
    my ($self, $cmd) = @_;
    my $x1 = $cmd->x1;
    my $y1 = $cmd->y1;
    my $x2 = $cmd->x2;
    my $y2 = $cmd->y2;
    my $color = $cmd->color;
    my ($red, $green, $blue, $alpha) = $self->_int_to_opengl_color( $color );

    my $make_line_sub = sub {
        my ($width, $red, $green, $blue, $alpha) = @_;
        my $code = qq!
            glLineWidth( $width );
            glColor4ub( $red, $green, $blue, $alpha );
            glBegin( GL_LINES );
                glVertex2f( $x1, $y1 );
                glVertex2f( $x2, $y2 );
            glEnd();
        !;
        return $code;
    };

    my $code = '';
    if( $self->glow_count > 0 ) {
        # TODO not really getting the effect I was hoping for. Play around 
        # with it later.
        my @colors1 = $self->_brighten( 2.0, $red, $green, $blue, $alpha );
        my @colors2 = ($red, $green, $blue, $alpha);
        my @colors3 = $self->_brighten( 0.7, $red, $green, $blue, $alpha );
        $code = $make_line_sub->( 5.0, @colors3 );
        $code .= $make_line_sub->( 2.0, @colors2 );
        #$code .= $make_line_sub->( 1.0, @colors1 );
    }
    else {
        $code = $make_line_sub->( 1.0, $red, $green, $blue, $alpha );
    }

    return $code;
}

sub make_rect
{
    my ($self, $cmd) = @_;