Skip to content

Instantly share code, notes, and snippets.

@zr-tex8r
Last active August 9, 2023 05:12
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save zr-tex8r/cc558ea109ead41bc5958daeefe37c44 to your computer and use it in GitHub Desktop.
tcfaspinを利用した“回るLaTeX文書”からアニメGIF画像を生成する
#!/usr/bin/env perl
use v5.12;
my $program = "tcspingif";
my $version = "0.8.1";
my $mod_date = "2023/08/08";
use constant DEFAULT_TICKS => 32;
use constant CYCLE => 2; # seconds
my ($ticks, $in_file, $out_file);
my $engine = "pdflatex";
my $density = 72;
my $boost = 1;
my $interval = 0;
my $verbose = 0;
my $interface = 'latex';
my $save_temp = 0;
my $alternate = 0;
my $fork = 0;
my $imconvert = $ENV{IMCONVERT} || "magick";
my $dvipdfmx = "dvipdfmx";
my $mylatexformat = "mylatexformat";
my $tempb = "__tcsg".$$."x";
my (@mlfinfo);
sub show_usage {
print <<"EOS";
Usage: $program [OPTION]... LATEX_FILE
Available options:
-e/--engine=NAME Set LaTeX engine.
-d/--density=NUM Set dpi value.
-t/--ticks=NUM Set ticks (number of frames) value.
-b/--boost=NUM Set boost value.
-i/--interval=NUM Set interval value (in msec).
--interface=NAME Set "frame interface" name. (latex/env)
-v/--verbose Be more verbose.
--clean Clean temporary files and exit.
-h/--help Show this help and exit.
-V/--version Show version and exit.
EOS
# --fork=NUM Enable concurrent mode.
}
sub show_version {
print <<"EOS";
$program $version
EOS
}
sub get_ticks {
my ($fsrc) = @_; local ($_, $/); my ($up);
open(my $h, '<', $fsrc)
or error("cannot open for input", $fsrc);
$_ = <$h>;
close($h);
($up) = m/\\usepackage\s*((\[.*?\])?)\s*\{tcfaspin\}/;
if (defined $up) {
($_) = ($up =~ m/ticks\s*=\s*(\d+)/);
return (defined $_) ? ($_-0) : DEFAULT_TICKS;
}
($up) = m/\\usepackage\s*((\[.*?\])?)\s*\{bxblink\}/;
if (defined $up) {
return 8;
}
return;
}
sub get_stop_blink {
my ($tv, $ticks) = @_;
return (int($tv * 8 / $ticks) % 4 == 2) ? 0 : 1;
}
my %generate_frame_ifs = (
latex => \&generate_frame,
env => \&generate_frame_env,
);
sub generate_frame {
my ($tick, $swf) = @_;
info("generate frame", $tick);
my $sb = get_stop_blink($tick, $ticks);
my $ts = sprintf("%0".length($ticks)."d", $tick);
my $fb = ($swf) ? "$tempb-z$ts" : $tempb;
my $fpdf = "$fb.pdf";
my $fdvi = "$fb.dvi";
my $fpng = "$tempb-$ts.png";
(!$swf) and unlink($fpdf, $fdvi);
if (@mlfinfo) {
compose_mylatexformat($fb,
"\\mathchardef\\faStopTicks=$tick" .
"\\mathchardef\\faAllTicks=$ticks" .
"\\mathchardef\\StopBlink=$sb");
(run(<<"EOS")) or error("LaTeX compile error", "$fb.tex");
$engine -halt-on-error -interaction=nonstopmode -jobname=$fb
-fmt=$tempb-m "$fb.tex"
1>$fb-o.out 2>$fb-e.out
EOS
} else {
(run(<<"EOS")) or error("LaTeX compile error", $in_file);
$engine -halt-on-error -interaction=nonstopmode -jobname=$fb
"\\mathchardef\\faStopTicks=$tick"
"\\mathchardef\\faAllTicks=$ticks"
"\\mathchardef\\StopBlink=$sb"
"\\input $in_file"
1>$fb-o.out 2>$fb-e.out
EOS
}
if (-s $fdvi) {
(run(<<"EOS") && -s $fpdf) or error("PDF conversion error", $fdvi);
$dvipdfmx $fdvi -o $fpdf
1>$fb-o.out 2>$fb-e.out
EOS
} elsif (!-s $fpdf) {
error("LaTeX compile error", $in_file);
}
(run(<<"EOS") && -s $fpng) or error("conversion error", $fpdf);
$imconvert -background white -alpha remove -density $density $fpdf $fpng
EOS
return $fpng;
}
sub generate_frame_env {
my ($tick, $swf) = @_;
info("generate frame", $tick);
my $sb = get_stop_blink($tick, $ticks);
my $ts = sprintf("%0".length($ticks)."d", $tick);
my $fb = ($swf) ? "$tempb-z$ts" : $tempb;
my $fpdf = "$fb.pdf";
my $fpng = "$tempb-$ts.png";
(!$swf) and unlink($fpdf);
$ENV{FASTOPTICKS} = "$tick";
$ENV{FAALLTICKS} = "$ticks";
$ENV{STOPBLINK} = "$sb";
(run(<<"EOS")) or error("frame generator error", $in_file);
$engine "$in_file" "$fpdf"
1>$fb-o.out 2>$fb-e.out
EOS
if (!-s $fpdf) {
error("frame generator error", $in_file);
}
(run(<<"EOS") && -s $fpng) or error("conversion error", $fpdf);
$imconvert -background white -alpha remove -density $density $fpdf $fpng
EOS
return $fpng;
}
sub prepare_mylatexformat {
open(my $h, '<', $in_file) or error("cannot read", $in_file);
my @lines = <$h>;
close($h);
foreach my $i (0 .. $#lines) {
local $_ = $lines[$i];
(m/^\s*\%/) and next;
(m/\\endofdump\b|\\csname +endofdump\\endcsname\b/) or next;
@mlfinfo = (join('', @lines[0..$i]), join('', @lines[$i+1..$#lines]));
last;
}
(@mlfinfo) or return;
info("endofdump token found, go mylatexformat...");
(run(<<"EOS") && -s "$tempb-m.fmt") or error("mylatexformat failure");
$engine -ini -halt-on-error -interaction=nonstopmode -jobname=$tempb-m
"\&$engine" mylatexformat.ltx "$in_file"
1>$tempb-o.out 2>$tempb-e.out
EOS
info("mylatexformat success");
}
sub compose_mylatexformat {
my ($bas, $add) = @_; my $f = "$bas.tex";
open(my $h, '>', $f) or error("cannot open for write", $f);
print $h ($mlfinfo[0], $add, "\n", $mlfinfo[1]);
close($h);
}
sub main {
read_option();
(-f $in_file) or error("file not found", $in_file);
if (!defined $ticks) {
$ticks = get_ticks($in_file);
(defined $ticks) or error("cannot get ticks value", $in_file);
}
($ticks > 0) or error("bad ticks value");
info("convert", "$in_file -> $out_file");
info("parameters", "density=$density; ticks=$ticks; alternate=$alternate");
prepare_mylatexformat();
my @png;
my $generate_frame = $generate_frame_ifs{$interface};
if ($fork <= 0) {
foreach my $tick (0 .. $ticks-1) {
push(@png, $generate_frame->($tick));
}
} else {
info("enter fork mode", "fork=$fork");
my $fpng = $generate_frame->(0, 1);
workers_run($fork, $ticks - 1, sub {
$generate_frame->($_[0], 1);
});
$fpng =~ s/0+(\.\w+)$/\*$1/;
@png = glob($fpng);
}
info("generate gif", $out_file);
my $delay = ($interval) ? $interval / 10 :
CYCLE * 100 / $ticks / $boost;
$delay = ($delay < 1) ? 1 : int($delay + 1e-8);
info("delay", ($delay * 10) . " ms");
my $inlist = make_in_list(\@png, $delay, $alternate);
(run(<<"EOS") && -s $out_file) or error("conversion error", $out_file);
$imconvert $inlist $out_file
EOS
unlink(glob("$tempb*.*")) unless ($save_temp);
}
sub make_in_list {
my ($png, $delay, $alternate) = @_; local ($_, $/);
if ($alternate) {
$png = [@$png, reverse(@$png[1..($#$png-1)])];
}
my @out; my $prev = '';
foreach my $fpng (@$png) {
my $fppm = $fpng; $fppm =~ s/png$/ppm/;
(-s $fppm) or (run(<<"EOS") && -s $fppm) or error("conversion error", $fppm);
$imconvert $fpng $fppm
EOS
open(my $h, '<', $fppm) or die;
binmode($h); $_ = <$h>;
close($h);
if ($prev eq $_) {
$out[-1][1] += $delay;
} else {
push(@out, [$fpng, $delay]); $prev = $_;
}
}
if ($verbose) {
info("conversion input list");
foreach my $e (@out) {
printf STDERR ("- %s (%s)\n", @$e);
}
}
my @words; $prev = -1;
foreach my $e (@out) {
my ($f, $d) = @$e;
if ($d != $prev) {
push(@words, "-delay", $d); $prev = $d;
}
push(@words, $f);
}
return join(' ', @words);
}
sub read_option {
my $clean = 0;
if (!@ARGV) {
show_usage(); exit;
}
while ($ARGV[0] =~ m/^-/) {
local $_ = shift(@ARGV); my $arg;
if (m/^--$/) {
last;
} elsif (m/^(?:-h|-?-help)$/) {
show_usage(); exit;
} elsif (m/^(?:-V|--version)$/) {
show_version(); exit;
} elsif (m/^(?:-v|--verbose)$/) {
$verbose = 1;
} elsif (m/^--clean$/) {
$clean = 1;
} elsif (($arg) = m/^(?:-d|--density)(?:=(.*))?$/) {
(defined $arg) or $arg = shift(@ARGV);
($arg =~ m/^\d+(?:\.\d+)?$/) or error("invalid density value", $arg);
$density = $arg;
} elsif (($arg) = m/^(?:-t|--ticks)(?:=(.*))?$/) {
(defined $arg) or $arg = shift(@ARGV);
($arg =~ m/^\d+$/) or error("invalid ticks value", $arg);
$ticks = $arg;
} elsif (($arg) = m/^(?:-b|--boost)(?:=(.*))?$/) {
(defined $arg) or $arg = shift(@ARGV);
($arg =~ m/^\d+(?:\.\d+)?$/) or error("invalid boost value", $arg);
$boost = $arg;
} elsif (($arg) = m/^(?:-i|--interval)(?:=(.*))?$/) {
(defined $arg) or $arg = shift(@ARGV);
($arg =~ m/^\d+(?:\.\d+)?$/) or error("invalid interval value", $arg);
$interval = $arg;
} elsif (($arg) = m/^--fork(?:=(.*))?$/) {
(defined $arg) or $arg = shift(@ARGV);
($arg =~ m/^\d+$/) or error("invalid fork value", $arg);
$fork = $arg;
} elsif (($arg) = m/^(?:-e|--engine)(?:=(.*))?$/) {
(defined $arg) or $arg = shift(@ARGV);
($arg =~ m/^[-\w]+$/) or error("invalid engine name", $arg);
$engine = $arg;
} elsif (($arg) = m/^--interface(?:=(.*))?$/) {
(defined $arg) or $arg = shift(@ARGV);
(exists $generate_frame_ifs{$arg}) or error("invalid interface name", $arg);
$interface = $arg;
} elsif (m/^--save-temp$/) {
$save_temp = 1;
} elsif (m/^--alternate$/) {
$alternate = 1;
} else {
error("unknown option", $_);
}
}
if ($clean) {
($#ARGV == -1) or error("wrong number of arguments");
clean(); exit;
}
($#ARGV == 0) or error("wrong number of arguments");
$in_file = shift(@ARGV);
($out_file = $in_file) =~ s/\.\w+$//i; $out_file .= ".gif";
}
sub clean {
local $_ = $tempb; s/\d+/\*/ or die; m/^_/ or die;
my @fs = glob("$_*");
$_ = "\Q$_\E"; s/\\\*/\\d\+/; $_ = qr/^$_/;
unlink(grep { m/$_/ } (@fs));
}
sub run {
local ($_) = @_; s/\s+/ /g;
debug("run", $_);
return (system($_) == 0);
}
sub show_log {
print STDERR (join(": ", $program, @_), "\n");
}
sub debug {
($verbose >= 1) and show_log(@_);
}
sub info {
($verbose >= 0) and show_log(@_);
}
sub error {
die (join(": ", $program, @_) . "\n");
}
#---------------------------------------
# worker system
my ($wkid);
sub wk_info {
my $w = (defined $wkid) ? "worker-$wkid" : "main";
info($w, @_);
}
sub wk_erfile {
return sprintf("%s-err", $tempb);
}
sub wk_tkfile {
return sprintf("%s-t%03d", $tempb, $_[0]);
}
sub wk_wkfile {
(@_) or return sprintf("%s-w*", $tempb);
return sprintf("%s-w%03d", $tempb, $_[0]);
}
sub workers_run {
my ($nwk, $ntk, $proc) = @_; my ($pid);
#
wk_info("make tickets", "num=$ntk");
for (1 .. $ntk) {
open(my $ht, '>', wk_tkfile($_)) or die; close($ht);
}
#
wk_info("make workers", "num=$ntk");
for (1 .. $nwk) {
if ($pid = fork()) {
$wkid = $_;
wk_info("created", "pid=$pid");
open(my $ht, '>', wk_wkfile($_)) or die; close($ht);
last;
}
}
######## WORKER
if (defined $wkid) {
foreach my $tk (1 .. $ntk) {
if (-f wk_erfile()) {
wk_info("aborted"); unlink(wk_wkfile($wkid));
exit(1);
}
if (unlink(wk_tkfile($tk))) {
wk_info("got ticket", "$tk");
eval {
$proc->($tk);
};
if ($@) {
local $_ = "$@"; s/\n\z//; wk_info("error", $_);
unlink(map { wk_tkfile($_) } (1 .. $ntk));
open(my $h, '>', wk_erfile()) or die; close($h);
unlink(wk_wkfile($wkid));
exit(1);
}
}
}
wk_info("done"); unlink(wk_wkfile($wkid));
exit;
}
######## MAIN
wk_info("wait");
while ($nwk > 0) {
my @a = glob(wk_wkfile());
if ($nwk != scalar(@a)) {
$nwk = scalar(@a);
wk_info("working", "num=$nwk");
}
sleep(1);
}
if (unlink(wk_erfile())) {
wk_info("error occurred");
}
wk_info("all done");
}
#---------------------------------------
main();
# EOF
@zr-tex8r
Copy link
Author

zr-tex8r commented Aug 9, 2020

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment