#!/usr/bin/perl

### skewing

use GD;
use strict;
use warnings;

use constant FINAL => 0;

my ($X, $Y) = (256, 256);

# all these images are 256x256
my $wood = GD::Image->new("acacia/wallwood.png");
my $ceiling = GD::Image->new("acacia/ceiling.png");
my $rug = GD::Image->new("acacia/floorrug.png");
my $comp = GD::Image->new("acacia/wallcomp.png");
my $arch = GD::Image->new("acacia/wallarch.png");


my $tmp = GD::Image->new(2 * $X, 2 * $Y, 1);
$tmp->clip(2 * $X/8, 2 * $Y/8, 2 * $X*7/8, 2 * $Y*7/8);


back_wall($tmp, $wood, 3, $_, $X, $Y) for -3 .. 3;

ceiling($tmp, $ceiling, 3, $_, $X, $Y) for -4 .. 4;
ceiling($tmp, $ceiling, 2, $_, $X, $Y) for -2 .. 2;
ceiling($tmp, $ceiling, 1, $_, $X, $Y) for -1 .. 1;

floor($tmp, $rug, 3, $_, $X, $Y) for -4 .. 4;
floor($tmp, $rug, 2, $_, $X, $Y) for -2 .. 2;
floor($tmp, $rug, 1, $_, $X, $Y) for -1 .. 1;

side_wall($tmp, $comp, 3,  1, $X, $Y);
side_wall($tmp, $comp, 2, -1, $X, $Y);
side_wall($tmp, $comp, 2,  1, $X, $Y);
side_wall($tmp, $comp, 1, -1, $X, $Y);
back_wall($tmp, $arch, 1,  0, $X, $Y);
back_wall($tmp, $comp, 1,  1, $X, $Y);


my $final = GD::Image->new(2*$X, 2*$Y*3/4, 1);
$final->copyResampled(
  $tmp,
  (0,0) => (2*$X/8, 2*$Y/8),
  (2*$X*3/4, 2*$Y*3/4), (2*$X*3/4, 2*$Y*3/4)
);

$tmp->setThickness(4);
$tmp->rectangle(
  (2 * $X/8, 2 * $Y/8) => (2 * $X*7/8, 2 * $Y*7/8),
  $tmp->colorAllocate(255,255,0),
);

print $tmp->rgb($tmp->getPixel($X,$Y));
$tmp->transparent($tmp->rgb($tmp->getPixel($X,$Y)));


open IMG, '>:raw', 'composite.png' or die $!;
binmode IMG;
print IMG +(FINAL ? $final : $tmp)->png;
close IMG;



sub ceiling {
  my ($dst, $src, $depth, $os, $x, $y) = @_;
  my $cf = 2 * (2**$depth - 1) / 2**($depth + 1);
  my $sf = 2 * 1 / 2**$depth;

  for (0 .. 2 * $y * 1/2**($depth+1) - 1) {
    $dst->copyResampled(
      $src,
      ($x * $cf + $sf * $x * $os + $_*(1 + 2*($os-1)), $y * $cf - ($_ 
++ 1)) => (0, $y - 2**$depth * ($_ + 1)),
      ($x * $sf + 2*$_, 1), ($x, 2**$depth),
    );
  }
}


sub floor {
  my ($dst, $src, $depth, $os, $x, $y) = @_;
  my $cf = (2**$depth - 1) / 2**($depth + 1);
  my $sf = 2 * 1 / 2**$depth;

  for (0 .. 2 * $y * 1/2**($depth+1) - 1) {
    $dst->copyResampled(
      $src,
      (2 * $x * $cf + $sf * $x * $os + $_*(1 + 2*($os-1)), 2 * $y * (1
+-$cf) + $_) => (0, 2**$depth * $_),
      ($x * $sf + 2*$_, 1), ($x, 2**$depth),
    );
  }
}


sub back_wall {
  my ($dst, $src, $depth, $os, $x, $y) = @_;
  my $cf = 2 * (2**$depth - 1) / 2**($depth + 1);
  my $sf = 2 * 1 / 2**$depth;

  $dst->copyResampled(
    $src,
    ($x * ($cf + $os * $sf), $y * $cf) => (0, 0),
    ($x * $sf, $y * $sf), ($x, $y),
  );
}


sub side_wall {
  my ($dst, $src, $depth, $os, $x, $y) = @_;
  my $cf = (2**$depth - 1) / 2**($depth + 1);
  my $sf = 2 * 1 / 2**$depth;
  $os-- if $os > 0;

  for (0 .. 2 * $x / 2**($depth + 1) - 1) {
    $dst->copyResampled(
      $src,
      (($os < 0 ? -1 : 0) + $sf*$x*$os + 2*$x*(1-$cf) + ($os*2+1)*$_, 
+2*$y*$cf - $_) => ($os < 0 ? ($x - ($_+1) * 2**$depth) : ($_ * 2**$de
+pth), 0),
      (abs(2*$os + 1), $sf * $y + 2 * $_), (2**$depth, $y)
    );
  }
}
[download]