commitid.scad.pl

   1 #!/usr/bin/perl -w
   2
   3 # commitid.scad.pl - a program for annotating solid models with commit info
   4 # Copyright (C)2016 Ian Jackson.  See below.  There is NO WARRANTY.
   5
   6
   7 # USAGE
   8 # =====
   9 #
  10 #   .../commitid.scad.pl [OPTION...] [STRING...] >commitid.scad.new \
  11 #     && mv -f commitid.scad.new commitid.scad
  12 #
  13 # Run without arguments, commitid.scad.pl will output an openscad file
  14 # which contains 2D and 3D models of the current git commit count and
  15 # commit object id (commit hash), useful for identifying printed
  16 # parts.
  17 #
  18 # See below for details.  You probably want these two sections, as a
  19 # quick starting point:
  20 #    General form of provided openscad modules
  21 #    Autoscaling modules
  22 #
  23 # We can also generate models of short mainly-numeric strings
  24 # specified on the command line.
  25 #
  26 #
  27 # Options:
  28 #
  29 #   --git    Generate git commit indications, as shown below
  30 #            (this is the default if no strings are requested with -t).
  31 #            Ie, produce the `Autoscaling modules' and `Specific layouts'.
  32 #
  33 #   --git=objid
  34 #            Generate git commit indication based on commit object only
  35 #            (ie avoid counting commits).  Ie, do not generate `Small'
  36 #            and `Full' layouts (and never select them for `Best').
  37 #
  38 #   -i       Do not generate `+' dirty indication if git-untracked files
  39 #            are present (ie, missing .gitignore entries).  The `*'
  40 #            dirty tree indication (for modified files) cannot be disabled.
  41 #
  42 #   [-t[LAYOUT]] TEXT
  43 #            Generate a layout LAYOUT containing TEXT.  TEXT can
  44 #            contain newlines (a final newline usually undesirable, as
  45 #            it will generate a blank line).  If LAYOUT is not specified,
  46 #            generates Arg0, Arg1, Arg2, etc., for successive such
  47 #            TEXTs.  The permissible character set in is TEXT is:
  48 #                 space 0-9 a-f + *
  49 #
  50 #
  51 # OPENSCAD INTERFACE
  52 # ==================
  53 #
  54 # Dynamic variables for configuration
  55 # -----------------------------------
  56 #
  57 # We honour the following variables to control various scaling factors:
  58 #
  59 #                             default value  notes
  60 #    $Commitid_pixelsz         0.8             \ multiplied together
  61 #    $Commitid_scale           1.0             /
  62 #    $Commitid_depth           pixelsz/2       \ multiplied together
  63 #    $Commitid_depth_scale     1.0             /
  64 #    $Commitid_max_best_scale  2.0             limits XY scaling in *Best*
  65 #
  66 # FYI the font is nominally 3x5 pixels, with 1-pixel inter-line and
  67 # inter-character gaps.  (It's not strictly speaking a 3x5 bitmap
  68 # font, size it contains partial pixels and diagonals.)
  69 #
  70 #
  71 # Non-`module'-specific functions
  72 # -------------------------------
  73 #
  74 # We provide the following functions (which depend on the config
  75 # variables, but not on anything else) and compute useful values:
  76 #
  77 #   function Commitid_pixelsz()   Actual size of each nominal pixel
  78 #   function Commitid_depth()     Depth to use (the amount characters
  79 #                                  should be raised or sunken)
  80 #
  81 # General form of provided openscad modules
  82 # -----------------------------------------
  83 #
  84 #   module Commitid_MODULE_2D(...)   Collection of polygons forming characters
  85 #   module Commitid_MODULE(...)      The above, extruded up and down in Z
  86 #   module Commitid_MODULE_M_2D(...) Mirror writing
  87 #   module Commitid_MODULE_M(...)    3D mirror writing
  88 #   function Commitid_MODULE_sz()    A 2-vector giving the X,Y size
  89 #
  90 # Except for *Best* modules, the XY origin is in the bottom left
  91 # corner without any margin.  Likewise Commitid_MODULE_sz does not
  92 # include any margin.
  93 #
  94 # For 3D versions, the model is 2*depth deep and the XY plane bisects
  95 # the model.  This means it's convenient to either add or subtract from
  96 # a workpiece whose face is in the XY plane.
  97 #
  98 # The _M versions are provided to avoid doing inconvenient translation
  99 # and rotation to get the flipped version in the right place.
 100 #
 101 #
 102 # Autoscaling modules
 103 # -------------------
 104 #
 105 # These modules take a specification of the available XY space, and
 106 # select and generate a suitable specific identification layout:
 107 #
 108 #   module Commitid_BestCount_2D  (max_sz, margin=Commitid_pixelsz())
 109 #   module Commitid_BestCount     (max_sz, margin=Commitid_pixelsz())
 110 #   module Commitid_BestCount_M_2D(max_sz, margin=Commitid_pixelsz())
 111 #   module Commitid_BestCount_M   (max_sz, margin=Commitid_pixelsz())
 112 #   module Commitid_BestObjid_2D  (max_sz, margin=Commitid_pixelsz())
 113 #   module Commitid_BestObjid     (max_sz, margin=Commitid_pixelsz())
 114 #   module Commitid_BestObjid_M_2D(max_sz, margin=Commitid_pixelsz())
 115 #   module Commitid_BestObjid_M   (max_sz, margin=Commitid_pixelsz())
 116 #
 117 # max_sz should be [x,y].
 118 #
 119 # BestCount includes (as much as it can of) the git commit count,
 120 # ie the result of
 121 #     git rev-list --first-parent --count HEAD
 122 # (and it may include some of the git revision ID too).
 123 #
 124 # BestObjid includes as much as it can of the git commit object hash,
 125 # and never includes any of the count.
 126 #
 127 # All of these will autoscale and autorotate the selected model, and
 128 # will include an internal margin of the specified size (by default,
 129 # one pixel around each edge).  If no margin is needed, pass margin=0.
 130 #
 131 # There are no `function Commitid_Best*_sz'.  If they existed they
 132 # would simply return max_sz.
 133 #
 134 #
 135 # Output format
 136 # -------------
 137 #
 138 # In general the output, although it may be over multiple lines,
 139 # is always in this order
 140 #     git commit object id (hash)
 141 #     dirty indicator
 142 #     git commit count
 143 #
 144 # Not all layouts have all these parts.  The commit object id may
 145 # sometimes be split over multiple lines, but the count will not be.
 146 # If both commit id and commit count appear they will be separated
 147 # by (at least) a newline, or a dirty indicator, or a space.
 148 #
 149 # The commit id is truncated to fit, from the right.
 150 #
 151 # The commit count is truncated from the _left_, leaving the least
 152 # significant decimal digits.
 153 #
 154 # The dirty indicator can be
 155 #
 156 #   *   meaning the working tree contains differences from HEAD
 157 #
 158 #   +   meaning the working tree contains untracked files
 159 #       (ie files you have failed to `git add' and also failed
 160 #       to add to gitignore).  (But see the -i option.)
 161 #
 162 #
 163 # Specific layouts
 164 # ----------------
 165 #
 166 # If you want to control the exact layout (and make space for it in
 167 # your design), you can use these:
 168 #
 169 #    module Commitid_LAYOUT_2D()
 170 #    module Commitid_LAYOUT()
 171 #    module Commitid_LAYOUT_M_2D()
 172 #    module Commitid_LAYOUT_M()
 173 #    function Commitid_LAYOUT_sz()
 174 #
 175 # Here LAYOUT is one of the following (giving for example, `module
 176 # Commitid_Full8_2D').  In the examples, we will assume that the tree
 177 # is dirty, the commit count is 123456, and the commit object id
 178 # starts abcdeffedbcaabcdef...  In the examples `_' shows where a
 179 # space would be printed.
 180 #
 181 #   Small2 Small3 ... Small9 Small10 Small12 Small14 Small16
 182 #       A single line containing as much of the count will fit, eg:
 183 #            Small5    3456*
 184 #            Small8    _*123456
 185 #       The objectid is included if more than one character of of it
 186 #       will fit without makign the output ambiguous:
 187 #            Small9    ab*123456
 188 #
 189 #   Small2S Small4S ... Small16S
 190 #   Small3T Small9T Small12T
 191 #       Same as Small but split into two lines (S)
 192 #       or three lines (T).  Eg:
 193 #            Small4S    *4       Small6T   _*
 194 #                       56                 34
 195 #                                          56
 196 #   Git2 Git3 ... Git9 Git10 Git12 Git14 Git16
 197 #   Git4S Git6S ... Git16S
 198 #   Git6T Git9T Git12T
 199 #       Just the commit object hash, in one, two (S) or three (T)
 200 #       lines.  E.g.:
 201 #            Git5    abcd*
 202 #
 203 #   Full4 Full6 ... Full20:
 204 #       The commit object hash plus the commit count, on
 205 #       separate lines, eg:
 206 #            Full12   abcdef     Full16    abcdeffe
 207 #                     *23456               _*123456
 208 #
 209 #   Full6T Full9T ... Full30T
 210 #       As Full but the commit object id is split over two lines
 211 #       producing a 3-line layout, eg:
 212 #            Full9T    abc       Full21T   abcdeff
 213 #                      de*                 edbcaa*
 214 #                      456                 _123456
 215 #
 216 # Other LAYOUTs
 217 # -------------
 218 #
 219 #   FontDemo
 220 #
 221 #       A demonstration of the built-in 18-character font
 222 #
 223 #   Arg0 Arg1, ...
 224 #
 225 #       Strings passed on command line (without -t, or bare -t,
 226 #       rather than with -tLAYOUT).
 227 #
 228 #   LAYOUT
 229 #
 230 #       Generated by passing -tLAYOUT on the command line.
 231 #
 232
 233
 234 # COPYRIGHT, LICENCE AND LACK-OF-WARRANTY INFORMATION
 235 # ===================================================
 236 #
 237 # This program is Free Software and a Free Cultural Work.
 238 #
 239 #   You can redistribute it and/or modify it under the terms of the
 240 #   GNU General Public License as published by the Free Software
 241 #   Foundation, either version 3 of the License, or (at your option)
 242 #   any later version.
 243 #
 244 #   This program is distributed in the hope that it will be useful,
 245 #   but WITHOUT ANY WARRANTY; without even the implied warranty of
 246 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 247 #   GNU General Public License for more details.
 248 #
 249 #   You should have received a copy of the GNU General Public License
 250 #   along with this program.  If not, see <http://www.gnu.org/licenses/>.
 251 #
 252 # Alternatively, at your option:
 253 #
 254 #   This work is licensed under the Creative Commons
 255 #   Attribution-ShareAlike 4.0 International License.
 256 #
 257 #   There is NO WARRANTY.
 258
 259
 260 use strict;
 261
 262 $SIG{__WARN__} = sub { die @_; };
 263
 264 our $debug=0;
 265
 266 if (@ARGV && $ARGV[0] =~ m/^-(D+)$/) {
 267     $debug = length $1;
 268     shift @ARGV;
 269 }
 270
 271 sub p { print @_ or die $!; }
 272
 273 sub p_debug { print STDERR @_ if $debug; }
 274
 275 p <<'END';
 276 // *** AUTOGENERATED - DO NOT EDIT *** //
 277 function Commitid_pixelsz() =
 278   ($Commitid_pixelsz       ? $Commitid_pixelsz       : 0.8) *
 279   ($Commitid_scale         ? $Commitid_scale         : 1.0);
 280 function Commitid_depth() =
 281   ($Commitid_depth         ? $Commitid_depth         : Commitid_pixelsz()/2) *
 282   ($Commitid_depth_scale   ? $Commitid_depth_scale   : 1.0);
 283 function Commitid__scale() =
 284   Commitid_pixelsz() / 0.2;
 285 END
 286
 287 sub chrmodname ($) {
 288     my ($chr) = @_;
 289     my $chrx = sprintf '%#x', ord $chr;
 290     return "Commitid__chr_$chrx";
 291 }
 292
 293 our $gtm_demo_i = -1;
 294 our $gtm_demo_j;
 295 our @gtm_demo_o;
 296
 297 sub gentextmodule_demo_start_batch () {
 298     $gtm_demo_j = 0;
 299     $gtm_demo_i++;
 300 }
 301
 302 sub argl_formal (@) { join ', ', @_; }
 303 sub argl_actual (@) { join ',', map { m/=/ ? $` : $_ } @_; }
 304
 305 sub gen3dmodule ($@) {
 306     my ($modb,$size,@argl) = (@_);
 307     $size ||= "${modb}_sz()";
 308     p "module ${modb}_M_2D(".argl_formal(@argl)."){\n";
 309     p "  translate([${size}[0],0])\n";
 310     p "    mirror([1,0,0])\n";
 311     p "    ${modb}_2D(".argl_actual(@argl).");\n";
 312     p "};\n";
 313     foreach my $mir ('','_M') {
 314         my $mm = "${modb}${mir}";
 315         p "module ${mm}(".argl_formal(@argl)."){\n";
 316         p " d=Commitid_depth();\n";
 317         p " translate([0,0,-d]) linear_extrude(height=d*2)\n";
 318         p "  ${mm}_2D(".argl_actual(@argl).");\n";
 319         p "}\n";
 320     }
 321 }
 322
 323 sub gentextmodule ($@) {
 324     my ($form, @lines) = @_;
 325     my $modb = "Commitid_$form";
 326     p "module ${modb}_2D(){\n";
 327     p " // |$_|\n" foreach @lines;
 328     p " scale(Commitid__scale()){\n";
 329     my $y = @lines;
 330     my $cols = 1;
 331     foreach my $line (@lines) {
 332         $y--;
 333         my $x = 0;
 334         foreach my $chr (split //, $line) {
 335             p sprintf "  translate([%d * 0.8, %d * 1.2]) %s();\n",
 336                 $x, $y, chrmodname $chr
 337                 if $chr =~ m/\S/;
 338             $x++;
 339         }
 340         $cols = $x if $x > $cols;
 341     }
 342     p " }\n";
 343     p "}\n";
 344     gen3dmodule($modb,'');
 345
 346     p sprintf "function %s_sz() = Commitid__scale() * 0.1 * [ %d, %d ];\n",
 347         $modb, 2 * ($cols * 4 - 1), 2 * (@lines * 6 - 1);
 348
 349     push @gtm_demo_o, <<END;
 350  translate([$gtm_demo_i * st[0], $gtm_demo_j * st[1]]) {
 351   difference(){
 352    color("blue") translate([-e,-e]) square(${modb}_sz() + 2*[e,e]);
 353    square(${modb}_sz());
 354   }
 355   ${modb}_2D();
 356 }
 357 END
 358     $gtm_demo_j++;
 359 }
 360
 361 our @demo;
 362
 363
 364 our $prcount;
 365
 366 sub debug_simplify_begin ($) {
 367     my ($chr) = @_;
 368
 369     return unless $debug;
 370
 371     open S, ">commitid-DEBUG-simplify-$chr.ps";
 372     print S "%!\n";
 373     print S "(Courier-Bold) findfont 15 scalefont setfont\n";
 374
 375     $prcount=0;
 376 }
 377
 378 sub debug_simplify_done () {
 379     return unless $debug;
 380     print S "showpage\n";
 381     close S or die $!;
 382 }
 383
 384 sub debug_simplify_pr ($$$) {
 385     my ($chr,$polys,$why) = @_;
 386
 387     return unless $debug;
 388
 389     print STDERR "PR $chr $why\n";
 390     my $ct_x = 10000 * ($prcount % 6);
 391     my $ct_y = 18000 * int($prcount / 6);
 392     printf S "0 setgray\n";
 393     printf S "%d %d moveto\n", map {$_/100 + 10} $ct_x,$ct_y;
 394     printf S "(%s) show\n", $why;
 395     my $pr_recur;
 396
 397     $pr_recur = sub {
 398         my ($tpolys, @levels) = @_;
 399         return unless @$tpolys;
 400         foreach my $i (0..$#$tpolys) {
 401             printf STDERR "P@levels %02d :", $i;
 402             my $pinfo =  $tpolys->[$i];
 403             my $p = $pinfo->{E};
 404             printf STDERR "@$p\n";
 405             my $lw = 5 - 4*($i / ($#$tpolys || 1));
 406             my $pp = sub {
 407                 my $spec = $p->[$_[0]];
 408                 $spec =~ m/^\d{5}/;
 409                 sprintf "%d %d",map { $_/100 }
 410                     1000 + $ct_x + $&,
 411                     5000 + $ct_y + $';
 412             };
 413             printf S "%s setrgbcolor\n", (@levels==0 ? '0 0 0' :
 414                                           @levels==1 ? '0 0 1'
 415                                           : '1 1 0');
 416             foreach my $eai (0..$#$p) {
 417                 my $ebi = ($eai + 1) % @$p;
 418                 printf S <<END, $lw, $pp->($eai), $pp->($ebi);
 419  %f setlinewidth
 420  %s moveto
 421  %s lineto
 422  stroke
 423 END
 424             }
 425             $pr_recur->($pinfo->{Holes}, @levels, $i);
 426         }
 427     };
 428     $pr_recur->($polys,0);
 429
 430     $prcount++;
 431 }
 432
 433 sub simplify ($$) {
 434     my ($chr,$polys) = @_;
 435     use Data::Dumper;
 436
 437     return unless @$polys;
 438
 439     my $count=0;
 440     my $pr = sub { };
 441
 442     if ($debug) {
 443         debug_simplify_begin($chr);
 444     }
 445
 446     $pr->("start");
 447
 448   AGAIN: while(1) {
 449         my %edges;
 450         my $found_hole;
 451
 452         foreach my $pi (0..$#$polys) {
 453             my $p = $polys->[$pi]{E};
 454             foreach my $ei (0..$#$p) {
 455                 my $e = $p->[$ei].$p->[($ei+1) % @$p];
 456                 die if $edges{$e};
 457                 $edges{$e} = [ $p, $pi, $ei ];
 458             }
 459         }
 460         p_debug "AGAIN $count\n";
 461         my $merge = sub {
 462             my ($pa, $pai, $eai, $pb, $pbi, $ebi) = @_;
 463             p_debug "# merging $pai:$eai.. $pbi:$ebi..\n";
 464             splice @$pa, $eai, 1,
 465                 ((@$pb)[$ebi+1..$#$pb], (@$pb)[0..$ebi-1]);
 466             @$pb = ( );
 467         };
 468         foreach my $pai (0..$#$polys) {
 469             my $painfo = $polys->[$pai];
 470             my $pa = $painfo->{E};
 471             foreach my $eai (0..$#$pa) {
 472                 my $ear = $pa->[ ($eai+1) % @$pa ].$pa->[$eai];
 473                 my $ebi = $edges{$ear};
 474                 next unless $ebi;
 475                 my ($pb,$pbi);
 476                 ($pb, $pbi, $ebi) = @$ebi;
 477                 # $pai:($eai+1)..$eai and $pbi:$ebi..($ebi+1) are identical
 478                 # so we want to remove them.
 479                 if ($pai==$pbi) {
 480                     # we're making a hole!  we make an assumption:
 481                     # holes have fewer line segments than the
 482                     # outlines.  This is almost always true because of
 483                     # the way we construct our figures.
 484                     if (($ebi - $eai + @$pa) % @$pa > @$pa/2) {
 485                         # We arrange that $eai..$ebi is the hole
 486                         ($ebi,$eai) = ($eai,$ebi);
 487                     }
 488                     p_debug "HOLE $eai $ebi\n";
 489                     # we want to make the smallest hole, to avoid
 490                     # making a hole that itself needs simplifying
 491                     my $holesz = ($ebi - $eai + @$pa) % @$pa;
 492                     $found_hole = [ $pa,$pai,$eai, $ebi, $holesz ]
 493                         unless $found_hole && $found_hole->[4] < $holesz;
 494                 } else {
 495                     $merge->($pa,$pai,$eai,$pb,$pbi,$ebi);
 496                     debug_simplify_pr($chr,$polys,"after $count");
 497                     next AGAIN;
 498                 }
 499             }
 500             # we process hole joining last, so that the whole of the
 501             # edge of the hole must be part of the same polygon
 502             if ($found_hole) {
 503                 p_debug "HOLE DOING @$found_hole\n";
 504                 my ($pa,$pai,$eai,$ebi) = @$found_hole;
 505                 # simplify the indexing
 506                 @$pa = ((@$pa)[$eai..$#$pa], (@$pa)[0..$eai-1]);
 507                 $ebi -= $eai; $ebi += @$pa; $ebi %= @$pa;
 508                 $eai = 0;
 509                 push @{ $painfo->{Holes} }, {
 510                     E => [ (@$pa)[$eai+1..$ebi-1] ],
 511                     Holes => [ ],
 512                 };
 513                 splice @$pa, $eai, $ebi-$eai+1;
 514                 debug_simplify_pr($chr,$polys,"hole $count");
 515                 next AGAIN;
 516             }
 517         }
 518         last;
 519     }
 520
 521     debug_simplify_done();
 522 }
 523
 524 sub p_edgelist ($$$) {
 525     my ($points,$vecs,$p) = @_;
 526     my @vec;
 527     foreach my $pt (@$p) {
 528         $pt =~ s{\d{5}}{$&,};
 529         $pt =~ s{\b\d}{$&.}g;
 530         push @$points, "[$pt]";
 531         push @vec, $#$points;
 532     }
 533     push @$vecs, \@vec;
 534 }
 535
 536 sub parsefont () {
 537     my %cellmap;
 538     for (;;) {
 539         $_ = <DATA> // die;
 540         last if %cellmap && !m/\S/;
 541         next unless m/\S/;
 542         chomp;
 543         s{^(.) }{};
 544         $cellmap{$1} = $_;
 545     }
 546     my %chrpolys;
 547     # $chrs{$chr}[$poly] = $poly
 548     # $poly->{E} = [ "012345012345", ... ]
 549     # $poly->{Holes} = $poly2
 550     while (<DATA>) {
 551         next unless m/\S/;
 552         chomp;
 553         my @chrs = split / /, $_;
 554         <DATA> !~ m/\S/ or die;
 555         foreach my $row (reverse 0..4) {
 556             $_ = <DATA>;
 557             chomp;
 558             s{^}{ };
 559             $_ .= ' ' x 8;
 560             m{\S/\S} and die;
 561             s{/(?=\s)}{L}g;
 562             s{/(?=\S)}{r}g;
 563             s{\\(?=\s)}{l}g;
 564             s{\\(?=\S)}{R}g;
 565             p "// $_\n";
 566             foreach my $chr (@chrs) {
 567                 s{^ }{} or die "$chr $_ ?";
 568                 foreach my $col (0..2) {
 569                     my @verts;
 570                     if (s{^ }{}) {
 571                     } elsif (s{^\S}{}) {
 572                         my $f = $cellmap{$&};
 573                         die unless $f;
 574                         $f =~ s/\b\d/ sprintf '%05d', $col*2000 + $&*1000 /ge;
 575                         $f =~ s/\d\b/ sprintf '%05d', $row*2000 + $&*1000 /ge;
 576                         push @{ $chrpolys{$chr} }, { E => [ split / /, $f ] };
 577                     } else {
 578                         die "$_ ?";
 579                     }
 580                 }
 581             }
 582             die "$_ ?" if m{\S};
 583         }
 584     }
 585
 586     my $demo = '';
 587     my $democols = 6;
 588     foreach my $chr (sort keys %chrpolys) {
 589
 590         my $polys = $chrpolys{$chr};
 591         $_->{Holes} = [] foreach @$polys;
 592
 593         simplify($chr,$polys);
 594
 595         my $mod = chrmodname $chr;
 596         p "module $mod () {\n";
 597         foreach my $poly (@$polys) {
 598             p " polygon(";
 599             my $holes = $poly->{Holes};
 600             my (@points, @vecs);
 601             p_edgelist(\@points, \@vecs, $poly->{E});
 602             foreach my $hole (@$holes) {
 603                 p_edgelist(\@points, \@vecs, $hole->{E});
 604             }
 605             p "points=[".(join ",",@points)."],";
 606             if (@$holes) {
 607                 p ",paths=[".(join ",",
 608                              map { "[".(join ",",@$_)."]" }
 609                              @vecs)."],";
 610             }
 611             p "convexity=4);\n";
 612         }
 613         p "}\n";
 614         $demo .= $chr;
 615     }
 616     @demo = reverse $demo =~ m{.{1,$democols}}go;
 617 }
 618
 619 parsefont();
 620
 621 our $do_git; # contains may chars 'c' (count) and/or 'o' (object)
 622 our $do_git_untracked = 1;
 623 our $argcounter;
 624
 625 our @forms;
 626 our %included; # 0 = not at all; 1 = truncated; 2 = full
 627
 628 sub rjustt ($$$;$) {
 629     # right justify and truncate (ie, pad and truncate at left)
 630     # always includes prefix
 631     # sets $included{$what}
 632     my ($sz, $what, $whole, $prefix) = @_;
 633     $prefix //= '';
 634     my $lw = length $whole;
 635     my $spare = $sz - $lw - (length $prefix);
 636     $included{$what}= 1 + ($spare > 0);
 637     return
 638         ($spare > 0 ? (' ' x $spare) : '').
 639         $prefix.
 640         substr($whole, ($spare < 0 ? -$spare : 0));
 641 }
 642
 643 sub ljustt ($$$;$) {
 644     my ($sz, $what, $whole, $suffix) = @_;
 645     $suffix //= '';
 646     $sz -= length $suffix;
 647     $included{$what} = 1 + ($sz >= length $whole);
 648     return sprintf "%-${sz}.${sz}s%s", $whole, $suffix;
 649 }
 650
 651 sub genform_prep() {
 652     $included{$_}=0 foreach qw(Objid Count);
 653 }
 654
 655 sub genform ($@) {
 656     my ($form, @lines) = @_;
 657     gentextmodule($form, @lines);
 658     my $f = {
 659         Form => $form,
 660         Chars => (length join '', @lines),
 661         Lines => (scalar @lines),
 662         Ambiguous => ($form =~ m/Full/ && !grep { m/\W/ } @lines),
 663         Included => { %included },
 664     };
 665     push @forms, $f;
 666 }
 667
 668 sub genform_q ($$$) {
 669     my ($form, $s, $lines) = @_;
 670     $gtm_demo_j++;
 671     my $l = length $s;
 672     return if $l % $lines;
 673     my $e = $l/$lines;
 674     return if $e < 2;
 675     $gtm_demo_j--;
 676     genform($form, $s =~ m/.{$e}/g);
 677 }
 678
 679 sub genform_plusq ($$) {
 680     my ($form, $s) = @_;
 681     genform($form, $s);
 682     genform_q("${form}S", $s, 2);
 683     genform_q("${form}T", $s, 3);
 684 }
 685
 686 our @gcmd;
 687
 688 sub gitrun_start () {
 689     open F, "-|", @gcmd or die "$gcmd[0]: start: $!";
 690 }
 691
 692 sub gitrun_done (;$) {
 693     my ($errok) = @_;
 694     $?=0; $!=0;
 695     return if close F;
 696     return if $errok;
 697     die $! if $!;
 698     die "@gcmd failed ($?)\n";
 699 }
 700
 701 sub gitoutput (@) {
 702     (@gcmd) = (qw(git), @_);
 703     gitrun_start;
 704     $_ = <F>;
 705     gitrun_done;
 706     defined or die "@gcmd produced no output";
 707     chomp or die "@gcmd produced no final newline";
 708     $_;
 709 }
 710
 711 sub do_git () {
 712     return unless $do_git;
 713
 714     @gcmd = qw(git status --porcelain);
 715     push @gcmd, qw(--untracked=no) unless $do_git_untracked;
 716
 717     my $git_dirty = '';
 718     gitrun_start;
 719     while (<F>) {
 720         if (m/^\?\?/ && $do_git_untracked) {
 721             $git_dirty = '+';
 722             next;
 723         }
 724         $git_dirty = '*';
 725         last;
 726     }
 727     gitrun_done($git_dirty eq '*');
 728
 729     my $git_count;
 730     my $git_object;
 731
 732     if ($do_git =~ m/c/) {
 733         $git_count = gitoutput qw(rev-list --first-parent --count HEAD);
 734     }
 735     if ($do_git =~ m/o/) {
 736         $git_object = gitoutput qw(rev-parse HEAD);
 737     }
 738     print STDERR join ' ', map { $_ // '?' }
 739         "-- commitid", $git_object, $git_dirty, $git_count, "--\n";
 740
 741     foreach my $sz (2..10, qw(12 14 16)) {
 742         gentextmodule_demo_start_batch();
 743
 744         if (defined($git_count)) {
 745             genform_prep();
 746             my $smallstr = rjustt($sz, 'Count', $git_count, $git_dirty);
 747             my $forgitobj = $sz - length($git_count) - 1;
 748             if (defined($git_object) && $forgitobj >= 2) {
 749                 $smallstr = ljustt($forgitobj, 'Objid', $git_object).
 750                     ($git_dirty || ' ').
 751                     $git_count;
 752             }
 753             genform_plusq("Small$sz", $smallstr);
 754         }
 755
 756         genform_prep();
 757         genform_plusq("Git$sz", ljustt($sz, 'Objid', $git_object, $git_dirty))
 758             if defined $git_object;
 759
 760         if (defined $git_count && defined $git_object && $sz<=10) {
 761             genform_prep();
 762             genform("Full".($sz*2),
 763                     ljustt($sz, 'Objid', $git_object),
 764                     rjustt($sz, 'Count', $git_count, $git_dirty));
 765
 766             genform_prep();
 767             my $e = $sz;
 768             genform("Full".($e*3)."T",
 769                     ljustt($e*2, 'Objid', $git_object, $git_dirty)
 770                     =~ m/.{$e}/g,
 771                     rjustt($e, 'Count', $git_count));
 772         }
 773     }
 774 }
 775
 776 sub do_some_best ($$) {
 777     my ($bestwhat, $formre) = @_;
 778     my $modname = "Best$bestwhat";
 779     my $fullmodname = "Commitid_${modname}_2D";
 780     my @argl = qw(max_sz margin=Commitid_pixelsz());
 781     p "module $fullmodname(".argl_formal(@argl).") {\n";
 782     my $mbs = '$Commitid_max_best_scale';
 783     p " sc_max = $mbs ? $mbs : 2;\n";
 784     p " sz = max_sz - 2*[margin,margin];\n";
 785     my @do;
 786     foreach my $f (
 787         sort {
 788             $b->{Included}{$bestwhat} <=> $a->{Included}{$bestwhat} or
 789             $b->{Chars} <=> $a->{Chars} or
 790             $a->{Lines} <=> $b->{Chars}
 791         }
 792         grep {
 793             $_->{Form} =~ m/$formre/ &&
 794             !$_->{Ambiguous}
 795         }
 796         @forms
 797     ) {
 798         my $form = $f->{Form};
 799         p " sz_$form = Commitid_${form}_sz();\n";
 800         foreach my $rot (qw(0 1)) {
 801             my $id = "${form}_r${rot}";
 802             p " sc_$id = min(sc_max";
 803             foreach my $xy (qw(0 1)) {
 804                 p ",sz[$xy]/sz_$form","[",(($xy xor $rot)+0),"]";
 805             }
 806             p ");\n";
 807             push @do, " if (sc_$id >= 1.0";
 808             push @do, " && sc_$id >= sc_${form}_r1" if !$rot;
 809             push @do, ") {\n";
 810             push @do, "  translate([margin,margin]) scale(sc_$id)\n";
 811             push @do, "   rotate(90) translate([0,-sz_$form"."[1]])\n" if $rot;
 812             push @do, "   Commitid_${form}_2D();\n";
 813             push @do, " } else";
 814         }
 815     }
 816     push @do, <<END;
 817  {
 818   echo("$fullmodname could not fit anything in", max_sz);
 819  }
 820 END
 821     p $_ foreach @do;
 822     p "}\n";
 823
 824     gen3dmodule "Commitid_$modname", 'max_sz', @argl;
 825 }
 826
 827 sub do_git_best () {
 828     return unless $do_git;
 829
 830     # Auto-computer for `best fit'
 831     #
 832     # We have two best fit approaches: with count, and git-object-id-only
 833     #
 834     # For `with count', we only ever include the git object id if the
 835     # result would be unambigous.  That means that at least one space
 836     # or punctuation was generated.
 837     #
 838     # We sort the options by firstly number of characters
 839     # (decreasing), and then by number of lines (increasing) and
 840     # try each one both ways round.
 841
 842     do_some_best('Count', 'Small|Full') if $do_git =~ m/c/;
 843     do_some_best('Objid', 'Git|Full') if $do_git =~ m/o/;
 844 }
 845
 846 while (@ARGV) {
 847     $_ = shift;
 848     if (m/^--(no)?-git$/) {
 849         $do_git = $1 ? '' : 'co';
 850     } elsif (m/^---git=objid$/i) {
 851         $do_git = 'o';
 852     } elsif (m/^-i$/) {
 853         $do_git_untracked = 0;
 854     } elsif (m/^-t(.*)$/) {
 855         my $form = $1;
 856         die "bad usage: -t needs string argument\n";
 857         $_ = shift;
 858         gentextmodule($form, split /\n/, $_);
 859         $argcounter //= 0;
 860     } elsif (m/^[^-]/) {
 861         gentextmodule("Arg$argcounter", $_);
 862         $argcounter++;
 863     } else {
 864         die "bad usage: unknown option \`$_'\n";
 865     }
 866 }
 867
 868 $do_git //= defined($argcounter) ? '' : 'co';
 869
 870 gentextmodule_demo_start_batch();
 871 gentextmodule('FontDemo', @demo);
 872
 873 do_git();
 874 do_git_best();
 875
 876 p "module Commitid_2DDemo(){\n";
 877 p " st = Commitid__scale() * [ 10, 5 ];\n";
 878 p " e  = Commitid_pixelsz();\n";
 879 p $_ foreach @gtm_demo_o;
 880 p "}\n";
 881
 882 flush STDOUT or die $!;
 883 close STDOUT or die $!;
 884
 885 __DATA__
 886
 887 # 00 20 22 02
 888 l 00 20 02
 889 r 00 20 22
 890 L 00 22 02
 891 R 20 22 02
 892 > 00 20 22 02 11
 893 < 00 20 11 22 02
 894
 895 0 1 2 3 4 5 6 7 8 9
 896
 897 /#\  r  /#\ ##\ # # ### /#/ ### /#\ /#\
 898 # # /#    #   # # # #   #     # # # # #
 899 # #  #  /#/ ##< \## ##\ ##\  // >#< \##
 900 # #  #  #     #   #   # # #  #  # #   #
 901 \#/ /#\ ### ##/   # ##/ \#/  #  \#/ ##/
 902
 903 a b c d e f
 904
 905     #         #     /##
 906     #   /##   # /#\ #
 907 /## ##\ #   /## #r# ###
 908 # # # # #   # # #/  #
 909 \## ##/ \## \## \#/ #
 910
 911 + *
 912
 913     # #
 914  #  \#/
 915 ### ###
 916  #  /#\
 917     # #