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

Rename Perl 6 -> Raku, alphabetize, minor clean-up
(Added Commodore BASIC solution)
(Rename Perl 6 -> Raku, alphabetize, minor clean-up)
Line 3:
Using the data storage type defined [[Basic_bitmap_storage|on this page]] for raster images, and the <tt>draw_line</tt> function defined in [[Bresenham's_line_algorithm|this one]], draw a ''quadratic bezier curve''
([[wp:Bezier_curves#Quadratic_B.C3.A9zier_curves|definition on Wikipedia]]).
 
 
=={{header|Ada}}==
Line 54 ⟶ 53:
 
</pre>
 
=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
Line 235:
</lang>
[https://www.worldofchris.com/assets/c64-bezier-curve.png Screenshot of Bézier curve on C64]
 
 
=={{header|D}}==
Line 289 ⟶ 288:
....................
....................</pre>
 
=={{header|Factor}}==
Some code is shared with the cubic bezier task, but I put it here again to make it simple (hoping the two version don't diverge)
Same remark as with cubic bezier, the points could go into a sequence to simplify stack shuffling
<lang factor>USING: arrays kernel locals math math.functions
rosettacode.raster.storage sequences ;
IN: rosettacode.raster.line
 
! This gives a function
:: (quadratic-bezier) ( P0 P1 P2 -- bezier )
[ :> x
1 x - sq P0 n*v
2 1 x - x * * P1 n*v
x sq P2 n*v
v+ v+ ] ; inline
 
! Same code from the cubic bezier task
: t-interval ( x -- interval )
[ iota ] keep 1 - [ / ] curry map ;
: points-to-lines ( seq -- seq )
dup rest [ 2array ] 2map ;
: draw-lines ( {R,G,B} points image -- )
[ [ first2 ] dip draw-line ] curry with each ;
:: bezier-lines ( {R,G,B} P0 P1 P2 image -- )
100 t-interval P0 P1 P2 (quadratic-bezier) map
points-to-lines
{R,G,B} swap image draw-lines ;
</lang>
 
=={{header|FBSL}}==
Line 351 ⟶ 378:
END SUB</lang>
'''Output:''' [[File:FBSLBezierQuad.PNG]]
 
=={{header|Factor}}==
Some code is shared with the cubic bezier task, but I put it here again to make it simple (hoping the two version don't diverge)
Same remark as with cubic bezier, the points could go into a sequence to simplify stack shuffling
<lang factor>USING: arrays kernel locals math math.functions
rosettacode.raster.storage sequences ;
IN: rosettacode.raster.line
 
! This gives a function
:: (quadratic-bezier) ( P0 P1 P2 -- bezier )
[ :> x
1 x - sq P0 n*v
2 1 x - x * * P1 n*v
x sq P2 n*v
v+ v+ ] ; inline
 
! Same code from the cubic bezier task
: t-interval ( x -- interval )
[ iota ] keep 1 - [ / ] curry map ;
: points-to-lines ( seq -- seq )
dup rest [ 2array ] 2map ;
: draw-lines ( {R,G,B} points image -- )
[ [ first2 ] dip draw-line ] curry with each ;
:: bezier-lines ( {R,G,B} P0 P1 P2 image -- )
100 t-interval P0 P1 P2 (quadratic-bezier) map
points-to-lines
{R,G,B} swap image draw-lines ;
</lang>
 
=={{header|Fortran}}==
Line 411 ⟶ 410:
 
end subroutine quad_bezier</lang>
 
=={{header|FreeBASIC}}==
{{trans|BBC BASIC}}
Line 707:
>> disp(img)
</lang>
 
 
=={{header|OCaml}}==
Line 750 ⟶ 749:
by_pair pts (fun p0 p1 -> line ~p0 ~p1);
;;</lang>
 
=={{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 quadratic ( ($x1, $y1), ($x2, $y2), ($x3, $y3), $pix, $segments = 30 ) {
my @line-segments = map -> $t {
my \a = (1-$t)²;
my \b = $t * (1-$t) * 2;
my \c = $t²;
(a*$x1 + b*$x2 + c*$x3).round(1),(a*$y1 + b*$y2 + c*$y3).round(1)
}, (0, 1/$segments, 2/$segments ... 1);
for @line-segments.rotor(2=>-1) -> ($p1, $p2) { self.line( $p1, $p2, $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(2,2,2) );
 
my @points = (65,25), (85,380), (570,15);
 
my %seen;
my $c = 0;
for @points.permutations -> @this {
%seen{@this.reverse.join.Str}++;
next if %seen{@this.join.Str};
$b.quadratic( |@this, color(255-$c,127,$c+=80) );
}
 
@points.map: { $b.dot( $_, color(255,0,0), 3 )}
 
$*OUT.write: $b.P6;</lang>
 
See [https://github.com/thundergnat/rc/blob/master/img/Bezier-quadratic-perl6.png example image here], (converted to a .png as .ppm format is not widely supported).
 
=={{header|Phix}}==
Line 986 ⟶ 879:
bm
</lang>
 
=={{header|Raku}}==
(formerly 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 quadratic ( ($x1, $y1), ($x2, $y2), ($x3, $y3), $pix, $segments = 30 ) {
my @line-segments = map -> $t {
my \a = (1-$t)²;
my \b = $t * (1-$t) * 2;
my \c = $t²;
(a*$x1 + b*$x2 + c*$x3).round(1),(a*$y1 + b*$y2 + c*$y3).round(1)
}, (0, 1/$segments, 2/$segments ... 1);
for @line-segments.rotor(2=>-1) -> ($p1, $p2) { self.line( $p1, $p2, $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(2,2,2) );
 
my @points = (65,25), (85,380), (570,15);
 
my %seen;
my $c = 0;
for @points.permutations -> @this {
%seen{@this.reverse.join.Str}++;
next if %seen{@this.join.Str};
$b.quadratic( |@this, color(255-$c,127,$c+=80) );
}
 
@points.map: { $b.dot( $_, color(255,0,0), 3 )}
 
$*OUT.write: $b.P6;</lang>
 
See [https://github.com/thundergnat/rc/blob/master/img/Bezier-quadratic-perl6.png example image here], (converted to a .png as .ppm format is not widely supported).
 
=={{header|Ruby}}==
Line 1,050:
}
return</lang>
 
=={{header|XPL0}}==
[[File:QuadXPL0.png|right]]
10,343

edits