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=0af0115b410e3c6c4405e64199ea5ae947c3f185;hb=7770827b802f785346281246c80a71663ea58938;hpb=5edd2b56ce9a3acd7d2a4348325c500f82c31a41 diff --git a/commitid.scad.pl b/commitid.scad.pl index 0af0115..62ae510 100755 --- a/commitid.scad.pl +++ b/commitid.scad.pl @@ -178,7 +178,7 @@ # starts abcdeffedbcaabcdef... In the examples `_' shows where a # space would be printed. # -# Small2 Small3 ... Small10 +# Small2 Small3 ... Small9 Small10 Small12 Small14 Small16 # A single line containing as much of the count will fit, eg: # Small5 3456* # Small8 _*123456 @@ -186,16 +186,16 @@ # will fit without makign the output ambiguous: # Small9 ab*123456 # -# Small2S Small4S ... Small10S -# Small3T Small9T +# Small2S Small4S ... Small16S +# Small3T Small9T Small12T # Same as Small but split into two lines (S) # or three lines (T). Eg: # Small4S *4 Small6T _* # 56 34 # 56 -# Git2 Git3 ... Git10 -# Git4S Git6S ... Git10S -# Git6T Git9T +# Git2 Git3 ... Git9 Git10 Git12 Git14 Git16 +# Git4S Git6S ... Git16S +# Git6T Git9T Git12T # Just the commit object hash, in one, two (S) or three (T) # lines. E.g.: # Git5 abcd* @@ -203,7 +203,7 @@ # Full4 Full6 ... Full20: # The commit object hash plus the commit count, on # separate lines, eg: -# Full6 abcdef Full8 abcdeffe +# Full12 abcdef Full16 abcdeffe # *23456 _*123456 # # Full6T Full9T ... Full30T @@ -261,8 +261,17 @@ use strict; $SIG{__WARN__} = sub { die @_; }; +our $debug=0; + +if (@ARGV && $ARGV[0] =~ m/^-(D+)$/) { + $debug = length $1; + shift @ARGV; +} + sub p { print @_ or die $!; } +sub p_debug { print STDERR @_ if $debug; } + p <<'END'; // *** AUTOGENERATED - DO NOT EDIT *** // function Commitid_pixelsz() = @@ -351,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 (;;) { @@ -362,6 +544,9 @@ sub parsefont () { $cellmap{$1} = $_; } my %chrpolys; + # $chrs{$chr}[$poly] = $poly + # $poly->{E} = [ "012345012345", ... ] + # $poly->{Holes} = $poly2 while () { next unless m/\S/; chomp; @@ -386,9 +571,9 @@ 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; - push @{ $chrpolys{$chr} }, [ split / /, $f ]; + $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 "$_ ?"; } @@ -401,19 +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 (@{ $chrpolys{$chr} }) { - p " polygon(["; - my $delim = ""; - foreach my $pt (@$poly) { - p $delim; - $pt =~ s{\d{5}}{$&,}; - $pt =~ s{\b\d}{$&.}g; - p "[$pt]"; - $delim = ','; + foreach my $poly (@$polys) { + 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 "]);\n"; + p "points=[".(join ",",@points)."],"; + if (@$holes) { + p ",paths=[".(join ",", + map { "[".(join ",",@$_)."]" } + @vecs)."],"; + } + p "convexity=4);\n"; } p "}\n"; $demo .= $chr; @@ -428,26 +623,35 @@ our $do_git_untracked = 1; our $argcounter; our @forms; +our %included; # 0 = not at all; 1 = truncated; 2 = full -sub rjustt ($$;$) { # right justify and truncate (ie, pad and truncate at left) - # always includes prefix - my ($sz, $whole, $prefix) = @_; +sub rjustt ($$$;$) { + # right justify and truncate (ie, pad and truncate at left) + # always includes prefix + # sets $included{$what} + my ($sz, $what, $whole, $prefix) = @_; $prefix //= ''; my $lw = length $whole; my $spare = $sz - $lw - (length $prefix); + $included{$what}= 1 + ($spare > 0); return ($spare > 0 ? (' ' x $spare) : ''). $prefix. substr($whole, ($spare < 0 ? -$spare : 0)); } -sub ljustt ($$;$) { - my ($sz, $whole, $suffix) = @_; +sub ljustt ($$$;$) { + my ($sz, $what, $whole, $suffix) = @_; $suffix //= ''; $sz -= length $suffix; + $included{$what} = 1 + ($sz >= length $whole); return sprintf "%-${sz}.${sz}s%s", $whole, $suffix; } +sub genform_prep() { + $included{$_}=0 foreach qw(Objid Count); +} + sub genform ($@) { my ($form, @lines) = @_; gentextmodule($form, @lines); @@ -456,6 +660,7 @@ sub genform ($@) { Chars => (length join '', @lines), Lines => (scalar @lines), Ambiguous => ($form =~ m/Full/ && !grep { m/\W/ } @lines), + Included => { %included }, }; push @forms, $f; } @@ -533,39 +738,44 @@ sub do_git () { print STDERR join ' ', map { $_ // '?' } "-- commitid", $git_object, $git_dirty, $git_count, "--\n"; - foreach my $sz (2..10) { + foreach my $sz (2..10, qw(12 14 16)) { gentextmodule_demo_start_batch(); if (defined($git_count)) { - my $smallstr = rjustt($sz, $git_count, $git_dirty); + genform_prep(); + my $smallstr = rjustt($sz, 'Count', $git_count, $git_dirty); my $forgitobj = $sz - length($git_count) - 1; if (defined($git_object) && $forgitobj >= 2) { - $smallstr = ljustt($forgitobj, $git_object). + $smallstr = ljustt($forgitobj, 'Objid', $git_object). ($git_dirty || ' '). $git_count; } genform_plusq("Small$sz", $smallstr); } - genform_plusq("Git$sz", ljustt($sz, $git_object, $git_dirty)) + genform_prep(); + genform_plusq("Git$sz", ljustt($sz, 'Objid', $git_object, $git_dirty)) if defined $git_object; - if (defined $git_count && defined $git_object) { + if (defined $git_count && defined $git_object && $sz<=10) { + genform_prep(); genform("Full".($sz*2), - ljustt($sz, $git_object), - rjustt($sz, $git_count, $git_dirty)); + ljustt($sz, 'Objid', $git_object), + rjustt($sz, 'Count', $git_count, $git_dirty)); + genform_prep(); my $e = $sz; genform("Full".($e*3)."T", - ljustt($e*2, $git_object, $git_dirty) + ljustt($e*2, 'Objid', $git_object, $git_dirty) =~ m/.{$e}/g, - rjustt($e, $git_count)); + rjustt($e, 'Count', $git_count)); } } } sub do_some_best ($$) { - my ($modname, $formre) = @_; + my ($bestwhat, $formre) = @_; + my $modname = "Best$bestwhat"; my $fullmodname = "Commitid_${modname}_2D"; my @argl = qw(max_sz margin=Commitid_pixelsz()); p "module $fullmodname(".argl_formal(@argl).") {\n"; @@ -575,6 +785,7 @@ sub do_some_best ($$) { my @do; foreach my $f ( sort { + $b->{Included}{$bestwhat} <=> $a->{Included}{$bestwhat} or $b->{Chars} <=> $a->{Chars} or $a->{Lines} <=> $b->{Chars} } @@ -628,8 +839,8 @@ sub do_git_best () { # (decreasing), and then by number of lines (increasing) and # try each one both ways round. - do_some_best('BestCount', 'Small|Full') if $do_git =~ m/c/; - do_some_best('BestObjid', 'Git|Full') if $do_git =~ m/o/; + do_some_best('Count', 'Small|Full') if $do_git =~ m/c/; + do_some_best('Objid', 'Git|Full') if $do_git =~ m/o/; } while (@ARGV) {