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
  81     use Data::Dumper;
  82     print Dumper(\%chrpolys);
  83 }
  84
  85 parsefont();
  86
  87 __DATA__
  88
  89 # 00 20 22 02
  90 l 00 20 22
  91 r 00 20 02
  92 L 00 22 02
  93 R 20 22 02
  94 > 00 20 22 02 11
  95 < 00 20 11 22 02
  96
  97 0 1 2 3 4 5 6 7 8 9
  98
  99 /#\  #  ##\ ##\ # # ### /## ### /#\ /#\
 100 # #  #    #   # # # #   #     # # # # #
 101 # #  #  /#/ ### ### ##\ ##\  // >#< \##
 102 # #  #  #     #   #   # # #  #  # #   #
 103 \#/  #  ### ##/   # ##/ \#/  #  \#/ ##/
 104
 105 a b c d e f
 106
 107     #         #     /##
 108 /## ##\ /## /## /## #
 109 # # # # #   # # # # ###
 110 # # # # #   # # #/  #
 111 \## ##/ \## \## ### #
 112