mirror of
				https://github.com/SoftFever/OrcaSlicer.git
				synced 2025-10-31 04:31:15 -06:00 
			
		
		
		
	
		
			
				
	
	
		
			131 lines
		
	
	
	
		
			2.8 KiB
		
	
	
	
		
			Perl
		
	
	
	
	
	
			
		
		
	
	
			131 lines
		
	
	
	
		
			2.8 KiB
		
	
	
	
		
			Perl
		
	
	
	
	
	
| package Slic3r::SVG;
 | |
| use strict;
 | |
| use warnings;
 | |
| 
 | |
| use SVG;
 | |
| 
 | |
| use constant X => 0;
 | |
| use constant Y => 1;
 | |
| 
 | |
| sub factor {
 | |
|     return $Slic3r::resolution * 100;
 | |
| }
 | |
| 
 | |
| sub svg {
 | |
|     my ($print) = @_;
 | |
|     $print ||= Slic3r::Print->new(x_length => 200 / $Slic3r::resolution, y_length => 200 / $Slic3r::resolution);
 | |
|     return SVG->new(width => $print->max_length * factor(), height => $print->max_length * factor());
 | |
| }
 | |
| 
 | |
| sub output_points {
 | |
|     my ($print, $filename, $points, $red_points) = @_;
 | |
|     $red_points ||= [];
 | |
|     
 | |
|     my $svg = svg($print);
 | |
|     my $g = $svg->group(
 | |
|         style => {
 | |
|             'stroke-width' => 2,
 | |
|             'stroke' => 'black',
 | |
|             'fill' => 'black',
 | |
|         },
 | |
|     );
 | |
|     foreach my $point (@$points) {
 | |
|         $g->circle(
 | |
|             cx      => $point->[X] * factor(),
 | |
|             cy      => $point->[Y] * factor(),
 | |
|             r       => 2,
 | |
|         );
 | |
|     }
 | |
|     
 | |
|     my $g2 = $svg->group(
 | |
|         style => {
 | |
|             'stroke-width' => 2,
 | |
|             'stroke' => 'red',
 | |
|             'fill' => 'red',
 | |
|         },
 | |
|     );
 | |
|     foreach my $point (@$red_points) {
 | |
|         $g2->circle(
 | |
|             cx      => $point->[X] * factor(),
 | |
|             cy      => $point->[Y] * factor(),
 | |
|             r       => 3,
 | |
|         );
 | |
|     }
 | |
|     
 | |
|     write_svg($svg, $filename);
 | |
| }
 | |
| 
 | |
| sub output_polygons {
 | |
|     my ($print, $filename, $polygons, $type) = @_;
 | |
|     $type ||= 'polygon';
 | |
|     
 | |
|     my $svg = svg($print);
 | |
|     my $g = $svg->group(
 | |
|         style => {
 | |
|             'stroke-width' => 2,
 | |
|             'stroke' => 'black',
 | |
|             'fill' => 'none',
 | |
|         },
 | |
|     );
 | |
|     foreach my $polygon (@$polygons) {
 | |
|         my $path = $svg->get_path(
 | |
|             'x' => [ map($_->[X] * factor(), @$polygon) ],
 | |
|             'y' => [ map($_->[Y] * factor(), @$polygon) ],
 | |
|             -type => 'polygon',
 | |
|         );
 | |
|         $g->$type(
 | |
|             %$path,
 | |
|         );
 | |
|     }
 | |
|     
 | |
|     write_svg($svg, $filename);
 | |
| }
 | |
| 
 | |
| sub output_polylines {
 | |
|     return output_polygons(@_, 'polyline');
 | |
| }
 | |
| 
 | |
| sub output_lines {
 | |
|     my ($print, $filename, $lines) = @_;
 | |
|     
 | |
|     my $svg = svg($print);
 | |
|     my $g = $svg->group(
 | |
|         style => {
 | |
|             'stroke-width' => 2,
 | |
|         },
 | |
|     );
 | |
|     
 | |
|     my $color = 'red';
 | |
|     my $draw_line = sub {
 | |
|         my ($line) = @_;
 | |
|         $g->line(
 | |
|             x1 => $line->[0][X] * factor(),
 | |
|             y1 => $line->[0][Y] * factor(),
 | |
|             x2 => $line->[1][X] * factor(),
 | |
|             y2 => $line->[1][Y] * factor(),
 | |
|             style => {
 | |
|                 'stroke' => $color,
 | |
|             },
 | |
|         );
 | |
|     };
 | |
|     
 | |
|     my $last = pop @$lines;
 | |
|     foreach my $line (@$lines) {
 | |
|         $draw_line->($line);
 | |
|     }
 | |
|     $color = 'black';
 | |
|     $draw_line->($last);
 | |
|     
 | |
|     write_svg($svg, $filename);
 | |
| }
 | |
| 
 | |
| sub write_svg {
 | |
|     my ($svg, $filename) = @_;
 | |
|     
 | |
|     open my $fh, '>', $filename;
 | |
|     print $fh $svg->xmlify;
 | |
|     close $fh;
 | |
|     printf "SVG written to %s\n", $filename;
 | |
| }
 | |
| 
 | |
| 1;
 | 
