37 lines
824 B
Raku
37 lines
824 B
Raku
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);
|