Added perl solution ch#62-2

1 files changed, 63 insertions, 0 deletions

diff --git a/challenge-062/yet-ebreo/perl/ch-2.pl b/challenge-062/yet-ebreo/perl/ch-2.pl
new file mode 100644
index 0000000000..46b526f963
--- /dev/null
+++ b/challenge-062/yet-ebreo/perl/ch-2.pl
@@ -0,0 +1,63 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use feature 'say';
+use Data::Dumper;
+
+my $m = $ARGV[0] || 3;
+my %qp;
+
+for my $d (1..$m) {
+    my @arr = map [(-1) x $m], 1 .. $m;
+
+    for my $r (0..$m-1) {
+        for my $c (0..$m-1) {
+            if ($arr[$r][$c] == -1) {
+                $qp{"[$r:$c]"} ? 
+                    ($arr[$r][$c] = 0) : 
+                    remove_captures(\@arr,$r,$c) 
+            }
+        }
+    }
+
+    for my $r (0..$m-1) {
+        say "@{$arr[$r]}";
+    }
+    print "\n"
+}
+
+sub remove_captures {
+    my ($arr,$r,$c) = @_;
+
+    $qp{"[$r:$c]"} = $arr->[$r][$c] = 1;
+
+    my $s = $#{$arr};
+
+    for my $x ($r+1..$s) {
+        $arr->[$x][$c] = 0;
+    }
+
+    for my $y ($c+1..$s) {
+        $arr->[$r][$y] = 0;
+    }
+
+    for my $o (0..$m-1) {
+        if ( $c+$o <= $s && $r+$o <= $s && $arr->[$r+$o][$c+$o] == -1) {
+            $arr->[$r+$o][$c+$o] = 0
+        }
+
+        if ($c+$o <= $s  && $r-$o >= 0  && $arr->[$r-$o][$c+$o] == -1) {
+            $arr->[$r-$o][$c+$o] = 0
+        }
+
+        if ($r+$o <= $s  && $c-$o >= 0  && $arr->[$r+$o][$c-$o] == -1) {
+            $arr->[$r+$o][$c-$o] = 0
+        }
+
+        if ($r-$o >= 0 && $c-$o >= 0 && $arr->[$r-$o][$c-$o] == -1) {
+            $arr->[$r-$o][$c-$o] = 0
+        }
+    }
+
+
+}
\ No newline at end of file