1package Image::Caa; 2 3use strict; 4use warnings; 5 6our $VERSION = '1.01'; 7 8# dark colors 9use constant CAA_COLOR_BLACK => 0; 10use constant CAA_COLOR_RED => 1; 11use constant CAA_COLOR_GREEN => 2; 12use constant CAA_COLOR_YELLOW => 3; 13use constant CAA_COLOR_BLUE => 4; 14use constant CAA_COLOR_MAGENTA => 5; 15use constant CAA_COLOR_CYAN => 6; 16use constant CAA_COLOR_LIGHTGRAY => 7; 17 18# light colors 19use constant CAA_COLOR_DARKGRAY => 8; 20use constant CAA_COLOR_LIGHTRED => 9; 21use constant CAA_COLOR_LIGHTGREEN => 10; 22use constant CAA_COLOR_BROWN => 11; 23use constant CAA_COLOR_LIGHTBLUE => 12; 24use constant CAA_COLOR_LIGHTMAGENTA => 13; 25use constant CAA_COLOR_LIGHTCYAN => 14; 26use constant CAA_COLOR_WHITE => 15; 27 28use constant CAA_LOOKUP_VAL => 32; 29use constant CAA_LOOKUP_SAT => 32; 30use constant CAA_LOOKUP_HUE => 16; 31 32use constant CAA_HSV_XRATIO => 6; 33use constant CAA_HSV_YRATIO => 3; 34use constant CAA_HSV_HRATIO => 3; 35 36 37sub new { 38 my $class = shift; 39 my %opts = @_; 40 my $opts = \%opts; 41 42 my $self = bless {}, $class; 43 44 $self->{driver} = $self->load_submodule($opts->{driver} || 'DriverANSI', $opts); 45 $self->{dither} = $self->load_submodule($opts->{dither} || 'DitherNone', $opts); 46 $self->{solid_background} = $opts->{black_bg} ? 0 : 1; 47 48 $self->{hsv_palette} = [ 49 # weight, hue, saturation, value 50 4, 0x0, 0x0, 0x0, # black 51 5, 0x0, 0x0, 0x5ff, # 30% 52 5, 0x0, 0x0, 0x9ff, # 70% 53 4, 0x0, 0x0, 0xfff, # white 54 3, 0x1000, 0xfff, 0x5ff, # dark yellow 55 2, 0x1000, 0xfff, 0xfff, # light yellow 56 3, 0x0, 0xfff, 0x5ff, # dark red 57 2, 0x0, 0xfff, 0xfff # light red 58 ]; 59 60 $self->init(); 61 62 return $self; 63} 64 65 66sub init { 67 my ($self) = @_; 68 69 $self->{hsv_distances} = []; 70 71 for (my $v = 0; $v < CAA_LOOKUP_VAL; $v++){ 72 for (my $s = 0; $s < CAA_LOOKUP_SAT; $s++){ 73 for (my $h = 0; $h < CAA_LOOKUP_HUE; $h++){ 74 75 my $val = 0xfff * $v / (CAA_LOOKUP_VAL - 1); 76 my $sat = 0xfff * $s / (CAA_LOOKUP_SAT - 1); 77 my $hue = 0xfff * $h / (CAA_LOOKUP_HUE - 1); 78 79 # Initialise distances to the distance between pure black HSV 80 # coordinates and our white colour (3) 81 82 my $outbg = 3; 83 my $outfg = 3; 84 my $distbg = $self->HSV_DISTANCE(0, 0, 0, 3); 85 my $distfg = $self->HSV_DISTANCE(0, 0, 0, 3); 86 87 88 # Calculate distances to eight major colour values and store the 89 # two nearest points in our lookup table. 90 91 for (my $i = 0; $i < 8; $i++){ 92 93 my $dist = $self->HSV_DISTANCE($hue, $sat, $val, $i); 94 95 if ($dist <= $distbg){ 96 97 $outfg = $outbg; 98 $distfg = $distbg; 99 $outbg = $i; 100 $distbg = $dist; 101 102 }elsif ($dist <= $distfg){ 103 104 $outfg = $i; 105 $distfg = $dist; 106 } 107 } 108 109 $self->{hsv_distances}->[$v]->[$s]->[$h] = ($outfg << 4) | $outbg; 110 } 111 } 112 } 113} 114 115sub init_instance { 116 my ($self) = @_; 117 118 $self->{lookup_colors} = []; 119 120 # These ones are constant 121 $self->{lookup_colors}->[0] = CAA_COLOR_BLACK; 122 $self->{lookup_colors}->[1] = CAA_COLOR_DARKGRAY; 123 $self->{lookup_colors}->[2] = CAA_COLOR_LIGHTGRAY; 124 $self->{lookup_colors}->[3] = CAA_COLOR_WHITE; 125 126 # These ones will be overwritten 127 $self->{lookup_colors}->[4] = CAA_COLOR_MAGENTA; 128 $self->{lookup_colors}->[5] = CAA_COLOR_LIGHTMAGENTA; 129 $self->{lookup_colors}->[6] = CAA_COLOR_RED; 130 $self->{lookup_colors}->[7] = CAA_COLOR_LIGHTRED; 131} 132 133# 134# Draw a bitmap on the screen. 135# 136# Draw a bitmap at the given coordinates. The bitmap can be of any size and 137# will be stretched to the text area. 138# 139# x1 X coordinate of the upper-left corner of the drawing area. 140# y1 Y coordinate of the upper-left corner of the drawing area. 141# x2 X coordinate of the lower-right corner of the drawing area. 142# y2 Y coordinate of the lower-right corner of the drawing area. 143# image Image Magick picture object to be drawn. 144# 145 146sub draw_bitmap{ 147 my ($self, $x1, $y1, $x2, $y2, $image) = @_; 148 149 my $w = $x2-$x1; 150 my $h = $y2-$y1; 151 152 my $iw = 0; 153 my $ih = 0; 154 my $h_pad = 0; 155 my $v_pad = 0; 156 157 if (defined $image){ 158 159 # resize to fit in the box 160 161 $image->Scale('100%,67%'); 162 my $x = $image->Resize(geometry => ($w-2).'x'.($h-2)); 163 warn "$x" if "$x"; 164 165 ($iw, $ih) = $image->Get('columns', 'rows'); 166 167 $h_pad = 1 + int(($w - $iw) / 2); 168 $v_pad = 1 + int(($h - $ih) / 2); 169 } 170 171 $self->init_instance(); 172 $self->{driver}->init(); 173 174 175 # Only used when background is black 176 177 my $white_colors = [ 178 CAA_COLOR_BLACK, 179 CAA_COLOR_DARKGRAY, 180 CAA_COLOR_LIGHTGRAY, 181 CAA_COLOR_WHITE, 182 ]; 183 184 my $light_colors = [ 185 CAA_COLOR_LIGHTMAGENTA, 186 CAA_COLOR_LIGHTRED, 187 CAA_COLOR_YELLOW, 188 CAA_COLOR_LIGHTGREEN, 189 CAA_COLOR_LIGHTCYAN, 190 CAA_COLOR_LIGHTBLUE, 191 CAA_COLOR_LIGHTMAGENTA, 192 ]; 193 194 my $dark_colors = [ 195 CAA_COLOR_MAGENTA, 196 CAA_COLOR_RED, 197 CAA_COLOR_BROWN, 198 CAA_COLOR_GREEN, 199 CAA_COLOR_CYAN, 200 CAA_COLOR_BLUE, 201 CAA_COLOR_MAGENTA, 202 ]; 203 204 205 # FIXME: choose better characters! 206 207 my $density_chars = 208 " ". 209 ". ". 210 ".. ". 211 "....". 212 "::::". 213 ";=;=". 214 "tftf". 215 '%$%$'. 216 "&KSZ". 217 "WXGM". 218 '@@@@'. 219 "8888". 220 "####". 221 "????"; 222 223 my @density_chars = split //, $density_chars; 224 $density_chars = \@density_chars; 225 226 my $density_chars_size = scalar(@{$density_chars}) - 1; 227 228 my $x = 0; 229 my $y = 0; 230 my $deltax = 0; 231 my $deltay = 0; 232 233 234 my $tmp; 235 if ($x1 > $x2){ $tmp = $x2; $x2 = $x1; $x1 = $tmp; } 236 if ($y1 > $y2){ $tmp = $y2; $y2 = $y1; $y1 = $tmp; } 237 238 $deltax = $x2 - $x1 + 1; 239 $deltay = $y2 - $y1 + 1; 240 241 242 for ($y = $y1 > 0 ? $y1 : 0; $y <= $y2; $y++){ 243 $self->{dither}->init($y); 244 for ($x = $x1 > 0 ? $x1 : 0; $x <= $x2; $x++){ 245 246 my $ch = 0; 247 my $r = 0; 248 my $g = 0; 249 my $b = 0; 250 my $a = 0; 251 my $hue = 0; 252 my $sat = 0; 253 my $val = 0; 254 my $fromx = 0; 255 my $fromy = 0; 256 my $tox = 0; 257 my $toy = 0; 258 my $myx = 0; 259 my $myy = 0; 260 my $dots = 0; 261 my $outfg = 0; 262 my $outbg = 0; 263 my $outch = chr 0; 264 265 # First get RGB 266 267 if (defined $image){ 268 269 my $px = ($x - $x1) - $h_pad; 270 my $py = ($y - $y1) - $v_pad; 271 272 my $to_l = $px < 0; 273 my $to_t = $py < 0; 274 my $to_r = $px >= $iw; 275 my $to_b = $py >= $ih; 276 277 if ($to_l || $to_t || $to_r || $to_b){ 278 279 $r = 0xfff; 280 $g = 0xfff; 281 $b = 0xfff; 282 283 }else{ 284 285 ($r, $g, $b, $a) = split /,/, $image->Get("pixel[$px,$py]"); 286 287 $r >>= 4; 288 $g >>= 4; 289 $b >>= 4; 290 } 291 292 #if (bitmap->has_alpha && a < 0x800) continue; 293 294 # Now get HSV from RGB 295 ($hue, $sat, $val) = $self->rgb2hsv_default($r, $g, $b); 296 297 }else{ 298 299 $hue = int(0x5fff * (($x-$x1) / ($x2-$x1))); 300 $sat = int(0xfff * (($y-$y1) / ($y2-$y1))); 301 $val = int(0xfff * (($y-$y1) / ($y2-$y1))); 302 $val = 0x777; 303 } 304 305 306 # The hard work: calculate foreground and background colours, 307 # as well as the most appropriate character to output. 308 309 if ($self->{solid_background}){ 310 311 my $point = chr 0; 312 my $distfg = 0; 313 my $distbg = 0; 314 315 $self->{lookup_colors}->[4] = $dark_colors->[1 + $hue / 0x1000]; 316 $self->{lookup_colors}->[5] = $light_colors->[1 + $hue / 0x1000]; 317 $self->{lookup_colors}->[6] = $dark_colors->[$hue / 0x1000]; 318 $self->{lookup_colors}->[7] = $light_colors->[$hue / 0x1000]; 319 320 my $idx_v = ($val + $self->{dither}->get() * (0x1000 / CAA_LOOKUP_VAL) / 0x100) * (CAA_LOOKUP_VAL - 1) / 0x1000; 321 my $idx_s = ($sat + $self->{dither}->get() * (0x1000 / CAA_LOOKUP_SAT) / 0x100) * (CAA_LOOKUP_SAT - 1) / 0x1000; 322 my $idx_h = (($hue & 0xfff) + $self->{dither}->get() * (0x1000 / CAA_LOOKUP_HUE) / 0x100) * (CAA_LOOKUP_HUE - 1) / 0x1000; 323 324 $point = $self->{hsv_distances}->[$idx_v]->[$idx_s]->[$idx_h]; 325 326 $distfg = $self->HSV_DISTANCE($hue % 0xfff, $sat, $val, ($point >> 4)); 327 $distbg = $self->HSV_DISTANCE($hue % 0xfff, $sat, $val, ($point & 0xf)); 328 329 # Sanity check due to the lack of precision in hsv_distances, 330 # and distbg can be > distfg because of dithering fuzziness. 331 332 if ($distbg > $distfg){ $distbg = $distfg; } 333 334 $outfg = $self->{lookup_colors}->[($point >> 4)]; 335 $outbg = $self->{lookup_colors}->[($point & 0xf)]; 336 337 $ch = $distbg * 2 * ($density_chars_size - 1) / ($distbg + $distfg); 338 $ch = 4 * $ch + $self->{dither}->get() / 0x40; 339 340 if ($ch >= scalar(@{$density_chars})){ 341 342 $ch = scalar(@{$density_chars}) - 1; 343 } 344 345 $outch = $density_chars->[$ch]; 346 347 }else{ 348 349 $outbg = CAA_COLOR_BLACK; 350 351 if ($sat < 0x200 + $self->{dither}->get() * 0x8){ 352 353 $outfg = $white_colors->[1 + ($val * 2 + $self->{dither}->get() * 0x10) / 0x1000]; 354 355 }elsif ($val > 0x800 + $self->{dither}->get() * 0x4){ 356 357 $outfg = $light_colors->[($hue + $self->{dither}->get() * 0x10) / 0x1000]; 358 359 }else{ 360 $outfg = $dark_colors->[($hue + $self->{dither}->get() * 0x10) / 0x1000]; 361 } 362 363 $ch = ($val + 0x2 * $self->{dither}->get()) * 10 / 0x1000; 364 $ch = 4 * $ch + $self->{dither}->get() / 0x40; 365 366 $outch = $density_chars->[$ch]; 367 } 368 369 # Now output the character 370 $self->{driver}->set_color($outfg, $outbg); 371 $self->{driver}->putchar($x, $y, $outch); 372 373 $self->{dither}->increment(); 374 } 375 } 376 377 $self->{driver}->fini(); 378} 379 380sub rgb2hsv_default { 381 my ($self, $r, $g, $b) = @_; 382 383 my ($hue, $sat, $val) = (0, 0, 0); 384 385 my $min = $r; 386 my $max = $r; 387 388 $min = $g if $min > $g; 389 $max = $g if $max < $g; 390 $min = $b if $min > $b; 391 $max = $b if $max < $b; 392 393 my $delta = $max - $min; # 0 - 0xfff 394 $val = $max; # 0 - 0xfff 395 396 if ($delta){ 397 398 $sat = 0xfff * $delta / $max; # 0 - 0xfff 399 400 # Generate *hue between 0 and 0x5fff 401 402 if ($r == $max){ 403 $hue = 0x1000 + 0x1000 * ($g - $b) / $delta; 404 }elsif ($g == $max){ 405 $hue = 0x3000 + 0x1000 * ($b - $r) / $delta; 406 }else{ 407 $hue = 0x5000 + 0x1000 * ($r - $g) / $delta; 408 } 409 }else{ 410 $sat = 0; 411 $hue = 0; 412 } 413 414 return ($hue, $sat, $val); 415} 416 417 418sub HSV_DISTANCE{ 419 my ($self, $h, $s, $v, $index) = @_; 420 421 my $v1 = $v - $self->{hsv_palette}->[$index * 4 + 3]; 422 my $s1 = $s - $self->{hsv_palette}->[$index * 4 + 2]; 423 my $h1 = $h - $self->{hsv_palette}->[$index * 4 + 1]; 424 425 my $s2 = $self->{hsv_palette}->[$index * 4 + 3] ? CAA_HSV_YRATIO * $s1 * $s1 : 0; 426 my $h2 = $self->{hsv_palette}->[$index * 4 + 2] ? CAA_HSV_HRATIO * $h1 * $h1 : 0; 427 428 return $self->{hsv_palette}->[$index * 4] * ((CAA_HSV_XRATIO * $v1 * $v1) + $s2 + $h2); 429} 430 431sub load_submodule { 432 my ($self, $module, $args) = @_; 433 434 eval "require Image::Caa::$module"; 435 warn $@ if $@; 436 437 my $obj = undef; 438 eval "\$obj = new Image::Caa::$module(\$args)"; 439 warn $@ if $@; 440 441 if (!$@ && defined $obj){ 442 443 return $obj; 444 } 445 446 die "Image::Caa - Couldn't load 'Image::Caa::$module'"; 447} 448 4491; 450 451__END__ 452 453=head1 NAME 454 455Image::Caa - Colored ASCII Art 456 457=head1 SYNOPSIS 458 459 use Image::Caa; 460 use Image::Magick; 461 462 463 # load an image 464 465 my $image = Image::Magick->new; 466 $image->Read('sunset.jpg'); 467 468 469 # display it as ASCII Art 470 471 my $caa = new Image::Caa(); 472 $caa->draw_bitmap(0, 0, 40, 20, $image); 473 474 475 # some fancy options 476 477 my $caa = new Image::Caa( 478 driver => 'DriverANSI', 479 dither => 'DitherOrdered8', 480 black_bg => 1, 481 ); 482 $caa->draw_bitmap(0, 0, 40, 20, $image); 483 484=head1 DESCRIPTION 485 486This module outputs C<Image::Magick> image objects as ASCII Art, using a variety of output 487dithering modes and output drivers (currently supported is a plain old ANSI termical 488output driver and a curses driver). 489 490=head1 METHODS 491 492=over 493 494=item C<new( opt =E<gt> 'value', ... )> 495 496Returns a new C<Image::Caa> object. The options are as follows: 497 498=over 499 500=item * C<driver> 501 502Output driver. Valid values are: 503 504=over 505 506=item * C<DriverANSI> (default) 507 508=item * C<DriverCurses> 509 510=back 511 512=item * C<dither> 513 514Dithering mode. Valid values are: 515 516=over 517 518=item * C<DitherNone> (default) 519 520=item * C<DitherOrdered2> 521 522=item * C<DitherOrdered4> 523 524=item * C<DitherOrdered8> 525 526=item * C<DitherRandom> 527 528=back 529 530=item * C<black_bg> 531 532Set to 1 to enable black background mode. 533By default, we use colored backgrounds to allow 256 colors (16 foreground x 16 background) 534 535=item * C<window> 536 537Used only by the Curses output driver. Indicates the Curses window to write output into. 538 539=back 540 541=item C<draw_bitmap($x1, $y1, $x2, $y2, $image)> 542 543Draws the image C<$image> within the box bounded by C<($x1,$y1)-($x2,$y2)>. 544Note that the default (ANSI) output driver ignores the origin position as uses 545only the absolute box size. 546 547=back 548 549=head1 EXTENDING 550 551Both the dithering and driver backends are plugable and fairly easy to create - just create 552modules in the Image::Caa::* namespace. Dither modules need to implement the C<new()>, 553C<init($line)>, C<get()> and C<increment()> methods. Driver modules need to implement the 554C<new()>, C<init()>, C<set_color($fg, $bg)>, C<putchar($x, $y, $char)> and C<fini()> methods. 555Look at the existing modules for guidance. 556 557=head1 AUTHORS 558 559Copyright (C) 2006, Cal Henderson <cal@iamcal.com> 560 561This library is based on libcaca's bitmap.c 562 563libcaca is Copyright (C) 2004 Sam Hocevar <sam@zoy.org> 564 565libcaca is licensed under the GNU Lesser General Publice License 566 567=head1 SEE ALSO 568 569L<Image::Magick>, L<http://sam.zoy.org/libcaca/> 570 571=cut 572