Color wheel

From Rosetta Code
Revision as of 23:53, 22 August 2016 by Thundergnat (talk | contribs) (→‎{{header|Perl 6}}: Add Perl 6 entry)
Color wheel is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.
Task

Write a function to draw a color wheel completely with code. This is strictly for learning purposes only. It's highly recommended that you use an image in an actual application to actually draw the color wheel as procedurally drawing this is super slow. This does help you understand how color wheels work and this can easily be used to determine a color value based on a position within a circle.


GML

<lang GML> for (var i = 1; i <= 360; i++) {

   for (var j = 0; j < 255; j++) {
       var hue = 255*(i/360);
       var saturation = j;
       var value = 255;
       var c = make_colour_hsv(hue,saturation,value);
       
       //size of circle determined by how far from the center it is
       //if you just draw them too small the circle won't be full. 
       //it will have patches inside it that didn't get filled in with color
       var r = max(1,3*(j/255));
       //Math for built-in GMS functions
       //lengthdir_x(len,dir) = +cos(degtorad(direction))*length;
       //lengthdir_y(len,dir) = -sin(degtorad(direction))*length;
       draw_circle_colour(x+lengthdir_x(m_radius*(j/255),i),y+lengthdir_y(m_radius*(j/255),i),r,c,c,false);
   }

} </lang>


Perl 6

Works with: Rakudo version 2016.08

<lang perl6>use Image::PNG::Portable;

my ($w, $h) = 300, 300;

my $out = Image::PNG::Portable.new: :width($w), :height($h);

my $center = $w/2 + $h/2*i;

color-wheel($out);

$out.write: 'Color-wheel-perl6.png';

sub color-wheel ( $png ) {

   for ^$w -> $x {
       for ^$h -> $y {
           my $point = $center - ($x + $y*i);
           my $mag = 2 * $point.abs;
           $png.set: $x, $y, |hsv2rgb( $point.&c2p, $mag / $w, so $mag < $w );
       }
   }

}

sub c2p ($xy) { # complex to polar angle scaled 0 to 2π

   ( π + atan2($xy.re, $xy.im) ) / τ

}

sub hsv2rgb ( $h, $s, $v ){ # inputs normalized 0-1

   my $c = $v * $s;
   my $x = $c * (1 - abs( (($h*6) % 2) - 1 ) );
   my $m = $v - $c;
   my ($r, $g, $b) = do given $h {
       when   0..^(1/6) { $c, $x, 0 }
       when 1/6..^(1/3) { $x, $c, 0 }
       when 1/3..^(1/2) { 0, $c, $x }
       when 1/2..^(2/3) { 0, $x, $c }
       when 2/3..^(5/6) { $x, 0, $c }
       when 5/6..1      { $c, 0, $x }
   }
   ( $r, $g, $b ) = map { (($_+$m) * 255).Int }, $r, $g, $b;

}</lang>

Until local image uploading is re-enabled, see Color-wheel-perl6.png