diff options
| -rwxr-xr-x | CAMM.pm | 672 | ||||
| -rw-r--r-- | DXF.pm | 1469 | ||||
| -rw-r--r-- | GPL-2.txt | 339 | ||||
| -rw-r--r-- | GPL-3.txt | 674 | ||||
| -rw-r--r-- | LICENSE.txt | 11 | ||||
| -rw-r--r-- | README.txt | 12 | ||||
| -rwxr-xr-x | camm2svg.pl | 23 | ||||
| -rwxr-xr-x | dxf2camm.pl | 505 | ||||
| -rwxr-xr-x | dxf2xml.pl | 29 | ||||
| -rwxr-xr-x | dxf_simplify.pl | 43 | ||||
| -rwxr-xr-x | xml2dxf.pl | 57 |
11 files changed, 3834 insertions, 0 deletions
@@ -0,0 +1,672 @@ +#!/usr/bin/perl + +# Module to read/write CAMM-GL III content + +## Copyright (c) 2019-2020 by Thomas Kremer +## License: GPL ver. 2 or 3 + +package CAMM; + +# This implements (a subset of) the CAMM-GL III instruction set "mode 2". + +use strict; +use warnings; + +use Math::Trig qw(pi); +#use POSIX qw(lround); + +use overload '""' => "content"; + +use constant units_per_mm => 40; +our $units_per_mm = 40; + +# escape character for writing strings: +#our $escape_char = "\003"; +# examplary slow and fast speed settings: +our $slow = 2; +our $fast = 30; + +# named arguments: +# escape_char: string terminator for text (default: "\003" aka END-OF-TEXT) +# relative, down, speed, char_size, char_slant, tool, +# force, p: current state of the machine (is not set automatically). +# outfile: a file to open for writing (overwrites "f") +# f: a file to write to (overwrites "output") +# output: a scalar ref to append commands or a ref to a subroutine +# (or object) to call for writing commands. (default: new scalar ref) +# no_timeouts: disable timeout detection that checks the tool after inactivity. + +sub new { + my ($class,%args) = shift; + if (defined $args{outfile}) { + open($args{f},">",$args{outfile}) or die "cannot open $args{outfile}: $!"; + } + if (defined $args{f}) { + my $f = $args{f}; + $args{output} = sub { + print $f @_; + }; + } + $args{output} //= \(my $s = ""); + $args{$$_[0]} //= $$_[1] for (["relative",0],["escape_char","\x03"],["down",0]); + return bless \%args, ref $class || $class; +} + +sub copy { + my $self = shift; + return bless {%$self}, ref $self; +} + +package CAMM::Commands { + # This is a list of bare, stateless commands with parameters, + # so mostly sprintf-like functions returning CAMM code. + # Their state logic is managed by the parent module. + + #our $escape_char = "\003"; + sub header { # escape_char + my $escape_char = $_[0]//"\003"; + "\003\015\012\015\012\015\012\015\012\015\012". + ";IN;PU;PA0,0;IW0,0,47000,64000;VS30;DT$escape_char;\n"; + # PA isn't a good idea: + #";IN;PA0,0;IW0,0,47000,64000;VS30;DT$escape_char;\n"; + } + sub set_escape_char { + my $escape_char = $_[0]; + "DT$escape_char;\n"; + } + sub footer { + moveto(0,0); + } + sub tool_up { + "PU;\n"; + } + sub tool_down { + "PD;\n"; + } + sub set_relative { + "PR;\n"; + } + sub set_absolute { + "PA;\n"; + } + sub moveto { # x,y + sprintf "PU%.2f,%.2f;\n", @_; + } + sub lineto { # x,y + sprintf "PD%.2f,%.2f;\n", @_; + } + sub polylineto { # x1,y1,x2,y2,... + "PD".join(",",map {sprintf "%.2f",$_} @_).";\n"; + } + sub set_speed { # v=2..30 is normal; cm/sec; max 85cm/sec + sprintf "VS%d;\n", $_[0]; + } + sub circle { # r; current point is center. + sprintf "CI%.2f;\n", $_[0]; + } + sub arc { # Mx,My,angle; radius is such that it includes the current point. + sprintf "AA%.2f,%.2f,%.2f;\n", @_; + # FIXED: datasheet says "*1"(float), but other angles are "*3"(float)... + } + sub arc_relative { # Mx,My,angle; Mx,My are relative to current point. + sprintf "AR%.2f,%.2f,%.2f;\n", @_; + # FIXED: datasheet says "*1"(float), but other angles are "*3"(float)... + } + sub moveto_relative { # x,y + sprintf "PR;PU%.2f,%.2f;\n", @_; + } + sub lineto_relative { # x,y + sprintf "PR;PD%.2f,%.2f;\n", @_; + } + sub polylineto_relative { # x1,y1,x2,y2,... + "PR;PD".join(",",map {sprintf "%.2f",$_} @_).";\n"; + } + sub set_char_size { # w,h in *cm* + sprintf "SI%.5f,%.5f;\n", @_; + } + sub set_char_slant { # tan(angle) + sprintf "SL%.2f;", $_[0]; + } + sub text { # text,escape_char; text must not contain escape_char + sprintf "LB%s%s\n", $_[0],($_[1]//"\003"); #$escape_char; + } + sub tool_change { + sprintf "SP%d;\n", $_[0]; + } + sub set_force { + sprintf "!FS %d\n", floor($_[0]/10)*10; + } +} + +BEGIN { + # name ? precondition ! postcondition + # -> to invoke <name>, <precondition> has to be guaranteed. + # Afterwards, state has changed to establish <postcondition>. + my @cmdspec = qw( + header!relative=0!down=0 + footer?relative=0!down=0 + tool_up!down=0 + tool_down!down=1 + moveto?relative=0!down=0 + lineto?relative=0!down=1 + polylineto?relative=0!down=1 + circle?down=1 + arc?down=1!relative=0 + arc_relative?down=1!relative=1 + moveto_relative!relative=1!down=0 + lineto_relative!relative=1!down=1 + polylineto_relative!relative=1!down=1 + ); + # set_absolute!relative=0 + # set_relative!relative=1 + # set_speed + # set_char_size + # set_char_slant + # tool_change + # set_force + + my %setters = ( + speed => \&CAMM::Commands::set_speed, + char_size => \&CAMM::Commands::char_size, + char_slant => \&CAMM::Commands::char_slant, + tool => \&CAMM::Commands::tool_change, + force => \&CAMM::Commands::set_force, + escape_char => \&CAMM::Commands::set_escape_char, + down => sub { $_[0] ? + CAMM::Commands::tool_down + : CAMM::Commands::tool_up; + }, + relative => sub { $_[0] ? + CAMM::Commands::set_relative + : CAMM::Commands::set_absolute; + }, + ); + + # sub set_escape_char { + # my ($self,$c) = @_; + # $self->{escape_char} = $c; + # local $CAMM::Commands::escape_char = $c; + # $self->emit(CAMM::Commands::set_escape_char($c)); + # } + + # getters, setters. + for my $name (keys %setters) { + my $sub = sub { + return $_[0]->{$name}; + }; + my $settersub = sub { + $_[0]->set($name,$_[1]); + }; + my $get_name = "get_$name"; + my $set_name = "set_$name"; + no strict "refs"; + *$name = $sub; + *$get_name = $sub; + *$set_name = $settersub; + } + + sub set { + my ($self,$name,$value) = @_; + # if ($name eq "down") { + # $self->emit( + # $value ? + # CAMM::Commands::tool_down + # : CAMM::Commands::tool_up); + # } elsif ($name eq "abs") { + # $self->emit( + # $value ? + # CAMM::Commands::set_absolute + # : CAMM::Commands::set_relative); + # } els + if (defined $setters{$name}) { + $self->emit($setters{$name}($value)); + } else { + die "unknown variable \"$name\""; + } + $self->{$name} = $value; + } + +#my $global_object = __PACKAGE__->new; + + for (@cmdspec) { + my @spec = split /(?=[!?])/, $_; + my $name = shift @spec; + my $command = do { + no strict "refs"; + \&{"CAMM::Commands::$name"}; + }; + my @reqs; + my @sets; + for (@spec) { + if (/^([?!])(\w+)=(\d+)/) { + my $arr = $1 eq "?" ? \@reqs : \@sets; + push @$arr, [$2,0+$3]; + } else { + die "invalid internal spec"; + } + } + my $sub = sub { + #my $self = (@_ && ref $$_[0] eq __PACKAGE__) ? shift : $global_object; + my $self = shift; + for (@reqs) { + if (($self->{$$_[0]}//"-1") != $$_[1]) { + $self->set($$_[0],$$_[1]); + } + } + $self->emit($command->(@_)); + for (@sets) { + $self->{$$_[0]} = $$_[1]; + } + }; + { + no strict "refs"; + *$name = $sub; + } + } + +} + +sub text { + #my $self = (@_ && ref $$_[0] eq __PACKAGE__) ? shift : $global_object; + my $self = shift; + #local $CAMM::Commands::escape_char = $self->{escape_char}; + $self->emit(CAMM::Commands::text($_[0],$self->{escape_char})); +} + +sub emit { + my ($self,$code) = @_; + my $out = $self->{output}; + if (ref $out eq "SCALAR") { + $$out .= $code; +# } elsif (ref $out eq "CODE") { + } else { + # if we've been idle for a couple of seconds, the tool has been upped + # automatically, so we have to down it again. This only applies to + # real-time usage and doesn't hurt otherwise, so we just use it in + # all direct-io cases. + my $lt = \$self->{lasttime}; + my $t = time; + if ($$lt+10 > $t && $self->{down} && !$self->{no_timeouts}) { + $code = CAMM::Commands::tool_down().$code; + } + $$lt = $t; + $out->($code); + } +} + +sub flush { + my $self = shift; + my $output = $self->{output}; + if (ref $output eq "SCALAR") { + my $s = $$output; + $$output = ""; + return $s; + } + return; +} + +sub content { + my $self = shift; + my $output = $self->{output}; + if (ref $output eq "SCALAR") { + my $s = $$output; + return $s; + } + return; +} + +# $paths = [$polyline,...] +# $polyline = ["open"|"closed",[point,...]] +# options: +# boolean: header, footer, headerfooter, relative +# float: epsilon, offset, shortline, smallangle + +sub from_polylines { + my $self = shift; + $self = $self->new unless ref $self; + #my $self = (@_ && ref $$_[0] eq __PACKAGE__) ? shift : $global_object; + my ($paths,%options) = @_; + @options{qw(header footer)} = (1,1) if $options{headerfooter}; + $self->header() if $options{header}; + my $eps = $options{epsilon}//0.00001; + for (@$paths) { + my $points = $$_[1]; + $self->moveto(@{$$points[0]}); + if ($options{offset}) { # if offset = 0, use the other code as well. + my $offs = $options{offset}; + my $short_line = $options{shortline}//80; # 1.5mm is small. + my $small_angle = $options{smallangle}//10; # 10° is small. + my @p = @{$$points[0]}; + my $first = 1; + for my $i (1..$#$points) { + my $pt = $$points[$i]; + my @q = ($$pt[0]-$p[0],$$pt[1]-$p[1]); + my $l = sqrt($q[0]**2+$q[1]**2); + next unless $l > $eps; + my @r = @q; + if ($first) { + $_ *= 1+$offs/$l for @q; + } + $_ *= -$offs/$l for @r; + @p = @$pt; + $first = 0; + + # sadly, we can't use relative coordinates here, because we don't + # know how arc end coordinates are rounded by the device. + + #$res .= CAMM::lineto_relative(@q); + #$res .= CAMM::lineto($$pt[0],$$pt[1]); + #my @q_abs = map lround($$pt[$_]-$r[$_]), 0,1; + my @q_abs = map $$pt[$_]-$r[$_], 0,1; + $self->lineto(@q_abs); + for my $j ($i+1 .. $#$points) { # implicit $i < $#$points + my $pt2 = $$points[$j]; + my @q2 = ($$pt2[0]-$$pt[0],$$pt2[1]-$$pt[1]); + my $l2 = sqrt($q2[0]**2+$q2[1]**2); + next unless $l2 > $eps; + # TODO: since arcs are rather slow, we might want to avoid real + # arcs here and use a polyline approximation instead. + # arg(q2/q1) = arg(q2*conj(q1)) + my $angle = 180/pi* + atan2($q2[1]*$q[0]-$q2[0]*$q[1], $q2[0]*$q[0]+$q2[1]*$q[1]); + #$res .= arc_relative(@r,$angle); + # if the angle is small and the next line is short, we assume an + # interpolated curved line. No need to emphasize the corners. + if (abs($angle) > $small_angle || $l2 > $short_line) { + $self->arc(@p,$angle); + } + last; + } + } + } else { + my @coords; + if ($options{relative}) { + my @p = @{$$points[0]}; + for (@$points[1..$#$points]) { + push @coords, $$_[0]-$p[0],$$_[1]-$p[1]; + @p = @$_; + } + $self->polylineto_relative(@coords); + } else { + @coords = map @$_[0,1], @$points[1..$#$points]; + #$res .= "# ".scalar(@coords)." points;\n"; + $self->polylineto(@coords); + } + } + } + $self->footer() if $options{footer}; + #return $self->flush(); + return $self; +} + +# parsing + +my $florex = qr/[-+]?(?:\d+(?:\.\d+)?|\.\d+)(?:[eE][-+]?\d+)?/; + +sub _take_token { + my ($camm,$esc) = @_; + $$camm =~ s/^\s+//; + my ($cmd,@args); + my $check_numeric = 0; + if ($$camm =~ s/^(?:\^[ \t]*)?([A-Z]{2})//) { + # mode 2 + $cmd = $1; + if ($cmd eq "LB" || $cmd eq "WD") { + my $i = index($$camm,$esc); + die "unterminated \"$cmd\"." if $i == -1; + @args = (substr($$camm,0,$i-1)); + substr($$camm,0,$i) = ""; + # $$camm =~ s/^(.*)\Q$esc\E//s;... + } elsif ($cmd eq "DT") { + @args = (substr($$camm,0,1)); + $$camm =~ s/^.[^;\n]*;//s; + } elsif ($$camm =~ s/^([^;]*);//) { + my $argstr = $1; + die "line break in argument to \"$cmd\"" if $argstr =~ /\n/; + @args = split /,/,$argstr; + $check_numeric = 1; + } else { + die "missing semicolon in command \"$cmd\"."; + } + } elsif ($$camm =~ s/^(![A-Z]{2})(.*)//) { # implicit /$/ + # mode 1 & 2 common + ($cmd,@args) = ($1,$2); + $check_numeric = 1; + } elsif ($$camm =~ s/^\e(\.[A-Z@])//) { + # device control instructions over RS-232 + $cmd = $1; + if ($$camm =~ s/^([^:\n]*)://) { + @args = split /;/, $1; + } + $check_numeric = 1; + } elsif ($$camm =~ s/^([A-Z])//) { + # mode 1 + $cmd = $1; + if ($$camm =~ s/^(.*)//) { + @args = $cmd eq "P" ? ($1) : split /,/,$1; + $check_numeric = 1 if $cmd ne "P"; + } + } else { + return; + } + if ($check_numeric) { + for (@args) { + if (/^\s*($florex)\s*$/) { + $_ = $1; + } else { + die "non-numerical argument \"$_\" in command \"$cmd\"."; + } + } + } + return ($cmd,\@args); +} + +# FIXED: PA,PR,AA,AR don't up/down the pen! +# FIXED: Idleness makes the machine up the pen and not down it again! +# (therefore we use PU/PD whenever possible.) +# FIXED: The machine can do floating point! +# FIXED: PA/PR influence absoluteness/relativity of PU/PD! +# Note: arcs turn positively leftways (as expected). + +our %camm2svg_commands; +{ + my $unimplemented = sub { + warn "command \"$_[1]\" is not implemented yet."; + }; + %camm2svg_commands = ( + # command => sub ($context,$command,@arguments) + # $context = { p => [$x,$y], d => "", escape_char => "\003" } + IN => sub { + @{$_[0]{p}} = (0,0); + $_[0]{escape_char} = "\003"; + $_[0]{d} .= "M 0,0 "; + }, + DT => sub { $_[0]{escape_char} = $_[2]; }, + PA => sub { + $_ = 0+$_ for @_[2..$#_]; + my ($ctx,$cmd,@xy) = @_; + my $i = {PA=>0,PR=>1,PU=>2,PD=>3}->{$cmd}; + $ctx->{$i&2?"down":"relative"} = $i&1; + pop @xy if @xy%2 != 0; + return if !@xy; + + my $p = $ctx->{p}; + my $letter = $ctx->{down} ? "l" : "m"; + if ($ctx->{relative}) { + for (0..$#xy) { + $$p[$_%2] += $xy[$_]; + } + } else { + @$p = @xy[-2,-1]; + $letter = uc($letter); + } + $_[0]{d} .= "$letter ".join(",",@xy)." "; + }, +# PU => sub { +# $_[0]{down} = 0; +# pop if @_%2 != 0; +# return if @_ <= 2; +# $_ = 0+$_ for @_[2..$#_]; +# @{$_[0]{p}} = @_[-2,-1]; +# $_[0]{d} .= "M ".join(",",@{$_[0]{p}})." "; +# }, +# PD => sub { +# $_[0]{down} = 1; +# pop if @_%2 != 0; +# return if @_ <= 2; +# $_ = 0+$_ for @_[2..$#_]; +# @{$_[0]{p}} = @_[-2,-1]; +# $_[0]{d} .= "L ".join(",",@_[2..$#_])." "; +# }, +# PR => sub { +# $_[0]{relative} = 1; +# pop if @_%2 != 0; +# return if @_ <= 2; +# $_ = 0+$_ for @_[2..$#_]; +# my $p = $_[0]{p}; +# for (2..$#_) { +# $$p[$_%2] += $_[$_]; +# } +# $_[0]{d} .= "l ".join(",",@_[2..$#_])." "; +# }, + #AA => alias for AR, + AR => sub { + $_ = 0+$_ for @_[2..$#_]; + my ($ctx,$cmd,$x,$y,$ang) = @_; + my $p = $ctx->{p}; + if ($cmd eq "AA") { + $x -= $$p[0]; + $y -= $$p[1]; + } + my $r = sqrt($x**2+$y**2); + my $a1 = atan2(-$y,-$x); + my $a2 = $a1+$ang/180*pi; + my $longarc = $ang > 180 ? 1 : 0; + my $rightways = $ang < 0 ? 0 : 1; # FIXME: svg coord system is left-handed, but we manually flip the y axis to make do.... + my @dp = ($r*(cos($a2)-cos($a1)),$r*(sin($a2)-sin($a1))); + $$p[$_] += $dp[$_] for 0,1; + if ($ctx->{down}) { + $ctx->{d} .= "a $r,$r,0,$longarc,$rightways,".join(",",@dp)." "; + } else { + $ctx->{d} .= "m ".join(",",@dp)." "; + } + }, + CI => sub { + return unless $_[0]{down}; + $_ = 0+$_ for @_[2..$#_]; + my $r = $_[2]; + $_[0]{d} .= "m $r,0 a $r,$r,0,0,0,".(-2*$r).",0 ". + "a $r,$r,0,0,0,".(2*$r).",0 z m ".(-$r).",0 "; + }, + + IW => sub { # need to implement this because it is in our header. + my ($ctx,$cmd,@args) = @_; + $ctx->{input_window} = [@args]; + #"IW0,0,47000,64000;"; + }, + map({$_ => 0} qw( + OA OC OE OF OH OI OO OP OS OW SS SP VS + !FS !NR !PG !ST + .B .M .N .H .I .@ .O .E .L .J .K .R) # actual no-ops + ), + map({$_ => $unimplemented} qw( + H D M I R L B X P S Q N C E A G K T + CA CP CS DF DI DR EA ER EW FT IM IP LB LT + PT RA RO RR SA SC SI SL SM SR TL UC WD WG XT YT + ) # unimplemented ops + ), + ); + my @aliases = qw( + PD PA + PU PA + PR PA + AA AR + H IN + D PD + M PU + I PR + ); + for (0..@aliases/2-1) { + $camm2svg_commands{$aliases[2*$_]} = $camm2svg_commands{$aliases[2*$_+1]}; + } + # maybe: !PG +} + +# <path d="%s" style='stroke:black; stroke-width: 40px; fill:#000000; fill-opacity:0.2;' /> +our $svg_template = <<'EOSVG'; +<?xml version="1.0" encoding="UTF-8"?> +<svg xmlns="http://www.w3.org/2000/svg" width="%f" height="%f"> +<g transform='scale(0.025,-0.025) translate(%f,%f)'> +%s +</g> +</svg> +EOSVG + +our $svg_path_template = <<'EOSVG'; + <path d="%s" style='stroke:%s; stroke-width: 40px; fill:#000000; fill-opacity:0.2;' /> +EOSVG + +sub to_svgpath { + my ($self,$camm,$splittable) = @_; + $self = $self->new unless ref $self; + my %defcontext = ( + escape_char => "\003", + p => [0,0], + d => "", + ); + $self->{$_} //= $defcontext{$_} for keys %defcontext; + while ($camm ne "") { + my ($cmd,$args) = _take_token(\$camm,$self->{escape_char}); + if (!defined $cmd) { + $camm =~ s/^[^;\n]*[;\n]//; + next; + } + my $handler = $camm2svg_commands{$cmd}; + if (defined $handler) { + $handler->($self,$cmd,@$args) if $handler != 0; + if ($splittable && !$self->{down}) { + $self->{d} .= " M ".join(",",@{$self->{p}})." "; + } + } else { + warn "ignoring unknown command \"$cmd\""; + } + } + my $d = $self->{d}; + delete $self->{d}; + return $d; +} + +# TODO: convert mm to pixels +sub to_svg { + my ($self,$camm,$split,$colored) = @_; + #$self = $self->new unless ref $self; + $self = $self->new(output => sub {}); + my $d = $self->to_svgpath($camm,$split); + my $win = $self->{input_window}; + my @origin = (0,0); + my @size = (100,100); + my $scale = 1/$units_per_mm; + if (defined $win) { + @origin = @$win[0,3]; + $_ = -$_ for @origin; + @size = (($$win[2]-$$win[0])*$scale,($$win[3]-$$win[1])*$scale); + } + my $color = "black"; + my @paths; + if ($split) { + @paths = split /(?=M )/, $d; + my $i = 0; + for (@paths) { + $color = sprintf "#%02x%02x%02x", map 127*(1+cos(($i/@paths*5/6-$_/3)*2*pi)),0..2 + if $colored; + $_ = (sprintf $svg_path_template, $_, $color); + $i++; + } + } else { + @paths = (sprintf $svg_path_template, $d, $color); + } + return sprintf $svg_template, @size, @origin, join("",@paths); +} + +1; + @@ -0,0 +1,1469 @@ +#!/usr/bin/perl + +# Module to read/write DXF files + +## Copyright (c) 2018-2020 by Thomas Kremer +## License: GPL ver. 2 or 3 + +package DXF; + +use strict; +use warnings; + +use List::Util qw(max); +use Math::Trig qw(pi); +use POSIX qw(floor); +use IO::Handle; +# xml related methods will require XML::DOM at runtime. +#use XML::DOM; + +# --- internal stuff --- + +# 9: variable name identifier. +our %dxf_node_ids = (0 => 1, 9 => 1); +our %dxf_end_nodes = ( + "ENDSEC" => "SECTION", + "ENDTAB" => "TABLE", + "EOF" => "dxf", + "ENDBLK" => "BLOCK", # ENDBLK has additional parameters?! + "SEQEND" => "POLYLINE", +); + +our %dxf_attr_names = ( + 1 => "text", + 2 => "name", + 3 => "text2", + 4 => "text3", + 5 => "handle", # entity handle, up to 16 hex digits. + 6 => "linetype", + 7 => "textstyle", + 8 => "layer", + # 10..18: x, 20..28: y, 30..37: z + 38 => "elevation", + 39 => "thickness", +# 40 = radius of circle, but other floats in other contexts... +# 40 => "r", # 40-48: floating point values... + 48 => "linetype_scale", + 49 => "values", # multiple values that make up a list, need a repeat count (7x) before! + # 50..58: angles in degrees + 60 => "invisibile", # 1 for invisible, 0 or undef for visible + 62 => "color", + 66 => "entities_follow", # flag. what for? + 67 => "space", # model- or paper-space + # 70-78: integer values, such as repeat counts, flag bits or modes + # 90-98: 32-bit integer values + 100 => "subclass", # required if object is derived from another concrete class + 102 => "control_string", # application defined stuff + 105 => "dimvar_handle", + 210 => "extrusion_direction_x", + 220 => "extrusion_direction_y", + 230 => "extrusion_direction_z", + + 999 => "comment", + + # we ignore anything above 999 here for now. + + # TODO: object-specific attribute names. Sometimes sensible... + +# TABLE: 2, 70 +# LAYER: 2, 6, 62, 70 +# LTYPE: 3, 40, 70, 72, 73 +); + +my @dxf_groupcode_typeranges = ( + [10,9,"x"],[20,9,"y"],[30,8,"z"], + [40,8,"float"], + [50,9,"angle"], + [70,9,"int"],[90,9,"int_32"],[280,10,"int_8"], + [290,10,"bool"],[300,10,"textstring"],[310,10,"blob"], + [320,10,"obj_handle"],[330,10,"softptr"],[340,10,"hardptr"], + [350,10,"softowner"],[360,10,"hardowner"], +# ... + [370,10,"lineweight"],[380,10,"plotstyle"],[390,10,"plotstyle_handle"], + [400,10,"int_16"], + [410,10,"string"], +); + +# Attributes that are preserved when substituting an entity by +# one or more simpler entities in boil_down(). +our @general_attributes = qw( + linetype + textstyle + layer + elevation + thickness + linetype_scale + invisibile + color + space + comment +); + +for my $range (@dxf_groupcode_typeranges) { + my $name = $$range[2]; + my $start = $$range[3]//0; + my $sep = substr($name,-1) =~ /^\d$/ ? "_" : ""; + for (0..$$range[1]) { + my $i = $start+$_; + $dxf_attr_names{$$range[0]+$_} = $name.($i == 0 ? "" : $sep.$i); + } +} + + +our %dxf_attr_ids = reverse %dxf_attr_names; +our %dxf_node_ends = reverse(%dxf_end_nodes);#, "dxf" => "EOF"); +#$dxf_attr_ids{$dxf_attr_names{$_}} = $_ for keys %dxf_attr_names; + +sub dxf_node_id { $_[0] =~ /^\$/ ? 9 : 0 } + + +# my %dxf_node_id0 = ( +# SECTION => 1, +# TABLE => 1, +# dxf => 1, +# VPORT => 1, +# LTYPE => 1, +# +# ); + +# -- basic parsing and construction -- + +sub parse_dxf { + my $fh = shift; + if (ref $fh eq "") { + my $s = $fh; + $fh = undef; + open ($fh, "<", \$s) or die "cannot open memory file"; + } + my $root = {name => "dxf", attrs => {}, children => []}; + my @contents = ($root); + while (my $id = <$fh>) { + my $param = <$fh>; + chomp $id; + if ($id =~ /^\s*(\d+)\s*$/) { + $id = $1; + } else { + die "id \"$id\" is not numeric as expected"; + } + chomp $param; + $param =~ s/\r$//; + if ($dxf_node_ids{$id}) { +# print STDERR "$param => $id\n" if $id == 9; + push @contents, {name => $param, attrs => {}, children => []}; + } else { + my $attr = $dxf_attr_names{$id}//"i$id"; + my $att = \$contents[-1]{attrs}{$attr}; + if (!defined($$att)) { + $$att = $param; + } elsif (ref $$att eq "ARRAY") { + push @$$att, $param; + } else { + $$att = [$$att,$param]; + } + #$contents[-1]{attrs}{$attr} = $param; + } + } + for (my $i = 0; $i <= $#contents; $i++) { + my $start = $dxf_end_nodes{$contents[$i]{name}}; + if (defined $start) { + my $begin = undef; + for (my $j = $i-1; $j >= 0; $j--) { + if ($contents[$j]{name} eq $start && !$contents[$j]{_completed}) { + $begin = $j; + last; + } + } + if (!defined $begin) { + warn "end tag found without matching starting \"$start\""; + splice @contents,$i,1; + $i--; + next; + } + my $parent = $contents[$begin]; + my @children = splice(@contents,$begin+1,$i-$begin); + + # Preserve the endtag, as it may have individual attributes and + # we don't want to drop any information at this stage. + $parent->{endtag} = pop @children; + for (@children) { + delete $_->{_completed}; + } + $parent->{children} = \@children; + $parent->{_completed} = 1; + $i = $begin; + } + } + for (@contents) { + delete $_->{_completed}; + } +# if ($contents[-1]{name} eq "EOF") { +# pop @contents; +# } else { +# warn "EOF tag is missing."; +# } + if (@contents != 1) { + die "EOF tag is missing (or worse)."; + } + if ($contents[0] != $root) { + die "something went terribly wrong!"; + } + #my $root = {name => "dxf", attrs => {}, children => \@contents}; + return $root; +} + +sub lol2xml { + my ($lol,$doc,$indent) = @_; + my $name = $lol->{name}//"dxf"; + $name =~ s/\$/_/g; + my $node; + + $indent = "" unless defined $indent; + + if (!defined $doc) { + require XML::DOM; + $doc = XML::DOM::Parser->new->parse("<$name></$name>"); + $node = $doc->getDocumentElement; + #$doc = XML::DOM::Document->new(); + } else { + $node = $doc->createElement($name); + } + + my @attrs = keys %{$lol->{attrs}}; + @attrs = sort + { + ($a =~ /^i(\d+)$/ ? $1 : $dxf_attr_ids{$a}) <=> + ($b =~ /^i(\d+)$/ ? $1 : $dxf_attr_ids{$b}) + } @attrs; + for (@attrs) { + my $attr = $_; + my $value = $lol->{attrs}{$attr}; + # XML doesn't accept multiple attributes of the same name, but DXF does. + if (ref $value eq "ARRAY") { + $value = join(" ",@$value); + $attr .= "-array"; + } + $node->setAttribute($attr,$value); +# for (ref ($value) eq "ARRAY" ? @$value : $value) { +# $node->setAttribute($attr,$_); +# } + } + my @children = @{$lol->{children}}; +# my $i = 0; + for (@children) { + $node->appendChild($doc->createTextNode("\n ".$indent)); + $node->appendChild(lol2xml($_,$doc,$indent." ")); +# $node->appendChild($doc->createTextNode("\n".($i == $#children ? "" : " ").$indent)); +# $i++; + } + my $emit_endtag = defined $lol->{endtag} && %{$lol->{endtag}{attrs}}; + if ($emit_endtag) { + $node->appendChild($doc->createTextNode("\n ".$indent)); + my $s = lol2xml($lol->{endtag},$doc,"")->toString; + $s =~ s/^</ /; + $s =~ s/\/>$/ /; + $node->appendChild($doc->createComment($s)); + } + $node->appendChild($doc->createTextNode("\n".$indent)) if @children || $emit_endtag; + return $node; +} + +sub lol { + my ($type,$attr,$content) = @_; + if (@_ == 2) { + if (ref $attr eq "HASH") { + $content = []; + } elsif (ref $attr eq "ARRAY") { + $content = $attr; + $attr = {}; + } else { + die "invalid lol"; + } + } elsif (@_ == 1) { + $attr = {}; + $content = []; + } elsif (@_ == 3) { + die "invalid lol" unless ref $attr eq "HASH" && ref $content eq "ARRAY"; + } else { + die "invalid lol"; + } + return { name => $type, attrs => $attr, children => $content}; +} + +sub minimal_header_lol { + return + lol("SECTION",{name=>"HEADER"},[ + lol("\$ACADVER",{text=>"AC1014"}), # "caption"? where did it come from? + lol("\$HANDSEED",{handle=>"FFFF"}), # i5 + lol("\$MEASUREMENT",{int=>1}) # i70 + ]); +} + +sub drawing2dxflol { + my (%layers) = @_; + my @lines; + for my $layer (keys %layers) { + my $paths = $layers{$layer}; + for (@$paths) { + if (ref($_) eq "ARRAY") { + next if @$_ < 2; +# my $type = ... + my $p = $$_[0]; + for my $i (1..$#$_) { + my $q = $$_[$i]; + push @lines, lol(LINE => {x=>$$p[0], y=>$$p[1],x1=>$$q[0],y1=>$$q[1], layer => $layer}); + $p = $q; + } + } + } + } + + my $lol = lol("dxf",[ + minimal_header_lol(), +# lol("SECTION",{name=>"HEADER"},[ +# lol("\$ACADVER",{text=>"AC1014"}), # "caption"? where did it come from? +# lol("\$HANDSEED",{handle=>"FFFF"}), # i5 +# lol("\$MEASUREMENT",{int=>1}) # i70 +# ]), + lol(SECTION => {name => "BLOCKS"}), + lol(SECTION => {name => "ENTITIES"},[ + @lines + ]), + lol(SECTION => {name => "OBJECTS"},[lol("DICTIONARY")]) + ]); + return $lol; +} + +sub lol2dxf { + my ($lol,$pr) = @_; + my $res = ""; + if (!defined $pr) { + $pr = sub { $res .= $_ for @_; }; + } + + my ($name,$attrs,$children,$endtag) = @$lol{qw(name attrs children endtag)}; + + my $node_id = dxf_node_id($name); + $pr->(sprintf "%3d\n%s\n", $node_id, $name) if $name ne "dxf"; + my %seen; + for my $attr (sort +# { +# ($a =~ /^i(\d+)$/ ? $1 : $dxf_attr_ids{$a}) <=> +# ($b =~ /^i(\d+)$/ ? $1 : $dxf_attr_ids{$b}) +# } + keys %$attrs) { + next if $seen{$attr}; + my $param = $attrs->{$attr}; + my $id = $attr =~ /^i(\d+)$/ ? $1 : $dxf_attr_ids{$attr}; + die "invalid attribute \"$attr\" in node \"$name\" (value \"".($param//"undef")."\")" unless defined $id; + + if ($id >= 10 && $id < 20 && ref($param) eq "ARRAY") { + # special case: coordinates of multiple points must be interleaved. + my $y = $dxf_attr_names{$id+10}; + my $z = $dxf_attr_names{$id+20}; + my @x = @$param; + my $_y = $attrs->{$y}//[]; + my $_z = $attrs->{$z}//[]; + my @y = ref $_y ? @$_y : ($_y); + my @z = ref $_z ? @$_z : ($_z); + my $max = max($#x,$#y,$#z); + my @p = map [$x[$_],$y[$_],$z[$_]], 0..$max; + for (@p) { + for my $i (0..2) { + $pr->(sprintf "%3d\n%s\n", $id+$i*10, $$_[$i]) if defined $$_[$i]; + } + } + $seen{$y} = 1; + $seen{$z} = 1; + } else { + for (ref ($param) eq "ARRAY" ? @$param : $param) { + $pr->(sprintf "%3d\n%s\n", $id, $_); + } + } + } + for (@$children) { + lol2dxf($_,$pr); + } + if (defined $endtag) { + lol2dxf($endtag,$pr); + } else { + my $nodeend = $dxf_node_ends{$name}; + $pr->(sprintf "%3d\n%s\n", $node_id, $nodeend) if defined $nodeend; + } + return $res; +} + +sub drawing2dxf { + return lol2dxf(drawing2dxflol(@_)); +} + +sub xml2lol { + my $node = shift; + my $name = $node->getTagName; + $name =~ s/^_/\$/; + my @xmlattrs = $node->getAttributes->getValues; + my %attrs; + for (@xmlattrs) { + my $aname = $_->getName; + my $aval = $_->getValue; + if ($aname =~ s/-array$//) { + $aval = [split / /,$aval]; + } + $attrs{$aname} = $aval; + } + my @children; + for ($node->getChildNodes) { + require XML::DOM; + if ($_->getNodeType == XML::DOM::ELEMENT_NODE()) { + push @children, xml2lol($_); + } + } + return lol($name => \%attrs,\@children); +} + +# -- modification and filters -- + +sub deep_copy { + my ($x,$prefilter,$postfilter) = @_; + my $ctx = {}; + if (defined $prefilter) { + $x = $prefilter->($x,$ctx); + } + my $r = ref $x; + if (($r//"") eq "") { + $x = $postfilter->($x,$ctx) if defined $postfilter; + return $x; + } + if ($r eq "SCALAR") { + my $pv = deep_copy($$x); + my $v = \$pv; + $v = $postfilter->($v,$ctx) if defined $postfilter; + return $v; + } elsif ($r eq "ARRAY") { + my $v = [@$x]; + $_ = deep_copy($_) for @$v; + $v = $postfilter->($v,$ctx) if defined $postfilter; + return $v; + } elsif ($r eq "HASH") { + my $v = {%$x}; + $$v{$_} = deep_copy($$v{$_}) for keys %$v; + $v = $postfilter->($v,$ctx) if defined $postfilter; + return $v; + } else { + die "cannot deep_copy type \"$r\"."; + } +} + +# To make calling conventions more clear we let argument-modifying +# procedural subs below explicitly return 1. + +#sub sample_prefilter { +# my $arr = shift; +# @$arr = (@$arr,@$arr); +# $$arr[0]{attrs}{comment} = "Has been visited and duplicated"; +# return (1,1); +#} + +# each filter gets an array, may modify that +# array, but must return 1 iff it did. +# Additionally it gets a hashref that can be used to transfer information +# from prefilter to postfilter. +# prefilter may return a second value, indicating whether to skip +# the node's contents. +# prefilter's array always contains exactly 1 element. +# postfilter gets the array the way prefilter leaves it. +sub tree_walk { + my ($node,$prefilter,$postfilter) = @_; + my $list = $node->{children}; + return if !defined $list || !@$list; + for (my $i = 0; $i <= $#$list; $i++) { + my @x = ($$list[$i]); + my $ctx = {}; + my ($mod,$skip) = (defined $prefilter && $prefilter->(\@x,$ctx)); + if (!$skip) { + for (@x) { + tree_walk($_,$prefilter,$postfilter); + } + } + $mod ||= (defined $postfilter && $postfilter->(\@x,$ctx)); + if ($mod) { + splice(@$list,$i,1,@x); + $i += @x-1; + } + } + return 1; +} + +sub get_sections { + my ($dxf,$croak_on_duplicates) = @_; + my %sections; + for (@{$dxf->{children}}) { + if ($_->{name} eq "SECTION") { + my $n = $_->{attrs}{name}; + if (defined $sections{$n}) { + die "duplicate section \"$n\"" if $croak_on_duplicates; + push @{$sections{$n}{children}}, @{$_->{children}}; + } else { + $sections{$n} = $_; + } + } + } + return \%sections; +} + +# - keep all objects. +# - merge duplicate sections. +# - remove stored end tags. +# modifies the input. +sub canonicalize { + my $dxf = shift; + my $sections = get_sections($dxf); + for (qw(CLASSES TABLES BLOCKS ENTITIES OBJECTS)) { + $$sections{$_} //= lol(SECTION => {name => $_}); + } + $$sections{HEADER} //= minimal_header_lol(); + $dxf->{children} = [@$sections{qw(HEADER CLASSES TABLES BLOCKS ENTITIES OBJECTS)}]; + + tree_walk($dxf,sub { delete $_[0][0]{endtag}; }); + return 1; +} + +# strip comments, tables, objects +# modifies the input. +sub strip { + my $dxf = shift; + my %delete_sections = ( TABLES => 1, CLASSES => 1); + my %clear_sections = ( BLOCKS => 1, OBJECTS => 1); + + @{$dxf->{children}} = grep !$delete_sections{$_->{attrs}{name}//""}, @{$dxf->{children}}; + for (@{$dxf->{children}}) { + if ($clear_sections{$_->{attrs}{name}//""}) { + $_->{children} = []; + } + } + delete $dxf->{attrs}{comment}; + tree_walk($dxf,sub { delete $_[0][0]{attrs}{comment}; }); + return 1; +} + +# makes a copy and removes superfluous data. +sub clean_dxf { + my $dxf = deep_copy(shift()); + strip($dxf); + return $dxf; +# my %delete_sections = ( TABLES => 1); +# my %clear_sections = ( BLOCKS => 1, OBJECTS => 1); +# +# @{$dxf->{children}} = grep !$delete_sections{$_->{attrs}{name}//""}, @{$dxf->{children}}; +# for (@{$dxf->{children}}) { +# if ($clear_sections{$_->{attrs}{name}//""}) { +# $_->{children} = []; +# } +# } +# return $dxf; +} + +# gets an array of entities that belong to a given block and transforms them according to an <INCLUDE> node. +# $blocks is a hashref of known blocks, $node is the INCLUDE node. +sub get_block_replacement { + my ($blocks,$node) = @_; + my ($insblock,$x,$y,$z,$xscale,$yscale,$zscale,$rot,$cols,$rows,$colspace,$rowspace) = @{$node->{attrs}}{qw(name x y z float1 float2 float3 angle int int1 float4 float5)}; + die "undefined block used" unless defined $blocks->{$insblock}; + die "incomplete block usage" unless $blocks->{$insblock}{finished}; + my @anchor = @{$blocks->{$insblock}{block}{attrs}}{qw(x y z)}; + $_ //= 0 for @anchor,$colspace,$rowspace; + $_ //= 1 for $cols,$rows; + my @p = ($x//0,$y//0,$z//0); + my @s = ($xscale//1,$yscale//1,$zscale//1); + my ($c,$s) = (cos($rot/180*pi),sin($rot/180*pi)); + + my $inserted = $blocks->{$insblock}{objects}; + my %supported = ( + LINE => 1, + SPLINE => 1, + POINT => 1, + LWPOLYLINE => 1, + ); + #print STDERR "inserting: ".Dumper($inserted); + my @res; + #die "not implemented" if ($cols//1) != 1 || ($rows//1) != 1; + for my $row (0..$rows-1) { + for my $col (0..$cols-1) { + my @pos = @p; + $pos[0] += $col*$colspace; + $pos[1] += $row*$rowspace; + for (@$inserted) { + die "not implemented" unless $supported{$_->{name}}; + my %a = %{$_->{attrs}}; + die "unexpected child" if @{$_->{children}}; + for (0..9) { + my ($x,$y,$z) = @DXF::dxf_attr_names{10+$_,20+$_,30+$_}; + if (defined $a{$x}) { + my @v = @a{$x,$y,$z}; + if (!defined $v[2]) { + $v[2] = ref($v[0]) eq "ARRAY" ? [(0)x@{$v[0]}] : 0; + } + if (ref $v[0] eq "ARRAY") { + $_ = [@$_] for @v; + for my $i (0..$#{$v[0]}) { + $v[$_][$i] -= $anchor[$_] for 0..2; + $v[$_][$i] *= $s[$_] for 0..2; + ($v[0][$i],$v[1][$i]) = ($v[0][$i]*$c-$v[1][$i]*$s, + $v[0][$i]*$s+$v[1][$i]*$c); + $v[$_][$i] += $pos[$_] for 0..2; + } + @a{$x,$y,$z} = @v; + } else { + $v[$_] -= $anchor[$_] for 0..2; + $v[$_] *= $s[$_] for 0..2; + ($v[0],$v[1]) = ($v[0]*$c-$v[1]*$s,$v[0]*$s+$v[1]*$c); + $v[$_] += $pos[$_] for 0..2; + @a{$x,$y,$z} = @v; + } + #print STDERR "changed $x/$y/$z\n"; + } + #print STDERR "tried $x/$y/$z\n"; + } + push @res, DXF::lol($_->{name},\%a); + } + } + } + return \@res; +} + +# TODO: safe recursion +sub flatten { + my $dxf = shift; + my @blocksecs = grep $_->{attrs}{name} eq "BLOCKS", @{$dxf->{children}}; + my %blocks; + for (@blocksecs) { + for (@{$_->{children}}) { + die "non-block in blocks section" unless $_->{name} eq "BLOCK"; + my $n = $_->{attrs}{name}; + die "duplicate block \"$n\"" if defined $blocks{$n}; + $blocks{$n} = { finished => 1, block => $_, objects => $_->{children} }; + } + } + tree_walk($dxf,sub { + my ($x,$ctx) = @_; + return (0,1) + if $$x[0]{name} eq "SECTION" && + $$x[0]{attrs}{name} !~ /^BLOCKS$|^ENTITIES$|^OBJECTS$/; + if ($$x[0]{name} eq "BLOCK") { + my $n = $$x[0]{attrs}{name}; + $blocks{$n}{finished} = 0; + $ctx->{name} = $n; + } + if ($$x[0]{name} eq "INSERT") { + my $n = $$x[0]{attrs}{name}; + my $insobjects = get_block_replacement(\%blocks,$$x[0]); + @$x = @$insobjects; + # FIXME: recursion protection done right. + #$blocks{$n}{finished} = 0; + #$ctx->{name} = $n; + return 1; + } + },sub { + my ($x,$ctx) = @_; + if (defined $ctx->{name}) { + $blocks{$ctx->{name}}{finished} = 1; + } + #if (@$x && $$x[0]{name} eq "BLOCK") { + # $blocks{$$x[0]{attrs}{name}}{finished} = 1; + #} + }); + return 1; +} + +# removes superfluous garbage and flattens all INCLUDEs. +sub flatten_dxf { + my $dxf = deep_copy(shift()); + canonicalize($dxf); + flatten($dxf); + strip($dxf); + my $sections = get_sections($dxf); + $$sections{BLOCKS} = DXF::lol(SECTION => {name => "BLOCKS"}); + # actually we may even drop the whole section. + $dxf = DXF::lol("dxf",[@$sections{qw(HEADER BLOCKS ENTITIES OBJECTS)}]); + return $dxf; +} + +## removes superfluous garbage and flattens all INCLUDEs. +#sub flatten_dxf { +# my $dxf = deep_copy(shift()); +# delete $dxf->{attrs}{comment}; +# for (@{$dxf->{children}}) { +# undef $_, next if $_->{name} ne "SECTION"; +# undef $_, next if !defined $_->{attrs}{name}; +# delete $_->{attrs}{comment}; +# delete $_->{attrs}{comment} for @{$_->{children}//[]}; +# } +# my (%sections,%blocks,@entities,@objects); +# @entities = ([],[]); +# for (@{$dxf->{children}}) { +# next unless defined; +# if ($_->{attrs}{name} eq "BLOCKS") { +# my $blocks = $_->{children}; +# my $current_block = ""; +# my $objects; +# for my $i (0..$#$blocks) { +# if ($blocks->[$i]{name} eq "BLOCK") { +# $current_block = $blocks->[$i]{attrs}{name}; +# $objects = []; +# $blocks{$current_block} = +# { finished => 0, start => $i, objects => $objects}; +# } elsif ($blocks->[$i]{name} eq "ENDBLK") { +# @{$blocks{$current_block}}{qw(finished end)} = (1,$i); +# $objects = undef; +## print STDERR "finished block $current_block:\n".Dumper(\%blocks); +# $current_block = ""; +# } else { +# if ($blocks->[$i]{name} eq "INSERT") { +# my $insobjects = get_block_replacement(\%blocks,$blocks->[$i]); +# push @$objects, @$insobjects; +# } else { +# push @$objects, $blocks->[$i]; +# } +# } +# } +## undef $_; +# } elsif ($_->{attrs}{name} eq "ENTITIES" || +# $_->{attrs}{name} eq "OBJECTS") { +# my $type = $_->{attrs}{name} eq "ENTITIES" ? 0 : 1; +# for (@{$_->{children}}) { +# if ($_->{name} eq "INSERT") { +# my $insobjects = get_block_replacement(\%blocks,$_); +## print STDERR "inserted block ".$_->{attrs}{name}.":\n".Dumper($insobjects); +# push @{$entities[$type]},@$insobjects; +# } else { +# push @{$entities[$type]},$_; +# } +# } +## undef $_; +# } else { +# push @{$sections{$_->{attrs}{name}}}, $_; +# } +# } +# for (keys %sections) { +# my $all = $sections{$_}; +# my $first = shift @$all; +# for (@$all) { +# push @{$first->{children}}, @{$_->{children}}; +# } +# $sections{$_} = $first; +# } +# #my @sections = grep defined, @{$dxf->{children}}; +# $sections{ENTITIES} = DXF::lol(SECTION => {name => "ENTITIES"},$entities[0]); +# $sections{OBJECTS} = DXF::lol(SECTION => {name => "OBJECTS"},$entities[1]); +# $sections{BLOCKS} = DXF::lol(SECTION => {name => "BLOCKS"}); # actually we may even drop the whole section. +# if (!defined $sections{HEADER}) { +# $sections{HEADER} = DXF::minimal_header_lol(); +# } +# $dxf = DXF::lol("dxf",[@sections{qw(HEADER BLOCKS ENTITIES OBJECTS)}]); +# return $dxf; +#} + +sub merge_dxf { + my ($dxf1,$dxf2) = @_; + + # ignore BLOCKS, we can't handle them anyway. + # delete TABLES. They will not be up-to-date. + # join ENTITIES. That's what we're interested in. + # what are OBJECTS anyway? Better delete them, there are some dictionaries there... + my ($e1) = grep(($_->{attrs}{name}//"") eq "ENTITIES", @{$dxf1->{children}}); + my @e2 = grep(($_->{attrs}{name}//"") eq "ENTITIES", @{$dxf2->{children}}); + + push @{$e1->{children}}, map @{$_->{children}}, @e2; + return $dxf1; +} + +sub colorize_dxf { + my ($dxf,$color) = @_; + #my @e = grep(($_->{attrs}{name}//"") eq "ENTITIES", @{$dxf->{children}}); + for (@{$dxf->{children}}) { + if (($_->{attrs}{name}//"") eq "ENTITIES") { + for (@{$_->{children}}) { + $_->{attrs}{color} = $color; + } + } + } + return $dxf; +} + +# POINT, LINE, SPLINE, POLYLINE, LWPOLYLINE, CIRCLE, ARC, ELLIPSE, TEXT, INCLUDE, + +# POLYLINE +# SPLINE----------------------> v +# \---> ARC -> ELLIPSE -> LWPOLYLINE <---> LINE +# CIRCLE------^ + +# spline -> circle: +# p1 ---p2 p3 +# | | +# | __-- p4 +# X--M2-- +# | +# M1 +# +# [p1,p2,p3,p4] -> arc(p1-M1-q,r=r1),arc(q-M2-p4,r=r2) +# a := |p1,X|, x := |X,M1|; b := |p4,X|, y := |X,M2|; phi := deg(p1,X,p4) +# r1 = a+x, r2 = b-y, l := a-b, r1-r2 = |M1,M2| = |[y*cos(phi)+x,y*sin(phi)]| +# r1-r2 = a-b+x+y = |[y*cos(phi)+x,y*sin(phi)]| +# = sqrt((y*c+x)^2+y^2*(1-c^2)) +# = sqrt(y^2*c^2+x^2 +2*y*c*x +y^2-y^2*c^2) +# l+x+y = sqrt(x^2+y^2 +2*x*y*c) +# l^2+x^2+y^2+2*x*y+2*l*(x+y) = x^2+y^2 +2*x*y*c +# l^2 + 2*l*(x+y) + 2*x*y*(1-c) = 0 +# l^2 + 2*l*x + 2*l*y + 2*x*y*(1-c) = 0 +# y = -(l^2 + 2*l*x)/(2*l + 2*x*(1-c)) +# m := r1/r2 = (a+x)/(b-y) +# y = b-(a+x)/m +# b-(a+x)/m = -(l^2 + 2*l*x)/(2*l + 2*x*(1-c)) +# (b-(a+x)/m)*(2*l + 2*x*(1-c)) = -(l^2 + 2*l*x) +# 2*(b*m-a-x)*(l + x*(1-c)) + l^2*m = -2*l*x*m +# 2*(b*m-a)*l + 2*(b*m-a)*x*(1-c) - 2*x*l - 2*x^2*(1-c) + l^2*m + 2*l*x*m = 0 +# -2*(1-c)*x^2 + 2*((b*m-a)*(1-c) + l*(m-1))*x + (2*b*m+l*m-2*a)*l = 0 + +# TODO: code 70: open and closed splines and polylines. +# dest => source => sub{} +my %replacers = ( + LWPOLYLINE => { + SPLINE => sub { + my $node = shift; + my (@x,@y); + my @sx = @{$node->{attrs}{x}}; + my @sy = @{$node->{attrs}{y}}; + my $deg = $node->{attrs}{int1}//3; + my $flags = $node->{attrs}{int}//8; + my $closed = $flags & 1; + my $planar = $flags & 8; + die "degrees other than 3 are not implemented" unless $deg == 3; + warn "spline not marked as planar. Using it anyway" unless $planar; + die "invalid spline" + unless @sx == @sy && (@sx % 3) == 1; + push @x, $sx[0]; + push @y, $sy[0]; + my $fn = 20; + while (@sx >= 4) { + # TODO: subdivide by angle first. Estimate curvature. + for my $i (1..$fn) { + my $t = $i/$fn; + my $x1 = $sx[0]*(1-$t)**3 + 3*$sx[1]*(1-$t)**2*$t + + 3*$sx[2]*(1-$t)*$t**2 + $sx[3]*$t**3; + my $y1 = $sy[0]*(1-$t)**3 + 3*$sy[1]*(1-$t)**2*$t + + 3*$sy[2]*(1-$t)*$t**2 + $sy[3]*$t**3; + push @x, $x1; + push @y, $y1; + #push @coords,$x1,$y1; + #@p = ($x1,$y1); + } + splice @sx,0,3; + splice @sy,0,3; + } + return lol(LWPOLYLINE => {x => \@x, y => \@y, int => $closed?1:0}); + }, + POLYLINE => sub { + my $node = shift; + my (@x,@y); + my $flags = $node->{attrs}{int}//0; + my $closed = $flags & 1; + for (@{$node->{children}}) { + die "invalid POLYLINE" unless $_->{name} eq "VERTEX"; + push @x, $_->{attrs}{x}; + push @y, $_->{attrs}{y}; + } + return lol(LWPOLYLINE => {x => \@x, y => \@y, int => $closed?1:0}); + }, + # DONE: Test whether my idea of an ellipse is the same as librecad's. + ELLIPSE => sub { + my $node = shift; + my (@x,@y); + my($x,$y,$x1,$y1,$min,$a1,$a2) = @{$node->{attrs}}{qw(x y x1 y1 float float1 float2)}; + # f(t) = [$x,$y]+scale($min along [$y1,-$x1])turn($a1+($a2+$a1)*t)[$x1,$y1] + my $incl = atan2($y1,$x1); + my $r1 = sqrt($x1**2+$y1**2); + my $r2 = $min*$r1; + # f(t) = [$x,$y]+turn(incl)[cos(a)*$r1,sin(a)*$r2] + + # Not sensible, but this is how it's interpreted by librecad: + while ($a2 < $a1) { + $a2 += 2*pi; + }# 0.000000005 + while ($a2 > $a1+2*pi+0.000000005) { # constant estimated by experimentation. + $a2 -= 2*pi; + } + my $rounds = ($a2-$a1)/pi/2; + my $closed = $rounds-floor($rounds) < 0.001; + + my $fn = floor(($a2-$a1)*$r1); # 1mm minimum + $fn = 20 if $fn < 20; + + for my $i (0..$fn) { + my $t = $i/$fn; + my $angle = $a1+($a2-$a1)*$t; + my ($px,$py) = (cos($angle)*$r1,sin($angle)*$r2); + my ($qx,$qy) = ($x+$px*cos($incl)-$py*sin($incl), + $y+$px*sin($incl)+$py*cos($incl)); + push @x, $qx; + push @y, $qy; + } + return lol(LWPOLYLINE => {x => \@x, y => \@y, int => $closed?1:0}); + }, + LINE => sub { + my $node = shift; + my (@x,@y); + @x = @{$node->{attrs}}{qw(x x1)}; + @y = @{$node->{attrs}}{qw(y y1)}; + return lol(LWPOLYLINE => {x => \@x, y => \@y, int => 0}); + }, + }, + ELLIPSE => { + ARC => sub { + my $node = shift; + my($x,$y,$r,$a1,$a2) = @{$node->{attrs}}{qw(x y float angle angle1)}; + return lol(ELLIPSE => {x => $x, y => $y, x1 => $r, y1 => 0, + float => 1, float1 => $a1*pi/180, float2 => $a2*pi/180}); + } + }, + ARC => { + CIRCLE => sub { + my $node = shift; + my($x,$y,$r) = @{$node->{attrs}}{qw(x y float)}; + return lol(ARC => {x => $x, y => $y, float => $r, + angle => 0, angle1 => 360}); + }, +# SPLINE => sub { +# # TODO: approximate (reasonably small/simple) spline with two arcs, +# # maintaining smoothness of the curve. +# ... +# } + }, + LINE => { + LWPOLYLINE => sub { + my $node = shift; + my @x = @{$node->{attrs}{x}}; + my @y = @{$node->{attrs}{y}}; + die "invalid polyline" + unless @x == @y && @x >= 1; + my @lines = map lol(LINE => {x => $x[$_], y => $y[$_], + x1 => $x[$_+1], y1 => $y[$_+1] }), 0..$#x-1; + return @lines; + } + }, +); + +sub boil_down { + my ($dxf,$acceptable,$to_replace) = @_; + $to_replace //= [map keys %$_, values %replacers]; + $acceptable //= ["POINT","LINE"]; + my (%accept,%replace); + $accept{$_} = 1 for @$acceptable; + $replace{$_} = 1 for @$to_replace; + delete $replace{$_} for @$acceptable; + $to_replace = [keys %replace]; + my %paths; + my $good = $acceptable; + $paths{$_} = [] for @$good; + # find shortest path for any object to replace. + OUTER: while (@$good) { + my @more = (); + for my $g (@$good) { + my $p = $paths{$g}; + for (keys %{$replacers{$g}}) { + my $p2 = $paths{$_}; + if (!defined $p2) { # || @$p2 > @$p) + $paths{$_} = [@$p,[$_,$replacers{$g}{$_}]]; + push @more, $_; + delete $replace{$_}; + last OUTER if !%replace; + } + } + } + $good = \@more; + } + if (%replace) { + die "unable to boil down these objects: ".join(",",sort keys %replace); + } + + %replace = map {$_ => [reverse @{$paths{$_}}]} @$to_replace; + +# FIXED: particularly wrong. + #return deep_copy($dxf,sub{ my $x = shift; my $r = $replace{$x}; return $x unless defined $r; for (@$r) { $x = $r->($x); } return $x; }); + + tree_walk($dxf,sub { + my ($x,$ctx) = @_; + return (0,1) + if $$x[0]{name} eq "SECTION" && + $$x[0]{attrs}{name} !~ /^BLOCKS$|^ENTITIES$|^OBJECTS$/; + my $r = $replace{$$x[0]{name}}; + return 0 unless defined $r; + my %attrs = %{$$x[0]{attrs}}; + for my $entry (@$r) { + my ($n,$sub) = @$entry; + @$x = map $_->{name} eq $n ? $sub->($_) : $_, @$x; + } + my @gen_attrs = grep defined $attrs{$_}, @general_attributes; + for my $entity (@$x) { + for (@gen_attrs) { + $entity->{attrs}{$_} //= $attrs{$_}; + } + } + return 1; + }); +} + +sub parse_property_criteria { + my ($criteria,$name) = @_; + if (ref $criteria eq "") { + $criteria =~ /^([-+])?([^=]*=)?(.*)$/s or die "cannot happen"; + my ($type,$nname,$ent) = ($1//"-",$2//$name,$3); + #$criteria = {_ => $type, $ent => 1}; + $criteria = $type eq "+" ? sub { $_[1]{attrs}{$nname} eq $ent; } + : sub { $_[1]{attrs}{$nname} ne $ent; }; + } elsif (ref $criteria eq "HASH") { + my ($type,$hash) = ($criteria->{_}//"-",$criteria); + $type =~ /^([-+])?(.*)$/s or die "cannot happen"; + $name = $2 if $2 ne ""; + $type = $1//"-"; + $criteria = $type eq "+" ? sub { $$hash{$_[1]{attrs}{$name}}; } + : sub { !$$hash{$_[1]{attrs}{$name}}; }; + } + die "criteria must be scalar, hash or coderef." + if (ref $criteria ne "CODE"); + return $criteria; +} + +# criteria can be an entity type, a hashtable of (entity type => 1) or a sub. +# the type may be prefixed with "+" or "-", the hashtable may +# contain _ => ("+"|"-"), to specify inclusion or exclusion filters. +# default is exclusion. +# the sub gets ($entity->{name},$entity) as parameters. +sub filter { + my ($dxf,$criteria) = @_; + if (ref $criteria eq "") { + $criteria =~ /^([-+])?(.*)$/s or die "cannot happen"; + my ($type,$ent) = ($1//"-",$2); + #$criteria = {_ => $type, $ent => 1}; + $criteria = $type eq "+" ? sub { $_[0] eq $ent; } : sub { $_[0] ne $ent }; + } elsif (ref $criteria eq "HASH") { + my ($type,$hash) = ($criteria->{_}//"-",$criteria); + $criteria = $type eq "+" ? sub { $$hash{$_[0]}; } : sub { !$$hash{$_[0]} }; + } + die "criteria must be scalar, hash or coderef." + if (ref $criteria ne "CODE"); + + my $sections = get_sections($dxf,1); + my $blocks = ($sections->{BLOCKS}//{})->{children}//[]; + + my @base = (@$blocks,grep defined, @$sections{qw(ENTITIES OBJECTS)}); + for (@base) { + tree_walk($_,sub { + my ($x,$ctx) = @_; + my $keep = $criteria->($$x[0]{name},$$x[0]); + return 0 if $keep; + @$x = (); + return 1; + }); + } +} + +sub filter_by_layer { + my ($dxf,$layers) = @_; + filter($dxf,parse_property_criteria($layers,"layer")); +} + +sub filter_by_color { + my ($dxf,$colors) = @_; + filter($dxf,parse_property_criteria($colors,"color")); +} + +sub filter_by { + my ($dxf,$crit) = @_; + filter($dxf,parse_property_criteria($crit,"")); +} + +sub deparse { + my ($dxf,$sub) = @_; + my @stack = ([]); + tree_walk($dxf,sub { + my ($x,$ctx) = @_; + my $prune = $sub->("prune",$$x[0]); + push @stack,[]; + return (0,1) if $prune; + return 0; + }, + sub { + my ($x,$ctx) = @_; + my $content = pop @stack; + my $res = $sub->("collect",$$x[0],$content); + push @{$stack[-1]},$res; + } + ); + die "WTF" if @stack != 1; + my $content = pop @stack; + my $res = $sub->("collect",$dxf,$content); + return $res; +} + + + + + + +# --- interface --- +# much TODO +# DONE: flatten +# TODO: bbox +# DONE: filter by layer +# DONE: filter by color + +package File::DXF; + +sub new { + my ($class,%args) = @_; + if (defined $args{copy}) { + return $args{copy}->copy; + } + my $self = bless {}, ref $class || $class; + if (defined $args{file}) { + $self->parsefile($args{file}); + } elsif (defined $args{data}) { + $self->parse($args{data}); + } elsif (defined $args{tree}) { + $self->load_tree($args{tree}); + } elsif (defined $args{xml}) { + $self->from_xml($args{xml}); + } else { + $self->load_tree(DXF::lol("dxf")); + } + return $self; +} + +sub copy { + my $self = shift; + my %new = %$self; + for (keys %new) { + $new{$_} = DXF::deep_copy($new{$_}); + } + return bless \%new, ref $self; +} + +sub drop_caches { + my ($self) = @_; + delete @$self{qw(sections header tables blocks bboxes)}; +} + +sub get_sections { + my $self = shift; + my $res = $self->{sections}; + if (!defined $res) { + $res = DXF::get_sections($self->{tree},1); + $self->{sections} = $res; + } + return $res; +} + +sub _need_vars_and_types { + my ($self) = @_; + return if defined $self->{header}; + my (%vars,%types,%nodes); + for (@{$self->get_sections->{HEADER}{children}}) { + my $name = $_->{name}; + $name =~ s/^$//; + my @k = keys %{$_->{attrs}}; + + my ($type,$value) = @k == 1 ? ($k[0],$_->{attrs}{$k[0]}) : + @k == 0 ? () : + defined $_->{attrs}{x} ? ("point",[@{$_->{attrs}}{qw(x y z)}]) : + do { warn "variable \"$name\" has multiple values"; (); }; + $vars{$name} = $value; + $types{$name} = $type; + $nodes{$name} = $_; + } + @$self{header} = {vars => \%vars, types => \%types, nodes => \%nodes}; +} + +sub tree { + my $self = shift; + return $self->{tree}; +} + +sub get_vars { + my $self = shift; + $self->_need_vars_and_types; + return $self->{header}{vars}; +} + +sub get_vartypes { + my $self = shift; + $self->_need_vars_and_types; + return $self->{header}{types}; +} + +sub get_blocks { + my $self = shift; + my $res = $self->{blocks}; + if (!defined $res) { + $res = {}; + for (@{$self->get_sections->{BLOCKS}{children}}) { + die "not a block: $$_{name}, but in BLOCKS." + unless $_->{name} eq "BLOCK"; + $$res{$_->{attrs}{name}} = $_; + } + $self->{blocks} = $res; + } + return $res; +} + +sub get_tables { + my $self = shift; + my $res = $self->{tables}; + if (!defined $res) { + $res = {}; + for (@{$self->get_sections->{TABLES}{children}}) { + die "not a table: $$_{name}, but in TABLES." + unless $_->{name} eq "BLOCK"; + $$res{$_->{attrs}{name}} = $_; + } + $self->{tables} = $res; + } + return $res; +} + +sub get_bboxes { + my $self = shift; + die "not implemented yet"; + my $res = $self->{bboxes}; + if (!defined $res) { + my $sections = $self->get_sections; + my $ent = $sections->{ENTITIES}; + my @blocks = $sections->{BLOCKS}{children}; + + for (@blocks) { + } + $self->{bboxes} = $res; + } + return $res; +} + +sub load_tree { # load a complete DXF::lol()-based tree + my ($self,$tree,$no_copy_needed) = @_; + # can be used as a constructor, too. + $self = $self->new if ref $self eq ""; + $tree = DXF::deep_copy($tree) unless $no_copy_needed; + DXF::canonicalize($tree); + my $sections = DXF::get_sections($tree,1); + $self->drop_caches; + $self->{tree} = $tree; + return $self; +} + +sub parse { # scalar data or file handle. + my ($self,$data) = @_; + # can be used as a constructor, too. + $self = $self->new if ref $self eq ""; + my $tree = DXF::parse_dxf($data); + return $self->load_tree($tree,1); +} + +*from_dxf = \&parse; + +sub parsefile { # filename + my ($self,$fname) = @_; + # can be used as a constructor, too. + $self = $self->new if ref $self eq ""; + open(my $f,"<",$fname) or die "cannot open \"$fname\": $!"; + my $tree = DXF::parse_dxf($f); + return $self->load_tree($tree,1); +} + +sub get_var { + my ($self,$name) = @_; + return $self->get_vars->{$name}; +} + +sub get_var_type { + my ($self,$name) = @_; + return $self->get_vartypes->{$name}; +} + +sub set_var { + my ($self,$name,$type,$value) = @_; + die "set_var needs a type" if @_ < 4; + my $types = $self->get_vartypes; + my $vars = $self->get_vars; + my $nodes = $self->{header}{nodes}; + + my %dxfval = $type ne "point" ? ($type => $value) + : map (("x","y","z")[$_] => $$value[$_], 0..$#$value); + # (x => $$value[0], y => $$value[1], z => $$value[2]) + if (exists $$types{$name}) { + if ($$types{$name} ne $type) { + warn "warning: changing header variable type."; + $types->{$name} = $type; + } + $nodes->{$name}{attrs} = \%dxfval; + $vars->{$name} = $value; + } else { + my $s = $self->get_sections; + my $node = DXF::lol("\$$name" => \%dxfval); + push @{$s->{HEADER}{children}}, $node; + $nodes->{$name} = $node; + $types->{$name} = $type; + $vars->{$name} = $value; + } + 1; +} + +sub change_var { + my ($self,$name,$value) = @_; + my $types = $self->get_vartypes; + die "varaiable \"$name\" does not yet exist" unless exists $$types{$name}; + $self->set_var($name,$$types{$name},$value); +} + +sub fulfill_version_requirements { + my ($self,$ver_str) = @_; + die "cannot set version: specs not yet fully implemented"; + my $s = $self->get_sections; + if ($ver_str =~ /^AC(\d+)$/) { + my $num = $1; + my @req_sections = $num <= 1009 ? ("ENTITIES") : + (qw(HEADER CLASSES TABLES ENTITIES OBJECTS)); + if (!defined $s->{ENTITIES}) { + my $node = lol(SECTION => {name => "ENTITIES"}); + $s->{ENTITIES} = $node; + push @{$s->{tree}{children}}, $node; + } + for (@req_sections) { + if (!defined $s->{$_}) { + my $node = lol(SECTION => {name => $_}); + $s->{$_} = $node; + push @{$s->{tree}{children}}, $node; + } + } + if ($num > 1009) { + # >= R13 + die "versions >= R13 are not yet implemented"; + # see https://ezdxf.readthedocs.io/en/master/dxfinternals/filestructure.html for detailed requirements. + } + } else { + die "cannot fulfill version requirements for version \"$ver_str\""; + } +} + +# AC1006 = R10 +# AC1009 = R11 and R12 +# AC1012 = R13 +# AC1014 = R14 +# AC1015 = AutoCAD 2000 +# AC1018 = AutoCAD 2004 +# AC1021 = AutoCAD 2007 +# AC1024 = AutoCAD 2010 +# AC1027 = AutoCAD 2013 +# AC1032 = AutoCAD 2018 + +sub version { + my ($self,$newver) = @_; + if (@_ > 1) { + $self->set_var("ACADVER",text => $newver); + $self->fulfill_version_requirements($newver); + } + return $self->get_var("ACADVER"); +} + +sub add_entities { + my ($self,$entities) = @_; + push @{$self->get_sections->{ENTITIES}{children}}, @$entities; + delete $self->{bboxes}; +} + +sub boil_down { + my ($self,$acceptable,$to_replace) = @_; + DXF::boil_down($self->{tree},$acceptable,$to_replace); + $self->drop_caches; +} + +sub flatten { + my ($self) = @_; + DXF::flatten($self->{tree}); + $self->drop_caches; +} + +sub strip { + my ($self) = @_; + DXF::strip($self->{tree}); + $self->drop_caches; +} + +sub filter { + my ($self,$criteria) = @_; + DXF::filter($self->{tree},$criteria); + $self->drop_caches; +} + +sub filter_by_layer { + my ($self,$criteria) = @_; + DXF::filter_by_layer($self->{tree},$criteria); + $self->drop_caches; +} + +sub filter_by_color { + my ($self,$criteria) = @_; + DXF::filter_by_color($self->{tree},$criteria); + $self->drop_caches; +} + +sub filter_by { + my ($self,$criteria) = @_; + DXF::filter_by($self->{tree},$criteria); + $self->drop_caches; +} + +sub to_dxf { + my ($self) = @_; + return DXF::lol2dxf($self->{tree}); +} + +sub to_xml_doc { + my ($self) = @_; + return DXF::lol2xml($self->{tree}); +} + +sub to_xml { + my ($self) = @_; + return DXF::lol2xml($self->{tree})->toString; +} + +sub from_xml { + my ($self,$doc) = @_; + # can be used as a constructor, too. + $self = $self->new if ref $self eq ""; + my $disp = 0; + if (!ref $doc) { + require XML::DOM; + $doc = XML::DOM::Parser->new->parse($doc); + $disp = 1; + } + my $lol = DXF::xml2lol($doc->getDocumentElement); + $doc->dispose if $disp; + $self->load_tree($lol,1); +} + + +#my $file = shift; +#my $f; +#if (defined $file) { +# open($f, "<", $file) or die "cannot open file"; +#} else { +# $f = \*STDIN; +#} +#my $lol = parse_dxf($f); +#my $dxf2 = lol2dxf($lol); +##print $dxf2; +#use Data::Dumper; +##print Dumper($lol); +#my $xml = lol2xml($lol); +#print $xml->toString; + + + diff --git a/GPL-2.txt b/GPL-2.txt new file mode 100644 index 0000000..d159169 --- /dev/null +++ b/GPL-2.txt @@ -0,0 +1,339 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Lesser General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + <one line to give the program's name and a brief idea of what it does.> + Copyright (C) <year> <name of author> + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along + with this program; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + <signature of Ty Coon>, 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. diff --git a/GPL-3.txt b/GPL-3.txt new file mode 100644 index 0000000..94a9ed0 --- /dev/null +++ b/GPL-3.txt @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/> + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + <one line to give the program's name and a brief idea of what it does.> + Copyright (C) <year> <name of author> + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see <http://www.gnu.org/licenses/>. + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + <program> Copyright (C) <year> <name of author> + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +<http://www.gnu.org/licenses/>. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +<http://www.gnu.org/philosophy/why-not-lgpl.html>. diff --git a/LICENSE.txt b/LICENSE.txt new file mode 100644 index 0000000..3b45007 --- /dev/null +++ b/LICENSE.txt @@ -0,0 +1,11 @@ +This project is licensed under the terms of the GNU GPL ver. 2 or 3. +Copyright (c) 2011-2017 by Thomas Kremer. + +The only exception is the font in consolefont_tiny.pgm and testfont.h, +which seems to be the font + "-misc-fixed-medium-r-normal--8-80-75-75-c-50-iso8859-1" +(actually just a screenshot of it). +Author: Markus Kuhn, License: "Public domain font. Share and enjoy." +Original source: https://www.x.org/releases/individual/font/font-misc-misc-1.0.0.tar.bz2 + + diff --git a/README.txt b/README.txt new file mode 100644 index 0000000..bda0f2d --- /dev/null +++ b/README.txt @@ -0,0 +1,12 @@ +DXF utilities and CAMM-GL III converters + +To convert a DXF file to CAMM-GL (which is apparently basically just HP-GL): + +$ perl -I. ./dxf2camm.pl --sort box,bottom,left camm-test.dxf > camm-test.camm + +To see, what is being plotted, the file can be converted to SVG (colors represent order, going from red to violet): + +$ perl -I. ./camm2svg.pl camm-test.camm > camm-test.svg + +For the XML tools you need the perl module XML::DOM (package "libxml-dom-perl" in Debian) + diff --git a/camm2svg.pl b/camm2svg.pl new file mode 100755 index 0000000..a1c11d5 --- /dev/null +++ b/camm2svg.pl @@ -0,0 +1,23 @@ +#!/usr/bin/perl + +# convert a CAMM-GL III file to SVG to see what is being plotted +# Line colors represent the order of plotting (red to violet) + +## Copyright (c) 2019-2020 by Thomas Kremer +## License: GPL ver. 2 or 3 + +# usage: +# camm2svg.pl infile > outfile +# camm2svg.pl < infile > outfile + +use strict; +use warnings; +use CAMM; + +local $/ = undef; + +my $camm = <>; + +my $svg = CAMM->to_svg($camm,1,1); + +print $svg; diff --git a/dxf2camm.pl b/dxf2camm.pl new file mode 100755 index 0000000..9ded0a4 --- /dev/null +++ b/dxf2camm.pl @@ -0,0 +1,505 @@ +#!/usr/bin/perl + +# Convert a DXF file to CAMM-GL III + +## Copyright (c) 2019-2020 by Thomas Kremer +## License: GPL ver. 2 or 3 + +# TODO: For pdf/ps/eps input: +# gs -dBATCH -dSAFER -dNOPAUSE -sDEVICE=pdfwrite -dCompressPages=false -dNoOutputFonts -dCompressStreams=false -dUNROLLFORMS -sOutputFile=foo.pdf testseite.ps +# (ps2write and eps2write are essentially just a pdf-interpreter plus the pdf) + +# perl -e 'use strict; use warnings; use CAM::PDF; { package CAM::PDF::Renderer::Dump; sub handler { my $name = shift; return eval q!sub { my $self = shift; my ($x,$y) = $self->userToDevice(@{$self->{last}}); print "$name($x,$y): ".join(",",map $_//"undef", @_)."\n"; $self->!."SUPER::$name".q!(@_); }!; } no strict "refs"; *$_ = handler($_) for qw(w d m l s c); } my $pdf = CAM::PDF->new($ARGV[0]); $pdf->getPageContentTree(1)->render("CAM::PDF::Renderer::Dump");' ~/foo.pdf + +use strict; +use warnings; + +#use POSIX qw(lround); +use Math::Trig qw(pi); +use DXF; +use CAMM; +use Getopt::Long qw(:config bundling); + +sub dxf_extract_polylines { + my ($dxf) = @_; + my @res; + for my $e (@{$dxf->get_sections->{ENTITIES}{children}}) { + warn("ignoring entity: $e->{name}"),next unless $e->{name} eq "LWPOLYLINE"; + my ($x,$y) = @{$e->{attrs}}{qw(x y)}; + die "invalid number of coordinates in lwpolyline" + unless ref $x eq "ARRAY" && @$x == @$y && @$x >= 1; + my $closed = $e->{attrs}{int} & 1; + my @points = map [$$x[$_],$$y[$_]], 0..$#$x; + push @res, [($closed?"closed":"open"),\@points]; + } + check_polylines(\@res,"extract"); + return \@res; +} + +sub check_polylines { + my ($l,$context) = @_; + my $pre = defined($context) ? $context.": " : ""; + die $pre."not an array ref" unless ref $l eq "ARRAY"; + for my $line (@$l) { + die $pre."not a pair" unless ref $line eq "ARRAY" && @$line == 2; + die $pre."not open|closed" if $$line[0] !~ /^(?:open|closed)$/; + my $points = $$line[1]; + die $pre."points not an array" unless ref $points eq "ARRAY"; + die $pre."points empty" unless @$points; + for my $point (@$points) { + die $pre."point not a pair" unless ref $point eq "ARRAY" && @$point == 2; + for (0,1) { + die $pre."coordinate $_ undef" unless defined $$point[$_]; + } + } + } +} + +# returns -1 if $x is within $y, 1 if $y is within $x, 0 otherwise or equal +sub rect_containment_cmp { + my ($x,$y) = @_; + my @possible = (1,1,1); # (less-than, strictly, greater-than) + for (0..3) { + my $i = ($$x[$_] <=> $$y[$_])*($_ >= 2 ? 1 : -1); + $possible[$i+1] = 0; + } + #if ($possible[0] != $possible[2]) { + # print STDERR $possible[0]-$possible[2]," : [", join(",",map int($_),@$x),"] <=> [",join(",",map int($_),@$y),"]\n"; + #} + # proves this function correct: + # my $res = $possible[0]-$possible[2]; + # my $c = 0; + # if ($$x[0] >= $$y[0] && $$x[1] >= $$y[1] && + # $$x[2] <= $$y[2] && $$x[3] <= $$y[3]) { + # $c = -1; + # } + # if ($$x[0] <= $$y[0] && $$x[1] <= $$y[1] && + # $$x[2] >= $$y[2] && $$x[3] >= $$y[3]) { + # $c = 1; + # } + # if ($res != $c) { + # print STDERR "$res : [", join(",",map int($_),@$x),"] <$c> [",join(",",map int($_),@$y),"]\n" if $c ne ""; + # } + #print STDERR "."; + return $possible[0]-$possible[2]; +} + +# sort by partial order, O(n^2), inplace +sub partial_sort { + my ($sub,$array) = @_; + my @res; + local $b; + for $b (@$array) { + my $i = 0; + for (;$i<@res;$i++) { + local $a = $res[$i]; + my $cmp = &$sub(); + #my $cmp = $sub->($res[$i],$e); + last if $cmp > 0; + } + splice @res,$i,0,$b; + } + @$array = @res; +} + +sub sort_polylines { + my ($lines,$order) = @_; + check_polylines($lines,"sort"); + + my @bboxes; + + for (@$lines) { + my $bbox = [$$_[1][0],$$_[1][0]]; + my @bbox = (undef)x4; + for my $p (@{$$_[1]}) { + for (0,1) { + $bbox[$_] = $$p[$_] + if !defined $bbox[$_] || $bbox[$_] > $$p[$_]; + $bbox[$_+2] = $$p[$_] + if !defined $bbox[$_+2] || $bbox[$_+2] < $$p[$_]; + } + } + push @bboxes, \@bbox; + } + # bboxes are calculated correctly: + #@$lines = map ["closed",[[@$_[0,1]],[@$_[2,1]],[@$_[2,3]],[@$_[0,3]],[@$_[0,1]]]], @bboxes; + + use sort "stable"; + + my %h = qw(left 0 bottom 1 right 2 top 3); + my @criteria = (); + for (split /,/, $order) { + if (/^(left|bottom|right|top)(?:-(asc|desc))?$/) { + my ($i,$f) = ($h{$1}, ($2//"asc") eq "asc" ? 1 : -1); + #@perm = sort {($bboxes[$a][$i] <=> $bboxes[$b][$i])*$f} @perm; + push @criteria, [$i,$f]; + } elsif (/^box$/) { + #@perm = sort {rect_containment_cmp($bboxes[$a],$bboxes[$b])} @perm; + push @criteria, \&rect_containment_cmp; + } else { + die "unknown sort order: \"$_\""; + } + } + return $lines if !@criteria; + + # # FIXED: non-totalness of box sorting kills transitivity of combined sort. + # @perm = sort { + # my $res = 0; + # for (@criteria) { + # my $res; + # if (ref eq "CODE") { + # $res = $_->($bboxes[$a],$bboxes[$b]); + # } else { + # $res = ($bboxes[$a][$$_[0]] <=> $bboxes[$b][$$_[0]])*$$_[1]; + # } + # return $res if $res != 0; + # } + # return 0; + # } 0..$#$lines; + + my @perm = 0..$#$lines; + for my $crit (reverse @criteria) { + if (ref $crit eq "CODE") { + partial_sort(sub {$crit->($bboxes[$a],$bboxes[$b])},\@perm); + #@perm = sort {$crit->($bboxes[$a],$bboxes[$b])} @perm; + } else { + @perm = sort {($bboxes[$a][$$crit[0]] <=> $bboxes[$b][$$crit[0]])*$$crit[1]} @perm; + } + } + return [@$lines[@perm]]; +} + +sub coarsify_polylines { + my ($lines,$mindist) = @_; + check_polylines($lines,"coarsify"); + my $min = $mindist**2; + my @res = @$lines; + for (@res) { + my $points = $$_[1]; + undef $_, next if @$points < 2; + $_ = [@$_]; + $points = [@$points]; + $$_[1] = $points; + my $closed = $$_[0] eq "closed"; + my $p = $$points[0]; + #die "wtf: $p, @$p" if ref $p ne "ARRAY" || @$p != 2 || !defined $$p[0] || !defined $$p[1]; + for my $q (@$points[1..$#$points-1]) { + my $d2 = 0; + #die "wtf2: $q, @$q" if ref $q ne "ARRAY" || @$q != 2 || !defined $$q[0] || !defined $$q[1]; + $d2 += ($$p[$_]-$$q[$_])**2 for 0..1; + undef $q, next if $d2 < $min; + $p = $q; + } + @$points = grep defined, @$points; + } + @res = grep defined, @res; + return \@res; +} + +# input is an array of ["closed"|"open",[p_1,...,p_n]], where p_i are [x,y]-points. +sub combine_polylines { + my ($lines,$try_join_cycles,$try_reverse_paths) = @_; + check_polylines($lines,"combine"); + my $first = undef; + my (%starts,%ends); # end|start => [[points,start,end],...] + my (@cycles,@noncycles); # [[points,start,end],...] + #for my $e (@{get_sections($dxf)->{ENTITIES}{children}}) { + for (@$lines) { + # @cycles contains all encountered cycles + # %starts contains all encountered non-cycles by start point + # %ends contains all encountered non-cycles by end point + + # when adding a new segment, we check if it can continue a previous + # segment, if it can be continued by a previous segment or both or none. + my ($type,$_points) = @$_; + my @points = @$_points; + my $closed = $type eq "closed"; + + my ($start,$end) = map join(";",@$_), @points[0,-1]; + if ($closed && $start ne $end) { + push @points, $points[0]; + $end = $start; + } + my $elem = [\@points,$start,$end]; + if ($start eq $end) { + push @cycles, $elem; + next; + } + my ($needstart,$needend) = (1,1); + if ($ends{$start} && @{$ends{$start}}) { + my $e2 = pop @{$ends{$start}}; + push @{$$e2[0]},@{$$elem[0]}; + $$e2[2] = $end; + $start = $$e2[1]; + $elem = $e2; + $needstart = 0; + if ($start eq $end) { + @{$starts{$start}} = grep $_ != $elem, @{$starts{$start}}; + push @cycles, $elem; + next; + } + } + if ($starts{$end} && @{$starts{$end}}) { + my $e2 = pop @{$starts{$end}}; + if ($needstart) { + unshift @{$$e2[0]},@{$$elem[0]}; + $$e2[1] = $start; + $end = $$e2[2]; + $elem = $e2; + $needend = 0; + } else { + # we need to remove $e2 because $elem is already linked in %start + push @{$$elem[0]},@{$$e2[0]}; + my $end2 = $end; + $end = $$e2[2]; + @{$starts{$end2}} = grep $_ != $e2, @{$starts{$end2}}; + @{$ends{$end}} = grep $_ != $e2, @{$ends{$end}}; + } + if ($start eq $end) { + @{$starts{$start}} = grep $_ != $elem, @{$starts{$start}} + if !$needstart; + @{$ends{$end}} = grep $_ != $elem, @{$ends{$end}} + if !$needend; + push @cycles, $elem; + next; + } + } + push @{$starts{$start}}, $elem if $needstart; + push @{$ends{$end}}, $elem if $needend; + } + for (keys %starts) { + delete $starts{$_} if !@{$starts{$_}}; + } + for (keys %ends) { + delete $ends{$_} if !@{$ends{$_}}; + } + + if ($try_reverse_paths) { + # join paths with same start or end by reversing one. + my %corners; # end|start => [[[points,start,end],is_end],...] + for (keys %starts) { + my $arr = $starts{$_}; + next unless @$arr; + $corners{$_} = [ map [$_,0], @$arr ]; + } + for (keys %ends) { + my $arr = $ends{$_}; + next unless @$arr; + push @{$corners{$_}}, map [$_,1], @$arr; + } + + for (values %corners) { + while (@$_ >= 2) { + my ($ee1,$ee2) = sort {$$b[1] <=> $$a[1]} splice @$_, 0,2; + # get start and end + my $p1 = $$ee1[0][0]; + my $p2 = $$ee2[0][0]; + my $ix1 = $$ee1[1]; + my $ix2 = $$ee2[1]; + my $start = $$ee1[0][2-$ix1]; + my $end = $$ee2[0][2-$ix2]; + my $s1 = $corners{$start}; + my $s2 = $corners{$end}; + # check for loop + my $is_loop = $start eq $end; + if (!$ix1) { + # reverse actual points + @$p1 = reverse @$p1; + # change startpoint entry to start if first is reversed + $$ee1[0][1] = $start; + for (@$s1) { + $$_[1] = 0 if $$_[0] == $$ee1[0]; + } + } + if ($is_loop) { + # note: $s1 != $_, $s2 != $_, since we don't have cycles in the hash. + @$s1 = grep $$_[0] != $$ee1[0], @$s1; + @$s2 = grep $$_[0] != $$ee2[0], @$s2; + push @cycles, $$ee1[0]; + } else { + # change endpoint entry from second to first + for (@$s2) { + @$_ = ($$ee1[0],1) if $$_[0] == $$ee2[0]; + } + } + if ($ix2) { + # reverse added points + $p2 = [reverse @$p2]; + } + # add points to first, dropping second. + $$ee1[0][2] = $end; + push @$p1,@$p2; + } + } + #%starts = (); + #%ends = (); + for (keys %corners) { + my $arr = $corners{$_}; + next unless @$arr; + push @noncycles, map $$_[0], grep $$_[1] == 0, @$arr; + #$starts{$_} = [map $$_[0], grep $$_[1] == 0, @$arr]; + #$ends{$_} = [map $$_[0], grep $$_[1] == 1, @$arr]; + } + } else { + for (values %starts) { + push @noncycles, @$_; + } + } + + if ($try_join_cycles) { + # embed cycles into other paths + my %cyclepoints; # pointstr => [i_th_cycle,k_th_pointincycle] + # every point gets marked with an unembedded cycle containing it. + # duplicate points are used to embed cycles immediately into other cycles. + for my $i (0..$#cycles) { + next unless defined; + my $c = $cycles[$i][0]; + for (my $k = 0; $k < $#$c; $k++) { + my $p = $$c[$k]; + my $ps = join(";",@$p); + if (defined $cyclepoints{$ps} && $cyclepoints{$ps}[0] != $i) { + my ($i2,$k2) = @{$cyclepoints{$ps}}; + my @points = @{$cycles[$i2][0]}; + @points = @points[$k2..$#points-1,0..$k2]; + splice @$c, $k, 1, @points; + undef $cycles[$i2]; + } + $cyclepoints{$ps} = [$i,$k]; + } + } + # non-cycles are scanned for containing cycles. + for (@noncycles) { + my $c = $$_[0]; + for (my $j = 0; $j < @$c; $j++) { + my $p = $$c[$j]; + my $ps = join(";",@$p); + if (defined $cyclepoints{$ps}) { + my ($i,$k) = @{$cyclepoints{$ps}}; + next unless defined $cycles[$i]; + my @points = @{$cycles[$i][0]}; + @points = @points[$k..$#points-1,0..$k]; + splice @$c, $j, 1, @points; + $j += @points-1; + undef $cycles[$i]; + } + } + } + @cycles = grep defined, @cycles; + } + + my @paths = (map(["closed",$$_[0]], @cycles), + map(["open",$$_[0]], @noncycles)); + + return \@paths; +} + +# option parsing. + +my (@opts,%opts,%opts_explained); + +sub usage { + my $ret = shift//0; + if ($ret != 0) { + print STDERR "wrong parameter. Left are: ",join(" ",@ARGV),"\n"; + } + #print join("\n --",$0,@opts),"\n"; + print STDERR "usage:\n $0\n"; + for (@opts) { + my $name = $_ =~ s/[|!=:].*//r; + my $value = $opts{$name}//"undefined"; + if (ref $value eq "SCALAR") { + $value = $$value; + } elsif (ref $value eq "CODE") { + $value = undef; + } + my $explanation = $opts_explained{$name}; + print STDERR " --",$_,(defined $value ? " (value: $value)":""),"\n", + defined($explanation) ? " $explanation\n":""; + + } + print STDERR " <dxffile>\n"; + print STDERR " read DXF data from this file instead of stdin.\n"; + exit($ret); +} + +%opts = ( + coarsify => 1/4, + combine => 1, + combine_cycles => 1, + combine_reverse => 1, + scale => 1, + help => sub { usage(0); }, +); + +%opts_explained = ( + output => "Write CAMM data to this file instead of stdout.", + offset => "Set knive offset to this value (mm).", + raw => "Don't emit header/footer commands.", + relative => "Use relative commands when possible (better compression).", + epsilon => "jump over line segments of at most this length.", + shortline => "maximum length of a short line (mm); smoothen corners only for those lines.", + smallangle => "maximum angle (degrees) considered small; smoothen corners only for those angles.", + coarsify => "segments smaller than this length (mm) are combined to straight lines.", + combine => "draw polylines that touch each other in one go.", + combine_cycles => "Allow embedding cycles into other polylines to combine them.", + combine_reverse => "Allow reversing of polylines to combine more of them.", + translate => "Translate everything to this point (\"x,y\")", + scale => "Scale everything by this factor", + sort => "Sort order: /(left|bottom|right|top)(|-asc|-desc)|box/, comma-separated", + help => "Show this help screen.", +); + +@opts = qw(output|o=s offset|off=f raw! relative! epsilon=f shortline=f smallangle=f coarsify=f combine! combine_cycles|cycles! combine_reverse|reverse! translate=s scale=f sort=s help|h|?); + +GetOptions(\%opts,@opts) or usage(2); + +usage(2) if @ARGV > 1; + +$opts{headerfooter} = !$opts{raw}; +$opts{offset} *= CAMM::units_per_mm if defined $opts{offset}; +$opts{shortline} *= CAMM::units_per_mm if defined $opts{shortline}; +$opts{translate} = [split /,/,$opts{translate}] if defined $opts{translate}; + + +my $dxffile = shift; +## TODO: get paths from dxf in a good way. + +my $dxf = File::DXF->new(defined($dxffile)?(file=>$dxffile):(data=>\*STDIN)); +$dxf->boil_down(["POINT","LWPOLYLINE"]); +$dxf->filter({_ => "+", INSERT => 1, LWPOLYLINE => 1}); +$dxf->flatten; + +my $paths = dxf_extract_polylines($dxf); + +for (@$paths) { # a path + for my $p (@{$$_[1]}) { # a point + if (defined $opts{translate}) { + $$p[$_] += $opts{translate}[$_] for 0,1; + } + for (@$p) { # a coordinate + $_ = $opts{scale}*$_*CAMM::units_per_mm; + #$_ = lround($opts{scale}*$_*CAMM::units_per_mm); + } + } +} + +$paths = combine_polylines($paths,$opts{combine_cycles},$opts{combine_reverse}) + if $opts{combine}; +$paths = coarsify_polylines($paths,$opts{coarsify}*CAMM::units_per_mm) + if $opts{coarsify}; +#$CAMM::units_per_mm/4); +$paths = sort_polylines($paths,$opts{sort}) + if defined $opts{sort}; + +my $camm = CAMM->from_polylines($paths,%opts); +#headerfooter=>1,offset=>10*$CAMM::units_per_mm); + +my $out; +if (defined $opts{output}) { + open($out,">",$opts{output}) or die "cannot open $opts{output}: $!"; +} else { + $out = \*STDOUT; +} + +print $out $camm; + diff --git a/dxf2xml.pl b/dxf2xml.pl new file mode 100755 index 0000000..4ed31af --- /dev/null +++ b/dxf2xml.pl @@ -0,0 +1,29 @@ +#!/usr/bin/perl + +# converts a DXF file to XML for viewing and editing. + +## Copyright (c) 2018-2020 by Thomas Kremer +## License: GPL ver. 2 or 3 + +# usage: +# dxf2xml.pl infile.dxf > outfile.xml +# dxf2xml.pl < infile.dxf > outfile.xml + +use strict; +use warnings; + +use DXF; +use XML::DOM; +use IO::Handle; + +my $file = shift; +my $f; +if (defined $file) { + open($f, "<", $file) or die "cannot open file"; +} else { + $f = \*STDIN; +} +my $lol = DXF::parse_dxf($f); +my $xml = DXF::lol2xml($lol); +print $xml->toString; + diff --git a/dxf_simplify.pl b/dxf_simplify.pl new file mode 100755 index 0000000..4502517 --- /dev/null +++ b/dxf_simplify.pl @@ -0,0 +1,43 @@ +#!/usr/bin/perl + +# simplifies a DXF by converting everything using a given set of DXF primitives. + +## Copyright (c) 2018-2020 by Thomas Kremer +## License: GPL ver. 2 or 3 + +# usage: +# dxf_simplify.pl infile.dxf POINT,LINE > outfile.dxf +# dxf_simplify.pl infile.dxf > outfile.dxf +# dxf_simplify.pl < infile.dxf > outfile.dxf + +use strict; +use warnings; + +use DXF; + +my ($dxffile,$set) = @ARGV; +my $f; + +if (defined $dxffile) { + open($f,"<",$dxffile) or die "cannot open dxf \"$dxffile\": $!"; +} else { + $f = \*STDIN; +} + +$set //= "POINT,LWPOLYLINE"; +$set = [split /,/, $set]; + +my $dxf = DXF::parse_dxf($f); + +DXF::canonicalize($dxf); +#DXF::boil_down($dxf,["POINT","LWPOLYLINE","CIRCLE"]); +#DXF::filter($dxf,{_=>"+", INSERT => 1, LWPOLYLINE => 1, POINT => 1, CIRCLE => 1}); +#DXF::flatten_dxf($dxf); +#my $copy = DXF::deep_copy($dxf); +DXF::boil_down($dxf,$set); +DXF::flatten($dxf); +DXF::strip($dxf); + +print DXF::lol2dxf($dxf); +#print DXF::lol2xml($dxf)->toString; + diff --git a/xml2dxf.pl b/xml2dxf.pl new file mode 100755 index 0000000..19e9f4c --- /dev/null +++ b/xml2dxf.pl @@ -0,0 +1,57 @@ +#!/usr/bin/perl + +# converts a DXF in XML format back to DXF. + +## Copyright (c) 2018-2020 by Thomas Kremer +## License: GPL ver. 2 or 3 + +# usage: +# xml2dxf.pl infile.xml > outfile.dxf +# xml2dxf.pl < infile.xml > outfile.dxf + +use strict; +use warnings; + +use DXF; +use XML::DOM; +use IO::Handle; + +sub xml2lol { + my $node = shift; + my $name = $node->getTagName; + $name =~ s/^_/\$/; + my @xmlattrs = $node->getAttributes->getValues; + my %attrs; + for (@xmlattrs) { + my $aname = $_->getName; + my $aval = $_->getValue; + if ($aname =~ s/-array$//) { + $aval = [split / /,$aval]; + } + $attrs{$aname} = $aval; + } + my @children; + for ($node->getChildNodes) { + if ($_->getNodeType == XML::DOM::ELEMENT_NODE) { + push @children, xml2lol($_); + } + } + return DXF::lol($name => \%attrs,\@children); +} + +my $file = shift; +my $f; +if (defined $file) { + open($f, "<", $file) or die "cannot open file"; +} else { + $f = \*STDIN; +} + +$/ = undef; +my $content = <$f>; + +my $xmldoc = XML::DOM::Parser->new->parse($content); +my $lol = xml2lol($xmldoc->getDocumentElement); +$xmldoc->dispose; +DXF::lol2dxf($lol,sub {print @_;}); + |