Bitmap/Bézier curves/Cubic: Difference between revisions

=={{header|Perl 6}}==

{{works with|Rakudo|2017.09}}

Uses pieces from [[Bitmap#Perl_6| Bitmap]], and [[Bitmap/Bresenham's_line_algorithm#Perl_6| Bresenham's line algorithm]] tasks. They are included here to make a complete, runnable program.

<lang perl6>class Pixel { has UInt ($.R, $.G, $.B) }

class Bitmap {

has UInt ($.width, $.height);

has Pixel @!data;

method fill(Pixel $p) {

@!data = $p.clone xx ($!width*$!height)

}

method pixel(

$i where ^$!width,

$j where ^$!height

--> Pixel

) is rw { @!data[$i + $j * $!width] }

method set-pixel ($i, $j, Pixel $p) {

return if $j >= $!height;

self.pixel($i, $j) = $p.clone;

}

method get-pixel ($i, $j) returns Pixel {

self.pixel($i, $j);

}

method line($x0 is copy, $y0 is copy, $x1 is copy, $y1 is copy, $pix) {

my $steep = abs($y1 - $y0) > abs($x1 - $x0);

if $steep {

($x0, $y0) = ($y0, $x0);

($x1, $y1) = ($y1, $x1);

}

if $x0 > $x1 {

($x0, $x1) = ($x1, $x0);

($y0, $y1) = ($y1, $y0);

}

my $Δx = $x1 - $x0;

my $Δy = abs($y1 - $y0);

my $error = 0;

my $Δerror = $Δy / $Δx;

my $y-step = $y0 < $y1 ?? 1 !! -1;

my $y = $y0;

for $x0 .. $x1 -> $x {

if $steep {

self.set-pixel($y, $x, $pix);

} else {

self.set-pixel($x, $y, $pix);

}

$error += $Δerror;

if $error >= 0.5 {

$y += $y-step;

$error -= 1.0;

}

}

}

method dot ($px, $py, $pix, $radius = 2) {

for $px - $radius .. $px + $radius -> $x {

for $py - $radius .. $py + $radius -> $y {

self.set-pixel($x, $y, $pix) if ( $px - $x + ($py - $y) * i ).abs <= $radius;

}

}

}

method cubic ( $x1, $y1, $x2, $y2, $x3, $y3, $x4, $y4, $pix, $segments = 30 ) {

my @line-segments = map -> $t {

my \a = (1-$t)³;

my \b = $t * (1-$t)² * 3;

my \c = $t² * (1-$t) * 3;

my \d = $t³;

(a*$x1 + b*$x2 + c*$x3 + d*$x4).round(1),(a*$y1 + b*$y2 + c*$y3 + d*$y4).round(1)

}, (0, 1/$segments, 2/$segments ... 1);

for @line-segments.rotor(2=>-1) -> (($x1,$y1),($x2,$y2)){ self.line($x1,$y1,$x2,$y2, $pix) };

}

method data { @!data }

}

role PPM {

method P6 returns Blob {

"P6\n{self.width} {self.height}\n255\n".encode('ascii')

~ Blob.new: flat map { .R, .G, .B }, self.data

}

}

sub color( $r, $g, $b) { Pixel.new(R => $r, G => $g, B => $b) }

my Bitmap $b = Bitmap.new( width => 600, height => 400) but PPM;

$b.fill( color(62,63,63) );

my @points = (55,390, 5,5, 580,370, 570,10);

$b.cubic( |@points, color(255,0,255) );

@points.map: { $b.dot( $^x, $^y, color(255,0,0) )}

$*OUT.write: $b.P6;</lang>

See [https://github.com/thundergnat/rc/blob/master/img/Bezier-cubic-perl6.png example image here], (converted to a .png as .ppm format is not widely supported).