X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=commitid.scad.pl;h=62ae5105e07259a2a0a2ec25ad2f69f8aec8b0a0;hb=HEAD;hp=33ab57d8cc8db00592a43970cb8cc3a77c3bebe3;hpb=8c3df00029d49a38603bbb1f644ae71590d0e631;p=reprap-play.git diff --git a/commitid.scad.pl b/commitid.scad.pl deleted file mode 100755 index 33ab57d..0000000 --- a/commitid.scad.pl +++ /dev/null @@ -1,390 +0,0 @@ -#!/usr/bin/perl -w -use strict; - -$SIG{__WARN__} = sub { die @_; }; - -# xxx much of the comment below is TODO -# -# Usage: -# -# .../commitid.scad.pl [OPTION...] [STRING...] >commitid.scad.new \ -# && mv -f commitid.scad.new commitid.scad -# -# Options: -# -# --git generate git commit indications, as shown below -# (this is the default if no strings are requested with -t) -# -# --git=object -# generate git commit indication based on commit object only -# (ie avoid counting commits) -# -# -i do not generate `+' if git-untracked files are present -# -# [-t[FORM]] TEXT -# generate a form FORM containing TEXT -# TEXT can contain newlines (final newline usually undesirable) -# if FORM not specified, generates Arg0 Arg1 Arg2 in sequence -# character set is SPC 0-9 a-f + * (`*' glyph is `=/='). -# -# We generate a physical indication of which commit was used. -# -# We provide for scaling factors with dynamic variables: -# $Commitid_pixelsz if not set, we use 0.8 } multiplied -# $Commitid_scale if not set, we use 1.0 } together -# $Commitid_depth if not set, we use xy pixel size from above / 2 -# $Commitid_depth_scale if not set, we use 1.0 (multiplies depth above) -# -# For each form we have -# -# module Commitid_Form_2D() { ... } -# module Commitid_Form() { ... } -# function Commitid_Form_sz() => [ x, y ] -# -# These have their origin in the bottom left corner. The 3D model -# is a positive, has its origin halfway through, and is twice the -# depth in height, so it can be added or subtracted. -# -# And we provide -# -# function Commitid_pixelsz() // $Commitid_pixelsz * $Commitid_scale -# function Commitid_depth() // see above -# -# We can generate these forms: -# -# Small3: -# Small4: -# Small5: -# Small6: -# Small7: -# Small8: -# Small9: -# Small10: -# git rev-list --first-parent --count HEAD -# typically 3-4 characters but we allow for up to 6 -# padded with zeroes; if too long we reduce mod 10^n -# eg -# Small4 1070 -# If tree is dirty, + or * is suffixed, reducing number of -# digits by 1. -# -# Small4S: -# Small6S: -# Small8S: -# Small10S: -# same but split into two lines eg -# Small4S 10 -# 70 -# -# Git4 Git4S -# Git6 Git6S -# Git8 Git8S -# Git10 Git10S -# git-rev-parse HEAD (prefix of requested length) -# eg -# Git6 82f2a2 -# If tree is dirty, + or * is suffixed to commitid, -# reducing number of hex digits by 1. - -# Full3 -# Full4 -# Full5 -# Full6 -# Full7 -# Full8 -# Full9 -# Full10 -# git-rev-list --first-parent --count HEAD -# git-rev-parse HEAD -# eg -# Full6 1070 -# 82f2a2 -# If tree is dirty, + or * is suffixed to count (but not to -# commitid) reducing number of digits by 1. -# -# FontDemo -# -# Arg0, Arg1, ... -# Strings passed on command line - -sub p { print @_ or die $!; } - -p <<'END'; -// *** AUTOGENERATED - DO NOT EDIT *** // -function Commitid_pixelsz() = - ($Commitid_pixelsz ? $Commitid_pixelsz : 0.8) * - ($Commitid_scale ? $Commitid_scale : 1.0); -function Commitid_depth() = - ($Commitid_depth ? $Commitid_depth : Commitid_pixelsz()/2) * - ($Commitid_depth_scale ? $Commitid_depth_scale : 1.0); -function Commitid__scale() = - Commitid_pixelsz() / 0.2; -END - -sub chrmodname ($) { - my ($chr) = @_; - my $chrx = sprintf '%#x', ord $chr; - return "Commitid__chr_$chrx"; -} - -sub gentextmodule ($@) { - my ($form, @lines) = @_; - my $modb = "Commitid_$form"; - p "module ${modb}_2D(){\n"; - p " // |$_|\n" foreach @lines; - p " scale(Commitid__scale()){\n"; - my $y = @lines; - my $cols = 1; - foreach my $line (@lines) { - $y--; - my $x = 0; - foreach my $chr (split //, $line) { - next if $chr !~ m/\S/; - p sprintf " translate([%d * 0.8, %d * 1.2]) %s();\n", - $x, $y, chrmodname $chr; - $x++; - } - $cols = $x if $x > $cols; - } - p " }\n"; - p "}\n"; - p "module ${modb}(){\n"; - p " d=Commitid_depth();\n"; - p " translate([0,0,-d]) linear_extrude(height=d*2) ${modb}_2D();\n"; - p "}\n"; - p sprintf "function %s_sz() = Commitid__scale() * 0.1 * [ %d, %d ];\n", - $modb, 2 * ($cols * 4 - 1), 2 * (@lines * 6 - 1); -} - -our @demo; - -sub parsefont () { - my %cellmap; - for (;;) { - $_ = // die; - last if %cellmap && !m/\S/; - next unless m/\S/; - chomp; - s{^(.) }{}; - $cellmap{$1} = $_; - } - my %chrpolys; - while () { - next unless m/\S/; - chomp; - my @chrs = split / /, $_; - !~ m/\S/ or die; - foreach my $row (reverse 0..4) { - $_ = ; - chomp; - s{^}{ }; - $_ .= ' ' x 8; - m{\S/\S} and die; - s{/(?=\s)}{L}g; - s{/(?=\S)}{r}g; - s{\\(?=\s)}{l}g; - s{\\(?=\S)}{R}g; - p "// $_\n"; - foreach my $chr (@chrs) { - s{^ }{} or die "$chr $_ ?"; - foreach my $col (0..2) { - my @verts; - if (s{^ }{}) { - } 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 ]; - } else { - die "$_ ?"; - } - } - } - die "$_ ?" if m{\S}; - } - } - - my $demo = ''; - my $democols = 6; - foreach my $chr (sort keys %chrpolys) { - 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 = ','; - } - p "]);\n"; - } - p "}\n"; - $demo .= $chr; - } - @demo = reverse $demo =~ m{.{1,$democols}}go; -} - -parsefont(); - -our $do_git; # contains may chars 'c' (count) and/or 'o' (object) -our $do_git_untracked = 1; -our $argcounter; - -sub rjustt ($$) { # right justify and truncate (ie, pad and truncate at left) - my ($sz, $whole) = @_; - my $lw = length $whole; - return $lw > $sz - ? substr($whole, $lw-$sz) - : sprintf "%${sz}s", $whole; -} - -sub ljustt ($$$) { # always includes $suffix - my ($sz, $whole, $suffix) = @_; - $sz -= length $suffix; - return sprintf "%-${sz}.${sz}s%s", $whole, $suffix; -} - -sub gentextmodule_plusq ($$) { - my ($form, $s) = @_; - my $l = length $s; - gentextmodule($form, $s); - if (!($l & 1) && $l>=4) { - gentextmodule("${form}S", substr($s,0,$l/2), substr($s,$l/2)); - } -} - -our @gcmd; - -sub gitrun_start () { - open F, "-|", @gcmd or die "$gcmd[0]: start: $!"; -} - -sub gitrun_done (;$) { - my ($errok) = @_; - $?=0; $!=0; - return if close F; - return if $errok; - die $! if $!; - die "@gcmd failed ($?)\n"; -} - -sub gitoutput (@) { - (@gcmd) = (qw(git), @_); - gitrun_start; - $_ = ; - gitrun_done; - defined or die "@gcmd produced no output"; - chomp or die "@gcmd produced no final newline"; - $_; -} - -sub do_git () { - return unless $do_git; - - @gcmd = qw(git status --porcelain); - push @gcmd, qw(--untracked=no) unless $do_git_untracked; - - my $git_dirty = ''; - gitrun_start; - while () { - if (m/^\?\?/ && $do_git_untracked) { - $git_dirty = '+'; - next; - } - $git_dirty = '*'; - last; - } - gitrun_done($git_dirty eq '*'); - - my $git_count; - my $git_object; - - if ($do_git =~ m/c/) { - $git_count = gitoutput qw(rev-list --first-parent --count HEAD); - } - if ($do_git =~ m/o/) { - $git_object = gitoutput qw(rev-parse HEAD); - } - - foreach my $sz (3..10) { - gentextmodule_plusq("Small$sz", rjustt($sz, $git_count.$git_dirty)) - if defined $git_count; - - gentextmodule_plusq("Git$sz", ljustt($sz, $git_object, $git_dirty)) - if defined $git_object; - - gentextmodule("Full$sz", - rjustt($sz, $git_count.$git_dirty), - ljustt($sz, $git_object, '')) - if defined $git_count && defined $git_object; - } -} - -while (@ARGV) { - $_ = shift; - if (m/^--(no)?-git$/) { - $do_git = $1 ? '' : 'co'; - } elsif (m/^---git=object$/) { - $do_git = 'o'; - } elsif (m/^-i$/) { - $do_git_untracked = 0; - } elsif (m/^-t(.*)$/) { - my $form = $1; - die "bad usage: -t needs string argument\n"; - $_ = shift; - gentextmodule($form, split /\n/, $_); - $argcounter //= 0; - } elsif (m/^[^-]/) { - gentextmodule("Arg$argcounter", $_); - $argcounter++; - } else { - die "bad usage: unknown option \`$_'\n"; - } -} - -$do_git //= defined($argcounter) ? '' : 'co'; - -gentextmodule('FontDemo', @demo); - -do_git(); - -flush STDOUT or die $!; -close STDOUT or die $!; - -__DATA__ - -# 00 20 22 02 -l 00 20 02 -r 00 20 22 -L 00 22 02 -R 20 22 02 -> 00 20 22 02 11 -< 00 20 11 22 02 - -0 1 2 3 4 5 6 7 8 9 - -/#\ r /#\ ##\ # # ### // ### /#\ /#\ -# # /# # # # # # # # # # # # -# # # /#/ ##< \## ##\ ##\ // >#< \## -# # # # # # # # # # # # # -\#/ /#\ ### ##/ # ##/ \#/ # \#/ ##/ - -a b c d e f - - # # /## - # /## # /#\ # -/## ##\ # /## #r# ### -# # # # # # # #/ # -\## ##/ \## \## \#/ # - -+ * - - r - # ### -### # - # ### - L