Data commit

Task/Greyscale-bars-Display/Perl/greyscale-bars-display.pl

@@ -0,0 +1,37 @@
+sub partition {
+    my($all, $div) = @_;
+    my @marks = 0;
+    push @marks, $_/$div * $all for 1..$div;
+    my @copy = @marks;
+    $marks[$_] -= $copy[$_-1] for 1..$#marks;
+    @marks[1..$#marks];
+}
+
+sub bars {
+    my($h,$w,$p,$rev) = @_;
+    my (@nums,@vals,$line,$d);
+
+    $d  = 2**$p;
+    push @nums, int $_/($d-1) * (2**16-1) for $rev ? reverse 0..$d-1 : 0..$d-1;
+    push @vals, ($nums[$_]) x (partition($w, $d))[$_] for 0..$#nums;
+    $line = join(' ', @vals) . "\n";
+    $line x $h;
+}
+
+my($w,$h) = (1280,768);
+open my $pgm, '>', 'Greyscale-bars-perl5.pgm' or die "Can't create Greyscale-bars-perl5.pgm: $!";
+
+print $pgm <<"EOH";
+P2
+# Greyscale-bars-perl5.pgm
+$w $h
+65535
+EOH
+
+my ($h1,$h2,$h3,$h4) = partition($h,4);
+
+print $pgm
+    bars($h1,$w,3,0),
+    bars($h2,$w,4,1),
+    bars($h3,$w,5,0),
+    bars($h4,$w,6,1);