Share Pastebin
Guest
Public paste!

SiD

By: a guest | Jan 1st, 2009 | Syntax: Perl | Size: 9.50 KB | Hits: 67 | Expires: Never
Copy text to clipboard
  1. #!usr/bin/perl
  2.  
  3. # --==--==--==--==--==--==--==--==--==--==
  4. # Author: SiD - flybor[at]hotmail[dot]it
  5. # License: GNU/Gpl
  6. # Version: 1.1
  7. # 1/2009
  8. # --==--==--==--==--==--==--==--==--==--==
  9. # PPM Base library
  10. # For Perl   ~~  Greetz to neo :)
  11. # --==--==--==--==--==--==--==--==--==--==
  12.  
  13. use Switch;
  14. package ppm;
  15.  
  16.  
  17. sub load_image {
  18.  
  19.         my $image = shift;
  20.         open(IMGP, "<", $image) ? $imgr = 1 : die("PPM Base library -> error. Invalid image?\n");
  21.  
  22. }
  23.  
  24. sub new_image {
  25.  
  26.         my $image = shift;
  27.         open(IMGP2, ">", $image) ? $imgr = 1 : die("PPM Base library -> error. Invalid image?\n");
  28.  
  29. }
  30.  
  31. #-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  32. # Single pixel color change function
  33. #-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  34. sub change_single {
  35.  
  36.         my $start = shift;
  37.         my $end   = shift;
  38.         my $rows  = 0;
  39.        
  40.         checktype();
  41.  
  42.         while($line = <IMGP>) {
  43.                 if($rows >= $imgtype) {
  44.                         for($xi=0; $xi<=length($line); $xi++) {
  45.                                 $s = 1 if($line =~ s/$start/$end/);
  46.                         }
  47.                 }
  48.                 print IMGP2 $line;
  49.                 $rows++;
  50.         }
  51.  
  52.         return "PPM Base library -> [Single] Done." if($s); $s=0;
  53.         return "PPM Base library -> [Single] No RGB changed." if(!$s);
  54.  
  55. }
  56.  
  57. #-=-=-=-=-=-=-=-=-=-=-=
  58. # Tern change function
  59. #-=-=-=-=-=-=-=-=-=-=-=
  60. sub change_tern {
  61.  
  62.         checktype();
  63.  
  64.         my $tern  = shift;
  65.         my $ntern = shift;
  66.  
  67.         if($tern and $ntern !~ /(.+) (.+) (.+)/) {
  68.                 die("PPM Base library -> [Tern] Invalid RGB tern!\n");
  69.         }
  70.        
  71.         while($linen = <IMGP>) {
  72.                 $s1 = 1 if($linen =~ s/$tern/$ntern/);
  73.                 print IMGP2 $linen;
  74.         }
  75.  
  76.         return "PPM Base library -> [Tern] Done." if($s1); $s1=0;
  77.         return "PPM Base library -> [Tern] No RGB tern changed." if(!$s1);
  78.  
  79. }
  80.  
  81. #-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  82. # Gradient function
  83. # For a good gradient, use 256 (WIDTH) ^^
  84. #-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  85. sub create_gradient {
  86.  
  87.         my($dim, $rgb) = @_;
  88.         print IMGP2 "P3\n#Gradient created with PPM Base library :: Perl :: By SiD\n$dim\n255\n";
  89.         @rgbval = split(" ", $rgb) and @dims = split(" ", $dim);
  90.         $lar = @dims[0];
  91.         $alt = @dims[1];
  92.         $r = @rgbval[0];
  93.         $g = @rgbval[1];
  94.         $b = @rgbval[2];
  95.  
  96.         for($xb=0; $xb<=$lar; $xb++) {
  97.                 for($xb2=0; $xb2<$alt; $xb2++, $g--) {
  98.                         if($g >= 0 && $g <= @rgbval[1]) {
  99.                                 $s2 = 1 if(print IMGP2 "$r $g $b\n");
  100.                         }
  101.                         else {
  102.                                 $g = @rgbval[1]+1;
  103.                         }
  104.                 }
  105.         }
  106.  
  107.         return "PPM Base library -> [Gradient] Done." if($s2); $s2=0;
  108.         return "PPM Base library -> [Gradient] No gradient created." if(!$s2);
  109.  
  110. }
  111.  
  112. #-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  113. # Chessboard function - I've to review this..
  114. # See the image with Photoshop or GIMP!
  115. #-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  116. sub chessboard {
  117.  
  118.         $dims = shift;
  119.         @dims1 = split(" ", $dims) and $chesstype = 0;
  120.         $larg = @dims1[0];
  121.         $alte = @dims1[1];
  122.  
  123.         $larg+=1 if(int($larg)%2 eq 0);
  124.         $alte+=1 if(int($alte)%2 eq 0);
  125.  
  126.         print IMGP2 "P1\n#Chessboard created with PPM Base library :: Perl :: By SiD\n$larg $alte\n";
  127.  
  128.         for($xc=0; $xc<$larg; $xc++) {
  129.                 for($xc2=0; $xc2<$alte; $xc2++) {
  130.                         if($chesstype eq 0) {
  131.                                 $s3 = 1 if(print IMGP2 $chesstype." ");
  132.                                 $chesstype = 1;
  133.                         }
  134.                         else {
  135.                                 $s3 = 1 if(print IMGP2 $chesstype." ");
  136.                                 $chesstype = 0;
  137.                         }
  138.                 }
  139.                 print IMGP2 "\n";
  140.         }
  141.  
  142.         return "PPM Base library -> [Chess] Done." if($s3); $s3=0;
  143.         return "PPM Base library -> [Chess] No chessboard created." if(!$s3);
  144.  
  145. }
  146.  
  147. #-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  148. # Line drawer function
  149. # See the image with Photoshop or GIMP!
  150. #-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  151. sub line {
  152.  
  153.         $size = shift;
  154.         $mode = shift;
  155.         @size1 = split(" ", $size) and $linetype = 1;
  156.         $larg = @size1[0];
  157.         $alte = @size1[0];
  158.  
  159.         print IMGP2 "P1\n#Line(s) created with PPM Base library :: Perl :: By SiD\n$size $size\n";
  160.  
  161.         for($xd=0; $xd<$larg; $xd++) {
  162.                 for($xd2=0; $xd2<$alte; $xd2++) {
  163.                         if($mode eq "vertical") {
  164.                                 if($linetype eq 0) {
  165.                                         $s4 = 1 if(print IMGP2 $linetype." ");
  166.                                         $linetype = 1;
  167.                                 }
  168.                                 else {
  169.                                         $s4 = 1 if(print IMGP2 $linetype." ");
  170.                                         $linetype = 0;
  171.                                 }
  172.                         }
  173.                         elsif($mode eq "horizontal") {
  174.                                 $s4 = 1 if(print IMGP2 $linetype." ");
  175.                         }
  176.                         else {
  177.                                 die("PPM Base library -> Invalid argument (orientation) for line function.\n");
  178.                         }
  179.                 }
  180.                 if($linetype eq 0 && $mode eq "horizontal") {
  181.                         $linetype = 1;
  182.                 }
  183.                 else {
  184.                         $linetype = 0;
  185.                 }
  186.                 print IMGP2 "\n";
  187.         }
  188.  
  189.         return "PPM Base library -> [Line] Done." if($s4); $s4=0;
  190.         return "PPM Base library -> [Line] No line image created." if(!$s4);
  191.  
  192. }
  193.  
  194. #-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  195. # Granule image creator function
  196. #-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  197. sub granule {
  198.  
  199.         $dims = shift;
  200.         @dims2 = split(" ", $dims);
  201.         $larg = @dims2[0];
  202.         $alte = @dims2[1];
  203.  
  204.         print IMGP2 "P3\n#Granule image with colours created with PPM Base library :: Perl :: By SiD\n$dims\n255\n";
  205.  
  206.         for($xe=0; $xe<$larg; $xe++) {
  207.                 for($xe2=0; $xe2<$alte; $xe2++) {
  208.                         $r = int(rand(255));
  209.                         $g = int(rand(255));
  210.                         $b = int(rand(255));
  211.                         $s5 = 1 if(print IMGP2 "$r $g $b\n");
  212.                 }
  213.         }
  214.  
  215.         return "PPM Base library -> [Granule Image] Done." if($s5); $s5=0;
  216.         return "PPM Base library -> [Granule Image] No image created." if(!$s5);
  217.  
  218. }
  219.  
  220. #-=-=-=-=-=-=-=-=-=-=-=
  221. # Reverse RGB function
  222. #-=-=-=-=-=-=-=-=-=-=-=
  223. sub reverse {
  224.  
  225.         checktype();
  226.  
  227.         my $rows = 0;
  228.  
  229.         while($line = <IMGP>) {
  230.                 if($rows >= $imgtype) {
  231.                         die("Invalid PPM image header.\n") if(length($line) <= 3);
  232.                         chomp($line);
  233.                         @tempa = split(" ", $line);
  234.                         $line = "";
  235.                         for($xf=0, $xf2=scalar(@tempa); $xf<=scalar(@tempa) && $xf2>=0; $xf++, $xf2--) {
  236.                                 $line .= @tempa[$xf2]." ";
  237.                         }
  238.                         $line .= "\n";
  239.                 }
  240.                 $s6 = 1 if(print IMGP2 $line);
  241.                 $line = "" and @tempa = ();
  242.                 $rows++;
  243.         }
  244.  
  245.         return "PPM Base library -> [Reverse] Done." if($s6); $s6=0;
  246.         return "PPM Base library -> [Reverse] No RGB reversed." if(!$s6);
  247.  
  248. }
  249.  
  250. #-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  251. # Format image with tern function
  252. #-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  253. sub format {
  254.  
  255.         checktype();
  256.  
  257.         my $rows = 0;
  258.         my $rgbtern = 1;
  259.  
  260.         while($line = <IMGP>) {
  261.                 if($rows >= $imgtype) {
  262.                         chomp($line);
  263.                         $newline .= $line." ";
  264.                         if($rgbtern eq 3) {
  265.                                 $s7 = 1 if(print IMGP2 $newline."\n");
  266.                                 $newline = "", $rgbtern = 0;
  267.                         }
  268.                         $rgbtern++;
  269.                 }
  270.                 else {
  271.                         $s7 = 1 if(print IMGP2 $line);
  272.                 }
  273.                 $rows++;
  274.         }
  275.  
  276.         return "PPM Base library -> [Format] Done." if($s7); $s7=0;
  277.         return "PPM Base library -> [Format] No image formatted." if(!$s7);
  278.  
  279. }
  280.  
  281. #-=-=-=-=-=-=-=-=-=-=-=-=
  282. # Copy PPM image function
  283. #-=-=-=-=-=-=-=-=-=-=-=-=
  284. sub copy {
  285.  
  286.         while($line = <IMGP>) {
  287.                 $arows++;
  288.                 $brows++ if(print IMGP2 $line);
  289.         }
  290.  
  291.         return "PPM Base library -> [Copy] Done." if($arows eq $brows);
  292.         return "PPM Base library -> [Copy] Cannot copy the image." if($arows ne $brows);
  293.  
  294. }
  295.  
  296. #-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  297. # 180° Rotation + Reverse function
  298. #-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  299. sub reverse_180 {
  300.  
  301.         checktype();
  302.  
  303.         my $rows = 0;
  304.         my(@temp, $line);
  305.  
  306.         while($line = <IMGP>) {
  307.                 if($rows >= $imgtype) {
  308.                         die("Invalid PPM image header.\n") if(length($line) <= 3);
  309.                         chomp($line);
  310.                         @splitter = split(" ", $line);
  311.                         push(@temp, @splitter);
  312.                 }
  313.                 else {
  314.                         $s8 = 1 if(print IMGP2 $line);
  315.                 }
  316.                 $rows++;
  317.         }
  318.  
  319.         for($xg=0, $xg2=scalar(@temp); $xg<=scalar(@temp) && $xg2>=0; $xg++, $xg2--) {
  320.                 $s8 = 1 if(print IMGP2 @temp[$xg2]." ");
  321.         }
  322.  
  323.         return "PPM Base library -> [180° + Reverse] Done." if($s8); $s8=0;
  324.         return "PPM Base library -> [180° + Reverse] Cannot process the image." if(!$s8);
  325.  
  326. }
  327.  
  328. #-=-=-=-=-=-=-=-=-=-=
  329. # Noise set function
  330. #-=-=-=-=-=-=-=-=-=-=
  331. sub noise {
  332.  
  333.         checktype();
  334.  
  335.         my $num = shift;
  336.         my $rows = 0;
  337.         my(@temp, $line, $newline);
  338.  
  339.         while($line = <IMGP>) {
  340.                 if($rows >= $imgtype) {
  341.                         die("Invalid PPM image header.\n") if(length($line) <= 3);
  342.                         @splitter = split(" ", $line);
  343.                         foreach(@splitter) {
  344.                                 push(@temp, $_);
  345.                         }
  346.                         my @splitter;
  347.                 }
  348.                 else {
  349.                         $s9 = 1 if(print IMGP2 $line);
  350.                 }
  351.                 $rows++;
  352.         }
  353.  
  354.         for($xi=0; $xi<=scalar(@temp); $xi++) {
  355.                 if(int(@temp[$xi]-$num) >= 0) {
  356.                         $newline = int(@temp[$xi]-$num);
  357.                 }
  358.                 else {
  359.                         $newline = @temp[$xi];
  360.                 }
  361.                 $s9 = 1 if(print IMGP2 $newline." ");
  362.                 $newline = "";
  363.         }
  364.  
  365.         return "PPM Base library -> [Noise] Done." if($s9); $s9=0;
  366.         return "PPM Base library -> [Noise] Cannot process the image." if(!$s9);
  367.  
  368. }
  369.  
  370. #-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  371. # P6 to P3 converter function
  372. # Thanks neo for the help with P6 images ^^
  373. #-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  374. sub P6_P3 {
  375.  
  376.         checktype();
  377.  
  378.         binmode(IMGP, IMGP2);
  379.         my $rows = 0;
  380.         ($imgt eq "P6\n") ? print IMGP2 "P3\n" : die("Invalid P6 image!\n");
  381.  
  382.         while($line = <IMGP>) {
  383.                 if($rows >= $imgtype) {
  384.                         @line = split("", $line);
  385.                         foreach(@line) {
  386.                                 $s10 = 1 if(print IMGP2 ord($_)."\n");
  387.                         }
  388.                         my @line;
  389.                 }
  390.                 else {
  391.                         $s10 = 1 if(print IMGP2 $line);
  392.                 }
  393.                 $rows++;
  394.         }
  395.  
  396.         return "PPM Base library -> [Convert to P3] Done." if($s10); $s10=0;
  397.         return "PPM Base library -> [Convert to P3] Cannot convert the image." if(!$s10);
  398.  
  399. }
  400.  
  401. #-=-=-=-=-=-=-=-=
  402. # Get image type
  403. #-=-=-=-=-=-=-=-=
  404. sub checktype {
  405.  
  406.         $imgt = <IMGP>;
  407.         if($imgt ne "P6\n") {
  408.                 print IMGP2 $imgt;
  409.         }
  410.         switch($imgt) {
  411.                 case("P1\n") {
  412.                         $imgtype = 2;
  413.                 }
  414.                 case("P2\n") {
  415.                         $imgtype = 3;
  416.                 }
  417.                 case("P3\n") {
  418.                         $imgtype = 3;
  419.                 }
  420.                 case("P5\n") {
  421.                         $imgtype = 3;
  422.                 }
  423.                 case("P6\n") {
  424.                         $imgtype = 3;
  425.                 }
  426.                 else {
  427.                         die("Invalid image found!\n");
  428.                 }
  429.         }
  430.        
  431.         return $imgtype;
  432.  
  433. }
  434.  
  435. if($imgr) {
  436.         close(IMGP, IMGP2);
  437. }
  438.  
  439. 1;
  440.  
  441.  
  442. # PPM Base Library
  443. # Author: SiD
  444.  
  445. # http://sid93.wordpress.com
  446. # flybor[at]hotmail[dot]it