view release on metacpan or  search on metacpan

lib/App/HPGL2Cadsoft.pm  view on Meta::CPAN

    # Add stuff here

    my $hpgl;

    my $fh = IO::File->new( "< " . $self->input_file );

    if ( defined $fh ) {

        # Slurp the file into the variable
        while (<$fh>) {
            $hpgl .= $_;
        }
    }
    else {
        die "Could not open file '" . $self->input_file . "' for reading";
    }

    $fh->close();
    $self->_hpgl($hpgl);

}

sub _parse_hpgl {
    my $self = shift();

    my @lines;
    my $zero_length_stubs = 0;

    my @commands = split( ";", $self->_hpgl() );

    my ( $pos_start, $pos_end );

    foreach my $command (@commands) {
                
        if ( $command =~ /\s+/) {
            next;
        }

        if ( $command =~ /PU(\d+),(\d+)/ ) {
            $pos_start = Grid::Coord->new( $2, $1 );
            next;
        }

        if ( $command =~ /PD(\d+),(\d+)/ ) {
            $pos_end = Grid::Coord->new( $2, $1 );

            if ( !$pos_start->equals($pos_end) ) {

                # Store the position as a line
                push( @lines, [ $pos_start, $pos_end ] );

# And update the last location to ensure we create a valid line when the next command is PD again
                $pos_start = $pos_end;
            }
            else {
                $zero_length_stubs++;
            }
            next;
        }
        if ( $command =~ /IN/ ) {
            say "Init sequence found";
            next;
        }

        if ( $command =~ /SP(\d+)/ ) {
            say "Selected pen $1";
            next;
        }
       
        if ( $command =~ /^PU$/) {
            # Final PU command
            next;
        }

        carp "HPGL command not parsed: '$command'\n";
    }

    my $line_count = scalar(@lines);

    $self->_hpgl_lines(\@lines);
    return ( $line_count, $zero_length_stubs);

}

# Applies the scaling factor to the lines in the data array
sub _scale {
    
    my $self = shift();
        
    # Scale the lines
    my @lines_scaled;
    
    foreach my $line (@{$self->_hpgl_lines()}) {
        my $start_scaled = Grid::Coord->new( $line->[0]->min_y() / $self->scaling_factor(),
            $line->[0]->min_x() / $self->scaling_factor() );
        my $stop_scaled = Grid::Coord->new( $line->[1]->min_y() / $self->scaling_factor(),
            $line->[1]->min_x() / $self->scaling_factor() );

        push( @lines_scaled, [ $start_scaled, $stop_scaled ] );
    }  
    
    $self->_hpgl_lines(\@lines_scaled);
}

sub run {
    my $self = shift();
    
    my ($lines, $zero_stubs)= $self->_parse_hpgl();
    say "Found $lines valid segments in HPGL file";
    say "Skipped $zero_stubs segments with zero length";
    
    $self->_scale();
    $self->_calculate_bbox();
    
    # Report bounding box dimensions, maybe the user wants to change the scaling factor
       say "Object bounding box stretches from (x,y) to (x,y) in millimeter:";
    say "   ("
      . sprintf( '%.3f', $self->_bbox->min_x() ) . " "
      . sprintf( '%.3f', $self->_bbox->min_y() ) . ") ("
      . sprintf( '%.3f', $self->_bbox->max_x() ) . " "
      . sprintf( '%.3f', $self->_bbox->max_y() ) . ")";

    say
"Total dimensions in x and y directions with scaling factor " . $self->scaling_factor() . " in mm are:";
    say "   ("
      . sprintf( '%.3f', $self->_bbox->max_x() - $self->_bbox->min_x() ) . " "
      . sprintf( '%.3f', $self->_bbox->max_y() - $self->_bbox->min_y() ) . ")";
      
    $self->_write_script();
    
    say "Done!";
}


sub _calculate_bbox {
    my $self = shift();

    # Init min and max values to the first point in the dataset
    my $l = $self->_hpgl_lines()->[0]->[0];

# Create bounding box with min and max values to be equal to the first point in the dataset
    $self->_bbox(
      Grid::Coord->new( $l->min_y(), $l->min_x() => $l->max_y(), $l->max_x() )
    );

    foreach my $line (@{$self->_hpgl_lines()}) {
        my $start = $line->[0];
        my $stop  = $line->[1];

        if ( !$self->_bbox->contains($start) ) {
            $self->_grow_bbox( $start );
        }

        if ( !$self->_bbox->contains($stop) ) {
            $self->_grow_bbox( $stop );
        }
    }

}

sub _grow_bbox {
    my $self  = shift();
    my $point = shift();

    my $bbox = \$self->_bbox;
    
    $$bbox->min_y( $point->min_y() ) if ( $point->min_y() < $$bbox->min_y() );
    $$bbox->min_x( $point->min_x() ) if ( $point->min_x() < $$bbox->min_x() );
    $$bbox->max_y( $point->max_y() ) if ( $point->max_y() > $$bbox->max_y() );
    $$bbox->max_x( $point->max_x() ) if ( $point->max_x() > $$bbox->max_x() );

    # Safety check
    warn "Bbox not updated as expected" if ( !$$bbox->contains($point) );

}

sub _write_script {
    my $self = shift();
    
    my $fh = IO::File->new( "> " . $self->output_file );

    if ( defined $fh ) {
        # Generate the script header
        print $fh "# Generated by HPGL2Cadsoft on " . localtime(time) . "\n";
        print $fh "grid mm\n";
        print $fh "grid 1\n";
        print $fh "set wire_bend 2\n";
        print $fh "change width 0\n";

        # Write the wires
        map {