commitid.scad.pl

   1 #!/usr/bin/perl -w
   2 use strict;
   3
   4 $SIG{__WARN__} = sub { die @_; };
   5
   6 # We generate a physical indication of which commit was used.
   7 #
   8 # We can generate three forms:
   9 #
  10 #   Tiny3:
  11 #   Tiny4:
  12 #   Tiny5:
  13 #   Tiny6:
  14 #   Tiny7:
  15 #   Tiny8:
  16 #       git rev-list --first-parent --count HEAD
  17 #       typically 3-4 characters but we allow for up to 6
  18 #       eg
  19 #            Tiny4    1070
  20 #
  21 #   Tiny4Q:
  22 #   Tiny6Q:
  23 #   Tiny9Q:
  24 #       same but in two lines eg
  25 #            Tiny4Q   10
  26 #                     70
  27 #
  28 #   Small4
  29 #   Small6
  30 #   Small8
  31 #       git-rev-list --first-parent --count HEAD
  32 #       git-rev-parse HEAD
  33 #       eg
  34 #            Small6     1070
  35 #                     82f2a2
  36
  37 sub parsefont () {
  38     my %cellmap;
  39     while (<DATA>) {
  40         last if %cellmap && !m/\S/;
  41         next unless m/\S/;
  42         chomp;
  43         s{^(.) }{};
  44         $cellmap{$1} = $_;
  45     }
  46     my %chrpolys;
  47     while (<DATA>) {
  48         next unless m/\S/;
  49         my @chrs = split / /, $_;
  50         <DATA> !~ m/\S/ or die;
  51         foreach my $row (0..4) {
  52             $_ = <DATA>;
  53             chomp;
  54             s{^}{ };
  55             $_ .= ' ' x (@chrs * 4);
  56             m{\S/\S} and die;
  57             s{/(?=\s)}{L}g;
  58             s{/(?=\S)}{r}g;
  59             s{\\(?=\s)}{l}g;
  60             s{\\(?=\S)}{R}g;
  61             foreach my $chr (@chrs) {
  62                 s{^ }{} or die "$chr $_ ?";
  63                 foreach my $col (0..2) {
  64                     my @verts;
  65                     if (s{^ }{}) {
  66                     } elsif (s{^\S}{}) {
  67                         my $f = $cellmap{$&};
  68                         die unless $f;
  69                         $f =~ s/\b\d/ sprintf '%x', $col*2 + $& /ge;
  70                         $f =~ s/\d\b/ sprintf '%x', $row*2 + $& /ge;
  71                         push @{ $chrpolys{$chr} }, [ split / /, $f ];
  72                     } else {
  73                         die "$_ ?";
  74                     }
  75                 }
  76             }
  77             die "$_ ?" if m{\S};
  78         }
  79     }
  80     foreach my $polys (values %chrpolys) {
  81         my %edges;
  82         foreach my $p (@$polys) {
  83             foreach my $ei (0..$#$p) {
  84                 my $e = $p->[$ei].$p->[($ei+1) % @$p];
  85                 die if $edges{$e};
  86                 $edges{$e} = [ $p, $ei ];
  87             }
  88         }
  89       AGAIN: {
  90             foreach my $pa (@$polys) {
  91                 foreach my $eai (0..$#$pa) {
  92                     my $ear = $pa->[ ($eai+1) % @$pa ].$pa->[$eai];
  93                     my $ebi = $edges{$ear};
  94                     next unless $ebi;
  95                     my $pb;
  96                     ($pb, $ebi) = @$ebi;
  97 #                   print "# merging $eai $ebi\n";
  98                     splice @$pb, $ebi, 1;
  99                     splice @$pa, $eai, 1, @$pb;
 100                     @$pb = ( );
 101                     next AGAIN;
 102                 }
 103             }
 104         }
 105 #       @$polys = grep { @$_ } @$polys;
 106     }
 107
 108     use Data::Dumper;
 109     print Dumper(\%chrpolys);
 110 }
 111
 112 parsefont();
 113
 114 __DATA__
 115
 116 # 00 20 22 02
 117 l 00 20 22
 118 r 00 20 02
 119 L 00 22 02
 120 R 20 22 02
 121 > 00 20 22 02 11
 122 < 00 20 11 22 02
 123
 124 0 1 2 3 4 5 6 7 8 9
 125
 126 /#\  #  ##\ ##\ # # ### /## ### /#\ /#\
 127 # #  #    #   # # # #   #     # # # # #
 128 # #  #  /#/ ### ### ##\ ##\  // >#< \##
 129 # #  #  #     #   #   # # #  #  # #   #
 130 \#/  #  ### ##/   # ##/ \#/  #  \#/ ##/
 131
 132 a b c d e f
 133
 134     #         #     /##
 135 /## ##\ /## /## /## #
 136 # # # # #   # # # # ###
 137 # # # # #   # # #/  #
 138 \## ##/ \## \## ### #
 139