pastebin - collaborative debugging

pastebin is a collaborative debugging tool allowing you to share and modify code snippets while chatting on IRC, IM or a message board.

This site is developed to XHTML and CSS2 W3C standards. If you see this paragraph, your browser does not support those standards and you need to upgrade. Visit WaSP for a variety of options.

Perl pastebin - collaborative debugging tool View Help


Posted by SiD on Thu 1 Jan 09:47
report abuse | download | new post

  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

Submit a correction or amendment below (click here to make a fresh posting)
After submitting an amendment, you'll be able to view the differences between the old and new posts easily.

Syntax highlighting:

To highlight particular lines, prefix each line with @@


Remember me so that I can delete my post