init
This commit is contained in:
162
wcmtools/lib/S2/Color.pm
Executable file
162
wcmtools/lib/S2/Color.pm
Executable file
@@ -0,0 +1,162 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
# This is a helper package, useful for creating color lightening/darkening
|
||||
# functions in core layers.
|
||||
#
|
||||
|
||||
package S2::Color;
|
||||
|
||||
# rgb to hsv
|
||||
# r, g, b = [0, 255]
|
||||
# h, s, v = [0, 1), [0, 1], [0, 1]
|
||||
sub rgb_to_hsv
|
||||
{
|
||||
my ($r, $g, $b) = map { $_ / 255 } @_;
|
||||
my ($h, $s, $v);
|
||||
|
||||
my ($max, $min) = ($r, $r);
|
||||
foreach ($g, $b) {
|
||||
$max = $_ if $_ > $max;
|
||||
$min = $_ if $_ < $min;
|
||||
}
|
||||
return (0, 0, 0) if $max == 0;
|
||||
|
||||
$v = $max;
|
||||
|
||||
my $delta = $max - $min;
|
||||
|
||||
$s = $delta / $max;
|
||||
return (0, $s, $v) unless $delta;
|
||||
|
||||
if ($r == $max) {
|
||||
$h = ($g - $b) / $delta;
|
||||
} elsif ($g == $max) {
|
||||
$h = 2 + ($b - $r) / $delta;
|
||||
} else {
|
||||
$h = 4 + ($r - $g) / $delta;
|
||||
}
|
||||
|
||||
$h = ($h * 60) % 360 / 360;
|
||||
|
||||
return ($h, $s, $v);
|
||||
}
|
||||
|
||||
# hsv to rgb
|
||||
# h, s, v = [0, 1), [0, 1], [0, 1]
|
||||
# r, g, b = [0, 255], [0, 255], [0, 255]
|
||||
sub hsv_to_rgb
|
||||
{
|
||||
my ($H, $S, $V) = @_;
|
||||
|
||||
if ($S == 0) {
|
||||
$V *= 255;
|
||||
return ($V, $V, $V);
|
||||
}
|
||||
|
||||
$H *= 6;
|
||||
my $I = POSIX::floor($H);
|
||||
|
||||
my $F = $H - $I;
|
||||
my $P = $V * (1 - $S);
|
||||
my $Q = $V * (1 - $S * $F);
|
||||
my $T = $V * (1 - $S * (1 - $F));
|
||||
|
||||
foreach ($V, $T, $P, $Q) {
|
||||
$_ = int($_ * 255 + 0.5);
|
||||
}
|
||||
|
||||
return ($V, $T, $P) if $I == 0;
|
||||
return ($Q, $V, $P) if $I == 1;
|
||||
return ($P, $V, $T) if $I == 2;
|
||||
return ($P, $Q, $V) if $I == 3;
|
||||
return ($T, $P, $V) if $I == 4;
|
||||
|
||||
return ($V, $P, $Q);
|
||||
}
|
||||
|
||||
# rgb to hsv
|
||||
# r, g, b = [0, 255], [0, 255], [0, 255]
|
||||
# returns: (h, s, l) = [0, 1), [0, 1], [0, 1]
|
||||
sub rgb_to_hsl
|
||||
{
|
||||
# convert rgb to 0-1
|
||||
my ($R, $G, $B) = map { $_ / 255 } @_;
|
||||
|
||||
# get min/max of {r, g, b}
|
||||
my ($max, $min) = ($R, $R);
|
||||
foreach ($G, $B) {
|
||||
$max = $_ if $_ > $max;
|
||||
$min = $_ if $_ < $min;
|
||||
}
|
||||
|
||||
# is gray?
|
||||
my $delta = $max - $min;
|
||||
if ($delta == 0) {
|
||||
return (0, 0, $max);
|
||||
}
|
||||
|
||||
my ($H, $S);
|
||||
my $L = ($max + $min) / 2;
|
||||
|
||||
if ($L < 0.5) {
|
||||
$S = $delta / ($max + $min);
|
||||
} else {
|
||||
$S = $delta / (2.0 - $max - $min);
|
||||
}
|
||||
|
||||
if ($R == $max) {
|
||||
$H = ($G - $B) / $delta;
|
||||
} elsif ($G == $max) {
|
||||
$H = 2 + ($B - $R) / $delta;
|
||||
} elsif ($B == $max) {
|
||||
$H = 4 + ($R - $G) / $delta;
|
||||
}
|
||||
|
||||
$H *= 60;
|
||||
$H += 360.0 if $H < 0.0;
|
||||
$H -= 360.0 if $H >= 360.0;
|
||||
$H /= 360.0;
|
||||
|
||||
return ($H, $S, $L);
|
||||
|
||||
}
|
||||
|
||||
# h, s, l = [0,1), [0,1], [0,1]
|
||||
# returns: rgb: [0,255], [0,255], [0,255]
|
||||
sub hsl_to_rgb {
|
||||
my ($H, $S, $L) = @_;
|
||||
|
||||
# gray.
|
||||
if ($S < 0.0000000000001) {
|
||||
my $gv = int(255 * $L + 0.5);
|
||||
return ($gv, $gv, $gv);
|
||||
}
|
||||
|
||||
my ($t1, $t2);
|
||||
if ($L < 0.5) {
|
||||
$t2 = $L * (1.0 + $S);
|
||||
} else {
|
||||
$t2 = $L + $S - $L * $S;
|
||||
}
|
||||
$t1 = 2.0 * $L - $t2;
|
||||
|
||||
my $fromhue = sub {
|
||||
my $hue = shift;
|
||||
if ($hue < 0) { $hue += 1.0; }
|
||||
if ($hue > 1) { $hue -= 1.0; }
|
||||
|
||||
if (6.0 * $hue < 1) {
|
||||
return $t1 + ($t2 - $t1) * $hue * 6.0;
|
||||
} elsif (2.0 * $hue < 1) {
|
||||
return $t2;
|
||||
} elsif (3.0 * $hue < 2.0) {
|
||||
return ($t1 + ($t2 - $t1)*((2.0/3.0)-$hue)*6.0);
|
||||
} else {
|
||||
return $t1;
|
||||
}
|
||||
};
|
||||
|
||||
return map { int(255 * $fromhue->($_) + 0.5) } ($H + 1.0/3.0, $H, $H - 1.0/3.0);
|
||||
}
|
||||
|
||||
1;
|
||||
135
wcmtools/lib/S2/EXIF.pm
Executable file
135
wcmtools/lib/S2/EXIF.pm
Executable file
@@ -0,0 +1,135 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
# This is a helper package, contains info about EXIF tag categories and how to print them
|
||||
#
|
||||
|
||||
package S2::EXIF;
|
||||
use strict;
|
||||
use vars qw(@TAG_CAT %TAG_CAT);
|
||||
|
||||
# rough categories which can optionally be used to display tags
|
||||
# with coherent ordering
|
||||
|
||||
@TAG_CAT =
|
||||
(
|
||||
[ media => {
|
||||
name => 'Media Information',
|
||||
tags => [ qw (
|
||||
PixelXDimension
|
||||
PixelYDimension
|
||||
ImageWidth
|
||||
ImageLength
|
||||
Compression
|
||||
CompressedBitsPerPixel
|
||||
)
|
||||
],
|
||||
},
|
||||
],
|
||||
|
||||
[ image => {
|
||||
name => 'Image Information',
|
||||
tags => [ qw (
|
||||
DateTime
|
||||
DateTimeOriginal
|
||||
ImageDescription
|
||||
UserComment
|
||||
Make
|
||||
Software
|
||||
Artist
|
||||
Copyright
|
||||
ExifVersion
|
||||
FlashpixVersion
|
||||
)
|
||||
],
|
||||
},
|
||||
],
|
||||
|
||||
[ exposure => {
|
||||
name => 'Exposure Settings',
|
||||
tags => [ qw(
|
||||
Orientation
|
||||
Flash
|
||||
FlashEnergy
|
||||
LightSource
|
||||
ExposureTime
|
||||
ExposureProgram
|
||||
ExposureMode
|
||||
DigitalZoomRatio
|
||||
ShutterSpeedValue
|
||||
ApertureValue
|
||||
MeteringMode
|
||||
WhiteBalance
|
||||
Contrast
|
||||
Saturation
|
||||
Sharpness
|
||||
SensingMethod
|
||||
FocalLength
|
||||
ISOSpeedRatings
|
||||
FNumber
|
||||
)
|
||||
],
|
||||
},
|
||||
],
|
||||
|
||||
[ gps => {
|
||||
name => 'GPS Information',
|
||||
tags => [ qw(
|
||||
GPSLatitudeRef
|
||||
GPSLatitude
|
||||
GPSLongitudeRef
|
||||
GPSLongitude
|
||||
GPSAltitudeRef
|
||||
GPSAltitude
|
||||
GPSTimeStamp
|
||||
GPSDateStamp
|
||||
GPSDOP
|
||||
GPSImgDirectionRef
|
||||
GPSImgDirection
|
||||
)
|
||||
],
|
||||
},
|
||||
],
|
||||
);
|
||||
|
||||
# make mapping into array
|
||||
%TAG_CAT = map { $_->[0] => $_->[1] } @TAG_CAT;
|
||||
|
||||
# return all tags in all categories
|
||||
sub get_tag_info {
|
||||
|
||||
my @ret = ();
|
||||
foreach my $currcat (@S2::EXIF::TAG_CAT) {
|
||||
push @ret, @{$currcat->[1]->{tags}};
|
||||
}
|
||||
|
||||
return @ret;
|
||||
}
|
||||
|
||||
# return hashref of category keys => names
|
||||
sub get_cat_info {
|
||||
return { map { $_->[0] => $_->[1]->{name} } @S2::EXIF::TAG_CAT };
|
||||
}
|
||||
|
||||
# return ordered array of category keys
|
||||
sub get_cat_order {
|
||||
return map { $_->[0] } @S2::EXIF::TAG_CAT;
|
||||
}
|
||||
|
||||
# return the name of a single category
|
||||
sub get_cat_name {
|
||||
return () unless $TAG_CAT{$_[0]};
|
||||
return $TAG_CAT{$_[0]}->{name};
|
||||
}
|
||||
|
||||
# return the tags in a given cateogry
|
||||
sub get_cat_tags {
|
||||
return () unless $TAG_CAT{$_[0]};
|
||||
return @{$TAG_CAT{$_[0]}->{tags}};
|
||||
}
|
||||
|
||||
# return all tags for all categories
|
||||
sub get_all_tags {
|
||||
return map { @{$TAG_CAT{$_}->{tags}} } keys %TAG_CAT;
|
||||
}
|
||||
|
||||
1;
|
||||
Reference in New Issue
Block a user