Last active
August 9, 2023 05:12
Star
You must be signed in to star a gist
tcfaspinを利用した“回るLaTeX文書”からアニメGIF画像を生成する
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/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 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
解説記事 → LaTeXでつくる「回転ゆきだるまGIF画像」