1package Prima::Drawable::Gradient; 2 3use strict; 4use warnings; 5 6sub new 7{ 8 my ( $class, $canvas, %opt) = @_; 9 bless { 10 canvas => $canvas, 11 palette => [ cl::White, cl::Black ], 12 %opt 13 }, $class; 14} 15 16sub clone 17{ 18 my ( $self, %opt ) = @_; 19 return ref($self)->new( undef, %$self, %opt ); 20} 21 22sub canvas { shift->{canvas} } 23sub palette { shift->{palette} } 24 25sub polyline_to_points 26{ 27 my ($self, $p) = @_; 28 my @map; 29 for ( my $i = 0; $i < @$p - 2; $i+=2) { 30 my ($x1,$y1,$x2,$y2) = @$p[$i..$i+3]; 31 $x1 = 0 if $x1 < 0; 32 my $dx = $x2 - $x1; 33 if ( $dx > 0 ) { 34 my $dy = ($y2 - $y1) / $dx; 35 my $y = $y1; 36 for ( my $x = int($x1); $x <= int($x2); $x++) { 37 $map[$x] = $y; 38 $y += $dy; 39 } 40 } else { 41 $map[int($x1)] = $y1; 42 } 43 } 44 return \@map; 45} 46 47sub stripes 48{ 49 my ( $self, $breadth) = @_; 50 51 my ($offsets, $points); 52 53 unless ($points = $self->{points}) { 54 my @spline = (0,0); 55 if ( my $s = $self->{spline} ) { 56 push @spline, map { $_ * $breadth } @$s; 57 } 58 if ( my $s = $self->{poly} ) { 59 push @spline, map { $_ * $breadth } @$s; 60 } 61 push @spline, $breadth, $breadth; 62 my $polyline = ( @spline > 4 && $self->{spline} ) ? Prima::Drawable-> render_spline( \@spline ) : \@spline; 63 $points = $self-> polyline_to_points($polyline); 64 } 65 66 67 unless ( $offsets = $self->{offsets}) { 68 my @o; 69 my $n = scalar(@{$self->{palette}}) - 1; 70 my $d = 0; 71 for ( my $i = 0; $i < $n; $i++) { 72 $d += 1/$n; 73 push @o, $d; 74 } 75 push @o, 1; 76 $offsets = \@o; 77 } 78 79 return $self-> calculate( 80 $self->{palette}, 81 [ map { $_ * $breadth } @$offsets ], 82 sub { $points->[shift] } 83 ); 84} 85 86sub colors 87{ 88 my ( $self, $breadth) = @_; 89 90 my $stripes = $self->stripes($breadth); 91 my @colors; 92 for ( my $i = 0; $i < @$stripes; $i+=2 ) { 93 push @colors, $stripes->[$i] for 1 .. $stripes->[$i+1]; 94 } 95 return @colors; 96} 97 98sub map_color 99{ 100 my ( $self, $color ) = @_; 101 return $color unless $color & cl::SysFlag; 102 $color |= 103 $self->{widgetClass} // 104 (( $self->{canvas} && $self->{canvas}->isa('Prima::Widget')) ? $self->{canvas}->widgetClass : undef ) // 105 wc::Undef 106 unless $color & wc::Mask; 107 return $::application->map_color($color); 108} 109 110sub calculate_single 111{ 112 my ( $self, $breadth, $start_color, $end_color, $function, $offset ) = @_; 113 114 return if $breadth <= 0; 115 116 $offset //= 0; 117 $start_color = $self-> map_color( $start_color); 118 $end_color = $self-> map_color( $end_color); 119 my @start = cl::to_rgb($start_color); 120 my @end = cl::to_rgb($end_color); 121 my @color = @start; 122 return $start_color, 1 if $breadth == 1; 123 124 my @delta = map { ( $end[$_] - $start[$_] ) / ($breadth - 1) } 0..2; 125 126 my $last_color = $start_color; 127 my $color = $start_color; 128 my $width = 0; 129 my @ret; 130 for ( my $i = 0; $i < $breadth; $i++) { 131 my @c; 132 my $j = $function ? $function->( $offset + $i ) - $offset : $i; 133 for ( 0..2 ) { 134 $color[$_] = $start[$_] + $j * $delta[$_] for 0..2; 135 $c[$_] = int($color[$_] + .5); 136 $c[$_] = 0xff if $c[$_] > 0xff; 137 $c[$_] = 0 if $c[$_] < 0; 138 } 139 $color = ( $c[0] << 16 ) | ( $c[1] << 8 ) | $c[2]; 140 if ( $last_color != $color ) { 141 push @ret, $last_color, $width; 142 $last_color = $color; 143 $width = 0; 144 } 145 146 $width++; 147 } 148 149 return @ret, $color, $width; 150} 151 152sub calculate 153{ 154 my ( $self, $palette, $offsets, $function ) = @_; 155 my @ret; 156 my $last_offset = 0; 157 $offsets = [ $offsets ] unless ref $offsets; 158 for ( my $i = 0; $i < @$offsets; $i++) { 159 my $breadth = $offsets->[$i] - $last_offset; 160 push @ret, $self-> calculate_single( $breadth, $palette->[$i], $palette->[$i+1], $function, $last_offset); 161 $last_offset = $offsets->[$i]; 162 } 163 return \@ret; 164} 165 166sub bar 167{ 168 my ( $self, $x1, $y1, $x2, $y2, $vertical ) = @_; 169 170 $_ = int($_) for $x1, $y1, $x2, $y2; 171 172 ($x1,$x2)=($x2,$x1) if $x1 > $x2; 173 ($y1,$y2)=($y2,$y1) if $y1 > $y2; 174 175 $vertical //= $self->{vertical}; 176 my $stripes = $self-> stripes( 177 $vertical ? 178 $x2 - $x1 + 1 : 179 $y2 - $y1 + 1 180 ); 181 182 my @bar = ($x1,$y1,$x2,$y2); 183 my ($ptr1,$ptr2) = $vertical ? (0,2) : (1,3); 184 my $max = $bar[$ptr2]; 185 my $canvas = $self->canvas; 186 for ( my $i = 0; $i < @$stripes; $i+=2) { 187 $bar[$ptr2] = $bar[$ptr1] + $stripes->[$i+1] - 1; 188 $canvas->color( $stripes->[$i]); 189 $canvas->bar( @bar ); 190 $bar[$ptr1] = $bar[$ptr2] + 1; 191 last if $bar[$ptr1] > $max; 192 } 193 if ( $bar[$ptr1] <= $max ) { 194 $bar[$ptr2] = $max; 195 $canvas->bar(@bar); 196 } 197} 198 199sub ellipse 200{ 201 my ( $self, $x, $y, $dx, $dy ) = @_; 202 return if $dx <= 0 || $dy <= 0; 203 204 $_ = int($_) for $x, $y, $dx, $dy; 205 my $diameter = ($dx > $dy) ? $dx : $dy; 206 my $mx = $dx / $diameter; 207 my $my = $dy / $diameter; 208 my $stripes = $self-> stripes( $diameter); 209 my $canvas = $self->canvas; 210 for ( my $i = 0; $i < @$stripes; $i+=2) { 211 $canvas->color( $stripes->[$i]); 212 $canvas->fill_ellipse( $x, $y, $mx * $diameter, $my * $diameter ); 213 $diameter -= $stripes->[$i+1]; 214 } 215} 216 217sub sector 218{ 219 my ( $self, $x, $y, $dx, $dy, $start, $end ) = @_; 220 my $angle = $end - $start; 221 $angle += 360 while $angle < 0; 222 $angle %= 720; 223 $angle -= 360 if $angle > 360; 224 my $min_angle = 1.0 / 64; # x11 limitation 225 226 my $max = ($dx < $dy) ? $dy : $dx; 227 my $df = $max * 3.14 / 360; 228 my $arclen = int($df * $angle + .5); 229 my $stripes = $self-> stripes( $arclen ); 230 my $accum = 0; 231 my $canvas = $self->canvas; 232 for ( my $i = 0; $i < @$stripes - 2; $i+=2) { 233 $canvas->color( $stripes->[$i]); 234 my $d = $stripes->[$i+1] / $df; 235 if ( $accum + $d < $min_angle ) { 236 $accum += $d; 237 next; 238 } 239 $d += $accum; 240 $accum = 0; 241 $canvas->fill_sector( $x, $y, $dx, $dy, $start, $start + $d + $min_angle); 242 $start += $d; 243 } 244 if ( @$stripes ) { 245 $canvas->color( $stripes->[-2]); 246 $canvas->fill_sector( $x, $y, $dx, $dy, $start, $end); 247 } 248} 249 2501; 251 252=pod 253 254=head1 NAME 255 256Prima::Drawable::Gradient - gradient fills for primitives 257 258=head1 DESCRIPTION 259 260Prima offers primitive gradient services to draw gradually changing colors. 261A gradient is requested by setting of at least two colors and optionally 262a set of quadratic spline points that, when, projected, generate the transition curve 263between the colors. 264 265The module augments the C<Prima::Drawable> drawing functionality by 266adding C<new_gradient> function. 267 268=head1 SYNOPSIS 269 270 $canvas-> new_gradient( 271 palette => [ cl::White, cl::Blue, cl::White ], 272 )-> sector(50,50,100,100,0,360); 273 274=for podview <img src="Prima/gradient.gif"> 275 276=for html <p><img src="https://raw.githubusercontent.com/dk/Prima/master/pod/Prima/gradient.gif"> 277 278=head1 API 279 280=head2 Methods 281 282=over 283 284=item new $CANVAS, %OPTIONS 285 286Here are %OPTIONS understood in the gradient request: 287 288=over 289 290=item clone %OPTIONS 291 292Creates a new gradient object with %OPTIONS replaced. 293 294=item widgetClass INTEGER 295 296Points to a widget class to resolve generic colors like C<cl::Back>, 297that may differ from widget class to widget class. 298 299=item palette @COLORS 300 301Each color is a C<cl::> value. The gradient is calculated as polyline where 302each its vertex corresponds to a certain blend between two neighbouring colors 303in the palette. F.ex. the simplest palette going from C<cl::White> to 304C<cl::Black> over a polyline C<0..1> (default), produces pure white color at 305the start and pure black color at the end, filling all available shades of gray 306in between, and changing monotonically. 307 308=item poly @VERTICES 309 310Set of 2-integer polyline vertexes where the first integer is a coordinate (x, 311y, or whatever required by the drawing primitive) between 0 and 1, and the 312second is the color blend value between 0 and 1. 313 314Default: ((0,0),(1,1)) 315 316=item spline \@VERTICES, %OPTIONS 317 318Serving same purpose as C<poly> but vertexes are projected first to a B-spline 319curve using L<render_spline> and C<%OPTIONS>. The resulting polyline is treated 320as C<poly>. 321 322=item vertical BOOLEAN 323 324Only used in L<bar>, to set gradient direction. 325 326=back 327 328See also: L<bar>, L<stripes> . 329 330=item bar X1, Y1, X2, Y2, VERTICAL = 0 331 332Draws a filled rectangle within (X1,Y1) - (X2,Y2) extents 333 334Context used: fillPattern, rop, rop2 335 336=item colors BREADTH 337 338Returns a list of gradient colors for each step from 1 to BREADTH. 339 340=item ellipse X, Y, DIAM_X, DIAM_Y 341 342Draws a filled ellipse with center in (X,Y) and diameters (DIAM_X,DIAM_Y) 343 344Context used: fillPattern, rop, rop2 345 346=item sector X, Y, DIAM_X, DIAM_Y, START_ANGLE, END_ANGLE 347 348Draws a filled sector with center in (X,Y) and diameters (DIAM_X,DIAM_Y) from START_ANGLE to END_ANGLE 349 350Context used: fillPattern, rop, rop2 351 352=item stripes BREADTH 353 354Returns an array consisting of integer pairs, where the first one is 355a color value, and the second is the breadth of the color strip. 356L<bar> uses this information to draw a gradient fill, where 357each color strip is drawn with its own color. Can be used for implementing 358other gradient-aware primitives (see F<examples/f_fill.pl> ) 359 360=back 361 362=head1 AUTHOR 363 364Dmitry Karasik, E<lt>dmitry@karasik.eu.orgE<gt>. 365 366=head1 SEE ALSO 367 368L<Prima::Drawable>, F<examples/f_fill.pl>, F<examples/gradient.pl> 369 370=cut 371