Skip to content

Instantly share code, notes, and snippets.

@shicks
Created February 14, 2020 23:01
Show Gist options
  • Save shicks/7931087c1aa85be3863e91f94aa12bff to your computer and use it in GitHub Desktop.
Save shicks/7931087c1aa85be3863e91f94aa12bff to your computer and use it in GitHub Desktop.
Tetraflexagon creator
#!/usr/bin/perl
# Perl script for creating hexatetraflexagons.
# Usage: flex a.jpg b.jpb c.jpg. d.jpg e.jpg f.jpg
# Will pair a/b as the central pair, c/d on one side, and e/f on the other.
# Images must be square.
use strict;
use warnings;
# NOTE: geometry should be 1/2 the size of the smallest image
# Corners and directions:
# FRONT: e(NW) e(NE) a(SW CCW) c(NE) a(NW CW) x x c(SE) c(NW) x x a(SE CW) c(SW) a(NE CCW) e(SW) e(SE)
# BACK: d(SW) d(SE) b(NE CW) f(NE) b(SE CCW) x x f(SE) f(NW) x x b(NW CCW) f(SW) b(SW CW) d(NW) d(NE)
# Alternative version flips the grouped c,d,e,f so that the main cross all has a complete picture
# FRONT: e(SW) e(SE) a(SW CCW) c(NW) a(NW CW) x x c(SW) c(NE) x x a(SE CW) c(SE) a(NE CCW) e(NW) e(NE)
# BACK: d(NW) d(NE) b(NE CW) f(NW) b(SE CCW) x x f(SW) f(NE) x x b(NW CCW) f(SE) b(SW CW) d(SW) d(SE)
die "Requires 8 args" if @ARGV != 8;
my ($a, $b, $c, $d, $e, $f, $front, $back) = @ARGV;
my @in = ($a, $b, $c, $d, $e, $f);
my $size = 768;
for (@in) {
my $n = $_;
$_ = `identify $_`;
/ (\d+)x(\d+) / or die "Could not find size: $_";
die "Not square: $n: $1x$2" unless $1 eq $2;
$size = $1 if $size > $1;
}
my @gravity = qw/NorthWest NorthEast SouthEast SouthWest/;
my @rotate = qw/270 0 90/;
sub p {
my $pic = shift;
my $r = 0;
my $g = 0;
while (@_) {
$_ = shift;
$r = -1 if $_ eq 'ccw';
$r = 1 if $_ eq 'cw';
$g = 0 if $_ eq 'nw';
$g = 1 if $_ eq 'ne';
$g = 2 if $_ eq 'se';
$g = 3 if $_ eq 'sw';
}
$g = ($g + $r) % 4 if $r;
my @x = ('(', $pic);
push @x, '-gravity', $gravity[$g];
push @x, '-rotate', $rotate[$r + 1] if $r;
return (@x, qw/-crop 50%x50% )/);
}
my @args = (
'-geometry', "${size}x$size+0+0",
p($e, 'nw'), p($e, 'ne'), p($a, 'sw', 'ccw'), p($c, 'ne'),
p($a, 'nw', 'cw'), 'null:', 'null:', p($c, 'se'),
p($c, 'nw'), 'null:', 'null:', p($a, 'se', 'cw'),
p($c, 'sw'), p($a, 'ne', 'ccw'), p($e, 'sw'), p($e, 'se'),
$front);
print STDERR "montage @args\n";
system 'montage', @args;
@args = (
'-geometry', "${size}x$size+0+0",
p($d, 'nw'), p($d, 'ne'), p($b, 'ne', 'cw'), p($f, 'ne'),
p($b, 'se', 'ccw'), 'null:', 'null:', p($f, 'se'),
p($f, 'nw'), 'null:', 'null:', p($b, 'nw', 'ccw'),
p($f, 'sw'), p($b, 'sw', 'cw'), p($d, 'sw'), p($d, 'se'),
$back);
print STDERR "montage @args\n";
system 'montage', @args;
# montage -geometry 300x225+0+0 null: \( a.jpg -rotate 180 -gravity NorthEast -crop 50%x50% \) null: null: null: null: null: \( a.jpg -gravity NorthWest -crop 50%x50% \) \( a.jpg -gravity SouthEast -crop 50%x50% \) null: null: null: null: null: \( a.jpg -gravity SouthWest -crop 50%x50% \) null: b.jpg
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment