File Coverage

blib/lib/OpenGL/PLG.pm

Criterion	Covered	Total	%
statement	89	149	59.7
branch	34	64	53.1
condition	6	12	50.0
subroutine	13	19	68.4
pod	16	16	100.0
total	158	260	60.7

package OpenGL::PLG;
use Carp;

use warnings;
use strict;

our $VERSION = '0.03';


# creates a new PoLyGon object
sub new {
    my ($class) = @_;
    my $self = bless {},$class;

    $self->{'vertices'} = [];
    $self->{'polygons'} = [];

    return $self;
}


# reads a given PLG file
# and parse it into the object
# TODO: handle multiple PLG formats
sub parse_file {
    my ($self, $filename) = @_;

    open my $fh, '<', $filename
        or croak "error loading '$filename': $!\n";

    my $reading_vertexes = 1;

    while (my $line = <$fh>) {
        my @fields = split /\s+/, $line;

        # if we reach an empty line,
        # then what will follow is
        # the list of positions for each
        # collected vertex
        if ( @fields == 0 ) {
            $reading_vertexes = 0;
            next;
        }

        # if we are reading vertices,
        # load them into our object
        if ($reading_vertexes) {
            $self->set_vertex(@fields);
        }

        # otherwise, we are reading
        # a polygon list (each of it
        # using some of the vertices
        # collected beforehand)
        else {

            # validade the input
            if ($fields[0] !~ m/^\d+$/ ) {
                croak 'error parsing file. Expected single number of '
                    . "vertices in polygon, but got '@fields' instead\n";
            }

            my $n_vertices = $fields[0];

            # retrieve the next line
            $line = <$fh>;
            @fields = split /\s+/, $line;

            $self->set_polygon($n_vertices, @fields);
        }
    }
    close $fh;
}


# include a polygon shape into the object.
# the first parameter indicates the number
# of vertices in the polygon. Next follows
# the list of vertices ids. This function
# does not return anything, but croak's if
# the number of vertices is not the same as
# expected.
sub set_polygon {
    my $self = shift;
    my ($n_vertices, @fields) = @_;

    # validade input (at least some of it)
    if ( @fields != $n_vertices ) {
        croak "error reading polygon input. Expected $n_vertices "
            . 'vertices but got ' . scalar @fields . " instead.\n";
    }
    else {
        push @{ $self->{'polygons'} }, [ @fields ];
    }
}

# deletes a given polygon by its id number.
# The first included polygon has id "1",
# while the last one is total_polygons().
# Circular references work, so you can
# get to the last polygon via a -1 id and
# so on. The id "0" does not exist. If you
# try to use it, you'll get an error.
# Also note that, once you delete a polygon,
# the id's of the polygons following it
# will be decreased by one.
sub delete_polygon {
    my ($self, $id) = @_;

    if ( not defined $id ) {
        croak "delete_polygon needs a loaded polygon id\n";
    }
    elsif ( $id == 0 ) {
        croak "polygon id cannot be zero\n";
    }

    # corrects behavior of plg files,
    # as they start with 1, not 0
    $id-- if $id > 0;

    if ( not defined $self->{'polygons'}->[$id] ) {
        croak "delete_polygon needs a loaded polygon id\n";
    }
    else {
        splice @{ $self->{'polygons'} }, $id, 1;
        return 1;
    }

}


# create a vertex in positions
# x, y, z. You can optionally specify an id
# for it ( >= 1 ), and PLG will put your
# vertex in that slot, replacing any vertex
# there (if available). Otherwise
# we'll place it in the last available
# id slot.
# TODO: croak if x,y,z values are not floats
# (regexp for -?\d+(?:\.\d+)?+e\d+ special float cases
# or something like that)
sub set_vertex {
    my $self = shift;
    my ($x, $y, $z, $id) = @_;

    # if 'id' is not valid or doesn't exist,
    # we'll use the last position on the array
    if (not defined $id or $id !~ /^\d+$/ ) {
        $id = @{ $self->{'vertices'} } + 1;
    }
    elsif ( $id == 0 ) {
        croak "vertex id cannot be zero\n";
    }

    if (not defined $x
     or not defined $y
     or not defined $z
    ) {
        croak "vertices must have all three coordinates (x, y, z)";
    }

    # corrects behavior of plg files,
    # as they start with 1, not 0
    $id-- if $id > 0;

    # insert the vertex in the correct
    # index (id) position
    $self->{'vertices'}->[$id] = [$x, $y, $z];

    return $id;
}


# same as set_vertex, but lets you create
# several vertices at once.
sub set_vertices {
    my ($self, $v_ref) = @_;

    if (not defined $v_ref
     or ref($v_ref) ne 'HASH') {
        croak "set_vertices must receive a hash reference.\n";
    }

    foreach (sort keys %{$v_ref} ) {
        $self->set_vertex(@{$v_ref->{$_}}, $_);
    }
}


# returns the total number of vertices
# in the object
sub total_vertices {
    my $self = shift;
    return scalar ( @{ $self->{'vertices'} } );
}

# returns the total number of polygons
# in the object
sub total_polygons {
    my $self = shift;
    return scalar ( @{ $self->{'polygons'} } );
}


# retrieves a vertex by its id
sub get_vertex {
    my ($self, $id) = @_;

    if ( not defined $id ) {
        croak "get_vertex needs a loaded vertex id\n";
    }
    elsif ( $id == 0 ) {
        croak "vertex id cannot be zero\n";
    }

    # corrects behavior of plg files,
    # as they start with 1, not 0
    $id-- if $id > 0;

    if ( not defined $self->{'vertices'}->[$id] ) {
        croak "get_vertex needs a loaded vertex id\n";
    }
    else {
        return @{ $self->{'vertices'}->[$id] };
    }
}


# returns an array reference containing
# the coordinates of each vertex inside a
# given polygon
sub get_vertices_from_polygon {
    my ($self, $polygon) = @_;
    my $vertices_ref = [];

    my $i = 0;
    foreach ( $self->get_polygon($polygon) ) {
        push @{$vertices_ref->[$i++]}, $self->get_vertex($_);
    }
    return $vertices_ref;
}


# deletes a given vertex by its id number.
# The first included vertex has id "1",
# while the last one is total_vertices().
# Circular references work, so you can
# get to the last vertex via a -1 id and
# so on. The id "0" does not exist. If you
# try to use it, you'll get an error.
# Also note that, once you delete a vertex,
# the id's of the vertices following it will
# be decreased by one.
sub delete_vertex {
    my ($self, $id) = @_;

    if ( not defined $id ) {
        croak "delete_vertex needs a loaded vertex id\n";
    }
    elsif ( $id == 0 ) {
        croak "vertex id cannot be zero\n";
    }

    # corrects behavior of plg files,
    # as they start with 1, not 0
    $id-- if $id > 0;

    if ( not defined $self->{'vertices'}->[$id] ) {
        croak "delete_vertex needs a loaded vertex id\n";
    }
    else {
        splice @{ $self->{'vertices'} }, $id, 1;
        return 1;
    }
}


# retrieves a polygon by its id
sub get_polygon {
    my ($self, $id) = @_;

    if ( not defined $id ) {
        croak "get_polygon needs a loaded polygon id\n";
    }
    elsif ( $id == 0 ) {
        croak "polygon id cannot be zero\n";
    }

    # corrects behavior of plg files,
    # as they start with 1, not 0
    $id-- if $id > 0;

    if ( not defined $self->{'polygons'}->[$id] ) {
        croak "get_polygon needs a loaded polygon id\n";
    }
    else {
        return @{ $self->{'polygons'}->[$id] };
    }
}


# renders OpenGL code to display the
# object (i.e. the collection of polygons
# forming whatever-it-is-they-form).
# Note that using this outside of an
# OpenGL program will most likely *not*
# produce the expected results (see example
# in the USAGE section for a way to actually
# display the image on the screen). This
# method needs the Perl OpenGL library to work.
sub render {
    my $self = shift;

    eval 'use OpenGL; 1';
    if ($@) {
        croak "Can't load Perl OpenGL: $@\n";
    }

    foreach my $plg_ref ( @{$self->{'polygons'} } ) {

        # each polygon is represented
        # independently
        &OpenGL::glBegin(&OpenGL::GL_POLYGON);

        foreach my $vertex_id ( @{$plg_ref} ) {
            my @v = $self->get_vertex($vertex_id);
            &OpenGL::glVertex3f(@v);
        }

        &OpenGL::glEnd;
    }
}

# dumps a string containing the OpenGL code
# to display the object (i.e. the collection
# of polygons forming whatever-it-is-they-form).
# Use this to see the code that will be produced
# by render() should you use it inside an OpenGL
# display. You do *NOT* need OpenGL to use this,
# as it will just output the code, not eval it.
sub dump_code {
    my $self = shift;
    my $dump = '';

    foreach my $plg_ref ( @{$self->{'polygons'} } ) {
        $dump .= "glBegin(GL_POLYGON);\n";
        foreach my $vertex_id ( @{$plg_ref} ) {
            my $v = join ( ', ', $self->get_vertex($vertex_id) );
            $dump .= "  glVertex3f($v);\n";
        }
        $dump .= "glEnd();\n";
    }

    return $dump;
}


# this is the same as dump_code(), but will write
# the string to a given file instead of giving
# it back to the user. This is useful if you want
# to use the OpenGL code in another language
# (like C or C++).
sub dump_code_to_file {
    my ($self, $filename) = @_;

    open my $fh, '>', $filename
        or croak "Error opening '$filename': $!\n";

    print $fh $self->dump()
        or croak "Error writing to file '$filename': $!\n";

    close $fh;
}

# this will write the object's vertices and
# polygons to a file, in raw PLG format. This
# is the exact reverse of parse_file().
# TODO: option to include vertices index next to them
# TODO: option to save in multiple PLG formats
sub write_to_file {
    my ($self, $filename) = @_;

    open my $fh, '>', $filename
        or croak "Error opening '$filename': $!\n";

    # write vertex data
    my $i = 0;
    while ($i < $self->total_vertices) {
        my @vertex = $self->get_vertex($i);
        next unless defined $vertex[0];
        print $fh join (' ', @vertex ) . "\n";
    }
    continue {
        $i++;
    }

    # insert a blank line
    print $fh "\n";

    # write polygon data
    $i = 0;
    while ($i < $self->total_polygons) {
        my @polygon = $self->get_polygon($i);
        next unless defined $polygon[0];

        print $fh scalar (@polygon) . "\n"
            . join (' ', @polygon ) . "\n"
            ;
    }
    continue {
        $i++;
    }
    close $fh;
}

42; # End of OpenGL::PLG

__END__