X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=reprap-play.git;a=blobdiff_plain;f=commitid.scad.pl;h=62ae5105e07259a2a0a2ec25ad2f69f8aec8b0a0;hp=e75143b46ca91b49697670d54a1ddbd2620d1cd8;hb=0dd084916e997047d879b074c71b5d40a311f747;hpb=d82cb026a973ad5c790c9464d1ae6ac5587b03e1 diff --git a/commitid.scad.pl b/commitid.scad.pl index e75143b..62ae510 100755 --- a/commitid.scad.pl +++ b/commitid.scad.pl @@ -360,6 +360,179 @@ END our @demo; + +our $prcount; + +sub debug_simplify_begin ($) { + my ($chr) = @_; + + return unless $debug; + + open S, ">commitid-DEBUG-simplify-$chr.ps"; + print S "%!\n"; + print S "(Courier-Bold) findfont 15 scalefont setfont\n"; + + $prcount=0; +} + +sub debug_simplify_done () { + return unless $debug; + print S "showpage\n"; + close S or die $!; +} + +sub debug_simplify_pr ($$$) { + my ($chr,$polys,$why) = @_; + + return unless $debug; + + print STDERR "PR $chr $why\n"; + my $ct_x = 10000 * ($prcount % 6); + my $ct_y = 18000 * int($prcount / 6); + printf S "0 setgray\n"; + printf S "%d %d moveto\n", map {$_/100 + 10} $ct_x,$ct_y; + printf S "(%s) show\n", $why; + my $pr_recur; + + $pr_recur = sub { + my ($tpolys, @levels) = @_; + return unless @$tpolys; + foreach my $i (0..$#$tpolys) { + printf STDERR "P@levels %02d :", $i; + my $pinfo = $tpolys->[$i]; + my $p = $pinfo->{E}; + printf STDERR "@$p\n"; + my $lw = 5 - 4*($i / ($#$tpolys || 1)); + my $pp = sub { + my $spec = $p->[$_[0]]; + $spec =~ m/^\d{5}/; + sprintf "%d %d",map { $_/100 } + 1000 + $ct_x + $&, + 5000 + $ct_y + $'; + }; + printf S "%s setrgbcolor\n", (@levels==0 ? '0 0 0' : + @levels==1 ? '0 0 1' + : '1 1 0'); + foreach my $eai (0..$#$p) { + my $ebi = ($eai + 1) % @$p; + printf S <($eai), $pp->($ebi); + %f setlinewidth + %s moveto + %s lineto + stroke +END + } + $pr_recur->($pinfo->{Holes}, @levels, $i); + } + }; + $pr_recur->($polys,0); + + $prcount++; +} + +sub simplify ($$) { + my ($chr,$polys) = @_; + use Data::Dumper; + + return unless @$polys; + + my $count=0; + my $pr = sub { }; + + if ($debug) { + debug_simplify_begin($chr); + } + + $pr->("start"); + + AGAIN: while(1) { + my %edges; + my $found_hole; + + foreach my $pi (0..$#$polys) { + my $p = $polys->[$pi]{E}; + foreach my $ei (0..$#$p) { + my $e = $p->[$ei].$p->[($ei+1) % @$p]; + die if $edges{$e}; + $edges{$e} = [ $p, $pi, $ei ]; + } + } + p_debug "AGAIN $count\n"; + my $merge = sub { + my ($pa, $pai, $eai, $pb, $pbi, $ebi) = @_; + p_debug "# merging $pai:$eai.. $pbi:$ebi..\n"; + splice @$pa, $eai, 1, + ((@$pb)[$ebi+1..$#$pb], (@$pb)[0..$ebi-1]); + @$pb = ( ); + }; + foreach my $pai (0..$#$polys) { + my $painfo = $polys->[$pai]; + my $pa = $painfo->{E}; + foreach my $eai (0..$#$pa) { + my $ear = $pa->[ ($eai+1) % @$pa ].$pa->[$eai]; + my $ebi = $edges{$ear}; + next unless $ebi; + my ($pb,$pbi); + ($pb, $pbi, $ebi) = @$ebi; + # $pai:($eai+1)..$eai and $pbi:$ebi..($ebi+1) are identical + # so we want to remove them. + if ($pai==$pbi) { + # we're making a hole! we make an assumption: + # holes have fewer line segments than the + # outlines. This is almost always true because of + # the way we construct our figures. + if (($ebi - $eai + @$pa) % @$pa > @$pa/2) { + # We arrange that $eai..$ebi is the hole + ($ebi,$eai) = ($eai,$ebi); + } + p_debug "HOLE $eai $ebi\n"; + # we want to make the smallest hole, to avoid + # making a hole that itself needs simplifying + my $holesz = ($ebi - $eai + @$pa) % @$pa; + $found_hole = [ $pa,$pai,$eai, $ebi, $holesz ] + unless $found_hole && $found_hole->[4] < $holesz; + } else { + $merge->($pa,$pai,$eai,$pb,$pbi,$ebi); + debug_simplify_pr($chr,$polys,"after $count"); + next AGAIN; + } + } + # we process hole joining last, so that the whole of the + # edge of the hole must be part of the same polygon + if ($found_hole) { + p_debug "HOLE DOING @$found_hole\n"; + my ($pa,$pai,$eai,$ebi) = @$found_hole; + # simplify the indexing + @$pa = ((@$pa)[$eai..$#$pa], (@$pa)[0..$eai-1]); + $ebi -= $eai; $ebi += @$pa; $ebi %= @$pa; + $eai = 0; + push @{ $painfo->{Holes} }, { + E => [ (@$pa)[$eai+1..$ebi-1] ], + Holes => [ ], + }; + splice @$pa, $eai, $ebi-$eai+1; + debug_simplify_pr($chr,$polys,"hole $count"); + next AGAIN; + } + } + last; + } + + debug_simplify_done(); +} + +sub p_edgelist ($$$) { + my ($points,$vecs,$p) = @_; + my @vec; + foreach my $pt (@$p) { + $pt =~ s{\d{5}}{$&,}; + $pt =~ s{\b\d}{$&.}g; + push @$points, "[$pt]"; + push @vec, $#$points; + } + push @$vecs, \@vec; +} + sub parsefont () { my %cellmap; for (;;) { @@ -373,6 +546,7 @@ sub parsefont () { my %chrpolys; # $chrs{$chr}[$poly] = $poly # $poly->{E} = [ "012345012345", ... ] + # $poly->{Holes} = $poly2 while () { next unless m/\S/; chomp; @@ -397,8 +571,8 @@ sub parsefont () { } elsif (s{^\S}{}) { my $f = $cellmap{$&}; die unless $f; - $f =~ s/\b\d/ sprintf '%05d', $col*2000 + $&*1025 /ge; - $f =~ s/\d\b/ sprintf '%05d', $row*2000 + $&*1025 /ge; + $f =~ s/\b\d/ sprintf '%05d', $col*2000 + $&*1000 /ge; + $f =~ s/\d\b/ sprintf '%05d', $row*2000 + $&*1000 /ge; push @{ $chrpolys{$chr} }, { E => [ split / /, $f ] }; } else { die "$_ ?"; @@ -412,20 +586,29 @@ sub parsefont () { my $demo = ''; my $democols = 6; foreach my $chr (sort keys %chrpolys) { + my $polys = $chrpolys{$chr}; + $_->{Holes} = [] foreach @$polys; + + simplify($chr,$polys); + my $mod = chrmodname $chr; p "module $mod () {\n"; foreach my $poly (@$polys) { - p " polygon(["; - my $delim = ""; - foreach my $pt (@{ $poly->{E} }) { - p $delim; - $pt =~ s{\d{5}}{$&,}; - $pt =~ s{\b\d}{$&.}g; - p "[$pt]"; - $delim = ','; + p " polygon("; + my $holes = $poly->{Holes}; + my (@points, @vecs); + p_edgelist(\@points, \@vecs, $poly->{E}); + foreach my $hole (@$holes) { + p_edgelist(\@points, \@vecs, $hole->{E}); + } + p "points=[".(join ",",@points)."],"; + if (@$holes) { + p ",paths=[".(join ",", + map { "[".(join ",",@$_)."]" } + @vecs)."],"; } - p "]);\n"; + p "convexity=4);\n"; } p "}\n"; $demo .= $chr;