Advertisement
gdog2u

Perl Cloud Gen

Feb 6th, 2018
147
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 4.00 KB | None | 0 0
  1. ###########################
  2. # Author: Geoffrey Hudson
  3. # Date: 2/6/2018
  4. # Purpose: Generate a matrix of values between 0 and 1 inclusive that can be used as alpha values for cloud like patterns
  5.  
  6.  
  7. # Generate a 10x10 matrix until I get one that isn't empty
  8. do{
  9.     @matrix = &makeMatrix(10);
  10. }while(!&sumMatrix(\@matrix));
  11.  
  12. # "Cloud-ify" my matrix with 5 passes
  13. &cloudMatrix(\@matrix, 5);
  14.  
  15. # Print my matrix to STDOUT
  16. print &printMatrix(\@matrix);
  17.  
  18. ###########################
  19. # Generates a matrix with the dimensions size X size.
  20. # Each cell has an 2% chance of being 1, which are used as the seed values for future growth.
  21. sub makeMatrix{
  22.     @m = ();
  23.     $size = shift;
  24.     $size--;
  25.     for(0..$size){
  26.         my @arr = ();
  27.         for(0..$size){
  28.             $n = rand() < .02 ? 1 : 0;
  29.             push(@arr, $n);
  30.         }
  31.         splice @m, 1, 0, \@arr;
  32.     }
  33.     return @m;
  34. }
  35.  
  36. ###########################
  37. # Returns the X and Y values of a cell adjacent to the input.
  38. # $notX and $notY are given when finding a cell adjacent to the previously adjacent cell, and we do not want the starting point.
  39. # E.G.
  40. #   start = [0][4]
  41. #   adjacent = [1][4]
  42. #   adjacent2 = getadjacent(@m, 1,4,0,4) = [1][3]
  43. # Params:
  44. #       @m: the matrix
  45. #       $x: the X coord to start with
  46. #       $y: the Y coord to start with
  47. #       $notX: if given, an X value that cannot be used, elsewise set to -1
  48. #       $notY: if given, an Y value that cannot be used, elsewise set to -1
  49. sub getAdjacent{
  50.     @m = @{ $_[0] };
  51.     $x = $_[1];
  52.     $y = $_[2];
  53.     $notX = $_[3] ? $_[3] : -1;
  54.     $notY = $_[4] ? $_[4] : -1;
  55.    
  56.     $outX;
  57.     $outY;
  58.    
  59.     $attempts;
  60.     do{
  61.         # A catch to prevent endless looping. Left over from testing various while conditions. Left in just in case.
  62.         $attempts++;
  63.         if($attempts > 1000){
  64.             die "$outX: $x | $notX\n$outY: $y | $notY";
  65.         }
  66.        
  67.         do{
  68.             $outX = (int(rand(3))-1) + $x;
  69.         }while($outX < 0 || $outX >= scalar @m);
  70.         do{
  71.             $outY = (int(rand(3))-1) + $y;
  72.         }while($outY < 0 || $outY >= scalar @{ $m[$x] });
  73.     }while(($outX == $x && $outX == $notX) && ($outY == $y && $outY == $notY));
  74.    
  75.     return ($outX, $outY);
  76. }
  77.  
  78. ###########################
  79. # Finds the higher of two numbers.
  80. # Params:
  81. #       $n1: any given number
  82. #       $n2: any other given number
  83. sub getMinMax{
  84.     $n1 = shift;
  85.     $n2 = shift;
  86.    
  87.     if($n1 <= $n2){
  88.         return ($n1, $n2);
  89.     }
  90.     else{
  91.         return($n2, $n1);
  92.     }
  93. }
  94.  
  95. ###########################
  96. # Given a matrix, iterate over it $rounds times.
  97. # Simple Steps:
  98. #   1. Iterate through the rows
  99. #   2. In each row, check each cell
  100. #   3. If a cell != 0, find an adjacent cell
  101. #   4. Find a cell that is adjacent to the previously found adjacent cell, that is not the parent cell
  102. #   5. Set the value of the first adjacent cell to a value between the parent cell, and the second adjacent cell
  103. #       such that the value is greater than 0, and less than 1
  104. # Params:
  105. #       @m: a matrix
  106. #       $rounds: the number of times to go over the matrix
  107. sub cloudMatrix{
  108.     @m = @{ $_[0] };
  109.     $rounds = $_[1]-1;
  110.    
  111.     for(0..$rounds){
  112.         for($i=0;$i<scalar @m;$i++){
  113.             for($j=0;$j<scalar @{ $m[$i] }; $j++){
  114.                 if($m[$i][$j] != 0){
  115.                     ($k, $l) = &getAdjacent(\@m, $i, $j);
  116.                     if($m[$k][$l] != 0) { next; }
  117.                     ($m, $n) = &getAdjacent(\@m, $k, $l, $i, $j);
  118.                     ($min, $max) = &getMinMax($m[$m][$n], $m[$i][$j]);
  119.                     if($min == $max){
  120.                         $newVal = $min;
  121.                     }else{
  122.                         $attempts = 0;
  123.                         do{
  124.                             $newVal = sprintf('%.1f', rand($max)+($min+.004));
  125.                             $attempts++;
  126.                         }while($newVal > 1);
  127.                     }
  128.                     $m[$k][$l] = $newVal;
  129.                 }
  130.             }
  131.         }
  132.     }
  133. }
  134.  
  135. ###########################
  136. # Returns the sum of the matrix.
  137. # Used to ensure I'm not getting empty arrays.
  138. sub sumMatrix{
  139.     return eval join "+", map { join "+", @{ $_ }} @{ $_[0] };
  140. }
  141.  
  142. ###########################
  143. # prints the array in such a way that I can easily split it for javascript array later.
  144. # Params:
  145. #       @m: the matrix to print
  146. sub printMatrix{
  147.     @m = @{ $_[0] };
  148.     foreach $row (@m){
  149.         @r = @{ $row };
  150.         foreach $cell (@r){
  151.             $cell = sprintf('%.1f', $cell);
  152.             $s .= "$cell,";
  153.         }
  154.         $s =~ s/,$/\n/;
  155.     }
  156.     return $s;
  157. }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement