#!usr/bin/perl
# --==--==--==--==--==--==--==--==--==--==
# Author: SiD - flybor[at]hotmail[dot]it
# License: GNU/Gpl
# Version: 1.1
# 1/2009
# --==--==--==--==--==--==--==--==--==--==
# PPM Base library
# For Perl ~~ Greetz to neo :)
# --==--==--==--==--==--==--==--==--==--==
use Switch;
sub load_image {
open(IMGP
, "<", $image) ? $imgr = 1
: die("PPM Base library -> error. Invalid image?\n");
}
sub new_image {
open(IMGP2
, ">", $image) ? $imgr = 1
: die("PPM Base library -> error. Invalid image?\n");
}
#-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
# Single pixel color change function
#-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
sub change_single {
my $rows = 0;
checktype();
while($line = <IMGP>) {
if($rows >= $imgtype) {
for($xi=0; $xi<=length($line); $xi++) {
$s = 1
if($line =~ s/$start/$end/);
}
}
$rows++;
}
return "PPM Base library -> [Single] Done." if($s); $s=0;
return "PPM Base library -> [Single] No RGB changed." if(!$s);
}
#-=-=-=-=-=-=-=-=-=-=-=
# Tern change function
#-=-=-=-=-=-=-=-=-=-=-=
sub change_tern {
checktype();
if($tern and $ntern !~ /(.+) (.+) (.+)/) {
die("PPM Base library -> [Tern] Invalid RGB tern!\n");
}
while($linen = <IMGP>) {
$s1 = 1
if($linen =~ s/$tern/$ntern/);
}
return "PPM Base library -> [Tern] Done." if($s1); $s1=0;
return "PPM Base library -> [Tern] No RGB tern changed." if(!$s1);
}
#-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
# Gradient function
# For a good gradient, use 256 (WIDTH) ^^
#-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
sub create_gradient {
my($dim, $rgb) = @_;
print IMGP2
"P3\n#Gradient created with PPM Base library :: Perl :: By SiD\n$dim\n255\n";
@rgbval = split(" ", $rgb) and @dims = split(" ", $dim);
$lar = @dims[0];
$alt = @dims[1];
$r = @rgbval[0];
$g = @rgbval[1];
$b = @rgbval[2];
for($xb=0; $xb<=$lar; $xb++) {
for($xb2=0; $xb2<$alt; $xb2++, $g--) {
if($g >= 0 && $g <= @rgbval[1]) {
$s2 = 1
if(print IMGP2
"$r $g $b\n");
}
else {
$g = @rgbval[1]+1;
}
}
}
return "PPM Base library -> [Gradient] Done." if($s2); $s2=0;
return "PPM Base library -> [Gradient] No gradient created." if(!$s2);
}
#-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
# Chessboard function - I've to review this..
# See the image with Photoshop or GIMP!
#-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
sub chessboard {
@dims1 = split(" ", $dims) and $chesstype = 0;
$larg = @dims1[0];
$alte = @dims1[1];
$larg+=1
if(int($larg)%2
eq 0
);
$alte+=1
if(int($alte)%2
eq 0
);
print IMGP2
"P1\n#Chessboard created with PPM Base library :: Perl :: By SiD\n$larg $alte\n";
for($xc=0; $xc<$larg; $xc++) {
for($xc2=0; $xc2<$alte; $xc2++) {
if($chesstype eq 0) {
$s3 = 1
if(print IMGP2
$chesstype." ");
$chesstype = 1;
}
else {
$s3 = 1
if(print IMGP2
$chesstype." ");
$chesstype = 0;
}
}
}
return "PPM Base library -> [Chess] Done." if($s3); $s3=0;
return "PPM Base library -> [Chess] No chessboard created." if(!$s3);
}
#-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
# Line drawer function
# See the image with Photoshop or GIMP!
#-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
sub line {
@size1 = split(" ", $size) and $linetype = 1;
$larg = @size1[0];
$alte = @size1[0];
print IMGP2
"P1\n#Line(s) created with PPM Base library :: Perl :: By SiD\n$size $size\n";
for($xd=0; $xd<$larg; $xd++) {
for($xd2=0; $xd2<$alte; $xd2++) {
if($mode eq "vertical") {
if($linetype eq 0) {
$s4 = 1
if(print IMGP2
$linetype." ");
$linetype = 1;
}
else {
$s4 = 1
if(print IMGP2
$linetype." ");
$linetype = 0;
}
}
elsif($mode eq "horizontal") {
$s4 = 1
if(print IMGP2
$linetype." ");
}
else {
die("PPM Base library -> Invalid argument (orientation) for line function.\n");
}
}
if($linetype eq 0 && $mode eq "horizontal") {
$linetype = 1;
}
else {
$linetype = 0;
}
}
return "PPM Base library -> [Line] Done." if($s4); $s4=0;
return "PPM Base library -> [Line] No line image created." if(!$s4);
}
#-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
# Granule image creator function
#-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
sub granule {
@dims2 = split(" ", $dims);
$larg = @dims2[0];
$alte = @dims2[1];
print IMGP2
"P3\n#Granule image with colours created with PPM Base library :: Perl :: By SiD\n$dims\n255\n";
for($xe=0; $xe<$larg; $xe++) {
for($xe2=0; $xe2<$alte; $xe2++) {
$s5 = 1
if(print IMGP2
"$r $g $b\n");
}
}
return "PPM Base library -> [Granule Image] Done." if($s5); $s5=0;
return "PPM Base library -> [Granule Image] No image created." if(!$s5);
}
#-=-=-=-=-=-=-=-=-=-=-=
# Reverse RGB function
#-=-=-=-=-=-=-=-=-=-=-=
checktype();
my $rows = 0;
while($line = <IMGP>) {
if($rows >= $imgtype) {
die("Invalid PPM image header.\n") if(length($line) <= 3
);
@tempa = split(" ", $line);
$line = "";
for($xf=0
, $xf2=scalar(@tempa); $xf<=scalar(@tempa) && $xf2>=0; $xf++, $xf2--) {
$line .= @tempa[$xf2]." ";
}
$line .= "\n";
}
$s6 = 1
if(print IMGP2
$line);
$line = "" and @tempa = ();
$rows++;
}
return "PPM Base library -> [Reverse] Done." if($s6); $s6=0;
return "PPM Base library -> [Reverse] No RGB reversed." if(!$s6);
}
#-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
# Format image with tern function
#-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
checktype();
my $rows = 0;
my $rgbtern = 1;
while($line = <IMGP>) {
if($rows >= $imgtype) {
$newline .= $line." ";
if($rgbtern eq 3) {
$s7 = 1
if(print IMGP2
$newline."\n");
$newline = "", $rgbtern = 0;
}
$rgbtern++;
}
else {
$s7 = 1
if(print IMGP2
$line);
}
$rows++;
}
return "PPM Base library -> [Format] Done." if($s7); $s7=0;
return "PPM Base library -> [Format] No image formatted." if(!$s7);
}
#-=-=-=-=-=-=-=-=-=-=-=-=
# Copy PPM image function
#-=-=-=-=-=-=-=-=-=-=-=-=
sub copy {
while($line = <IMGP>) {
$arows++;
$brows++ if(print IMGP2
$line);
}
return "PPM Base library -> [Copy] Done." if($arows eq $brows);
return "PPM Base library -> [Copy] Cannot copy the image." if($arows ne $brows);
}
#-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
# 180° Rotation + Reverse function
#-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
sub reverse_180 {
checktype();
my $rows = 0;
my(@temp, $line);
while($line = <IMGP>) {
if($rows >= $imgtype) {
die("Invalid PPM image header.\n") if(length($line) <= 3
);
@splitter = split(" ", $line);
}
else {
$s8 = 1
if(print IMGP2
$line);
}
$rows++;
}
for($xg=0
, $xg2=scalar(@temp); $xg<=scalar(@temp) && $xg2>=0; $xg++, $xg2--) {
$s8 = 1
if(print IMGP2
@temp[$xg2]." ");
}
return "PPM Base library -> [180° + Reverse] Done." if($s8); $s8=0;
return "PPM Base library -> [180° + Reverse] Cannot process the image." if(!$s8);
}
#-=-=-=-=-=-=-=-=-=-=
# Noise set function
#-=-=-=-=-=-=-=-=-=-=
sub noise {
checktype();
my $rows = 0;
my(@temp, $line, $newline);
while($line = <IMGP>) {
if($rows >= $imgtype) {
die("Invalid PPM image header.\n") if(length($line) <= 3
);
@splitter = split(" ", $line);
foreach(@splitter) {
}
my @splitter;
}
else {
$s9 = 1
if(print IMGP2
$line);
}
$rows++;
}
for($xi=0; $xi<=scalar(@temp); $xi++) {
if(int(@temp[$xi]-$num) >= 0
) {
$newline = int(@temp[$xi]-$num);
}
else {
$newline = @temp[$xi];
}
$s9 = 1
if(print IMGP2
$newline." ");
$newline = "";
}
return "PPM Base library -> [Noise] Done." if($s9); $s9=0;
return "PPM Base library -> [Noise] Cannot process the image." if(!$s9);
}
#-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
# P6 to P3 converter function
# Thanks neo for the help with P6 images ^^
#-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
sub P6_P3 {
checktype();
my $rows = 0;
($imgt eq "P6\n") ? print IMGP2
"P3\n" : die("Invalid P6 image!\n");
while($line = <IMGP>) {
if($rows >= $imgtype) {
@line = split("", $line);
foreach(@line) {
}
my @line;
}
else {
$s10 = 1
if(print IMGP2
$line);
}
$rows++;
}
return "PPM Base library -> [Convert to P3] Done." if($s10); $s10=0;
return "PPM Base library -> [Convert to P3] Cannot convert the image." if(!$s10);
}
#-=-=-=-=-=-=-=-=
# Get image type
#-=-=-=-=-=-=-=-=
sub checktype {
$imgt = <IMGP>;
if($imgt ne "P6\n") {
}
switch($imgt) {
case("P1\n") {
$imgtype = 2;
}
case("P2\n") {
$imgtype = 3;
}
case("P3\n") {
$imgtype = 3;
}
case("P5\n") {
$imgtype = 3;
}
case("P6\n") {
$imgtype = 3;
}
else {
die("Invalid image found!\n");
}
}
}
if($imgr) {
}
1;
# PPM Base Library
# Author: SiD
# http://sid93.wordpress.com
# flybor[at]hotmail[dot]it