#!/perl/bin/perl
#
# wif2png.pl -- script to convert from a .wif file to a .png for viewing...
use strict;
use warnings;
use diagnostics;
use IniFile;
use File::Basename;
use GD;
my $ini = new IniFile($ARGV[0]);
my %contents = getSectionHash($ini,'CONTENTS');
my %wif = getSectionHash($ini,'WIF');
my %tieup = getSectionHash($ini,'TIEUP');
my @threading = getSectionArray($ini,'THREADING');
my @treadling = getSectionArray($ini,'TREADLING');
my %weaving = getSectionHash($ini,'WEAVING');
my %color_table = getSectionHash($ini,'COLOR TABLE');
my %warp = getSectionHash($ini,'WARP');
my $warpcolor = $warp{'Color'};
my %weft = getSectionHash($ini,'WEFT');
my $weftcolor = $weft{'Color'};
my %color_palette = getSectionHash($ini,'COLOR PALETTE');
my @color_range = split(',',$color_palette{'Range'});
my @shafts;
my @compositshafts;
my @empty = split(/,/,'0,' x scalar(@threading));
my $im = new GD::Image(scalar(@threading),scalar(@treadling)) or die "couldn't create new GD image.\n";
my $WeftColor = gdRGB($im,$color_table{$weftcolor},@color_range);
my @color_table;
my %warp_colors = getSectionHash($ini,'WARP COLORS');
my ($name,$path,$suffix) = fileparse($ARGV[0],'\..*');
my $n;
foreach (keys %color_table) {
$color_table[$_ - 1] = gdRGB($im,$color_table{$_},@color_range);
}
foreach (1..$weaving{'Shafts'}) {
push(@shafts,[@empty]);
push(@compositshafts,[@empty]);
}
foreach (0..@threading - 1) {
$shafts[$threading[$_] - 1][$_] = ($warp_colors{$_} or $warpcolor);
}
$n = 0;
foreach (keys %tieup) {
foreach (split(',',$tieup{$_})) {
foreach ($shafts[$_ - 1]) {
$compositshafts[$n] = [union($compositshafts[$n],$_)];
}
}
$n++;
}
foreach my $row (0 .. @treadling - 1) {
foreach my $col (0 .. @threading - 1) {
if ($compositshafts[$row % 8][$col]) {
$im->setPixel($col,$row,$color_table[$compositshafts[$row % 8][$col] - 1]);
}
else {
$im->setPixel($col,$row,$WeftColor);
}
}
}
open(IMAGE,">$path$name.png") or die "Couldn't open $path$name.png:$!\n";
binmode IMAGE;
print IMAGE $im->png();
close IMAGE;
open(HTML,">$path$name.html") or die "Couldn't open $path$name.html:$!\n";
print HTML qq(\n);
print HTML qq(\n);
print HTML qq(\n);
print HTML qq(Image\n);
print HTML qq(\n);
print HTML qq(\n);
print HTML qq(![](\"$path$name.png\")
\n);
print HTML qq(\n);
close HTML;
sub gdRGB {
my $im = shift;
my ($rgb,$lowerlimit,$upperlimit) = @_;
my ($red,$green,$blue) = split(/,/,$rgb);
unless ($lowerlimit) {
return $im->colorAllocate(
int(($red / $upperlimit) * 255),
int(($green / $upperlimit) * 255),
int(($blue / $upperlimit) * 255));
}
else {
return undef;
}
}
sub union {
my $s1 = shift;
my $s2 = shift;
my @union;
foreach (0..@$s1 - 1) {
push(@union,@$s1[$_] | @$s2[$_]);
}
return @union;
}
sub getSectionHash {
my $ini = shift;
my $ref = $ini->get([shift]);
my %hash;
foreach (keys %$ref) {
$hash{$_} = $$ref{$_}[0];
}
return %hash;
}
sub getSectionArray {
my $ini = shift;
my $ref = $ini->get([shift]);
my @array;
foreach (keys %$ref) {
push(@array,$$ref{$_}[0]);
}
return @array;
}
__END__