diff --git a/automation/include/Auto4Utils.pm b/automation/include/Auto4Utils.pm new file mode 100644 index 000000000..bc0bba878 --- /dev/null +++ b/automation/include/Auto4Utils.pm @@ -0,0 +1,250 @@ +#/usr/bin/perl + +######### +# +# Written by Karl Blomster (TheFluff) 2008. +# (OK, mostly just a translation of utils-auto4.lua.) +# +# This script is hereby given into the public domain. +# If that is not possible according to local laws, I, the author, hereby grant +# anyone the right to use this script for any purpose. +# +######### + +package Auto4Utils; +require Exporter; + +use warnings; +use strict; +use feature ":5.10"; +use utf8; # just to be safe +use POSIX (); # gah, we only need floor(), no need to import all of IEEE 1003.1 + + +# TODO: discuss what should be exported by default +our @ISA = qw(Exporter); +our @EXPORT = qw(extract_color alpha_from_style color_from_style HSV_to_RGB HSL_to_RGB interpolate_color interpolate_alpha); +our @EXPORT_OK = qw(ass_color ass_alpha ass_style_color string_trim clamp interpolate); + + +# Given 3 integers R,G,B, returns ASS formatted &HBBGGRR& string +sub ass_color { + my ($r, $g, $b) = @_; + return(sprintf("&H%02X%02X%02X&", $b, $g, $r)); +} +# Perlier version of that: +# sub ass_color { return sprintf "&H%02X%02X%02X&", reverse } + # I don't think reverse reverses @_ by default, rats :( + +# Convert decimal alpha value to &H00& form +sub ass_alpha { + return(sprintf("&H%02X&", shift(@_))); +} + +# Given 4 integers R,G,B,A, returns a v4+ formatted style color string +# (note no terminating &) +sub ass_style_color { + my ($r, $g, $b, $a) = @_; + return(sprintf("&H%02X%02X%02X%02X", $a, $b, $g, $r)); +} + +# Tries its best to convert a string to 4 integers R,G,B,A. +# Returns them in that order if it succeeds, or undef if it can't do it. +# Useless in scalar context. +sub extract_color { + my $string = shift(@_); + + # This here thingie is a switch statement. Magic! + given ( $string ) { + # try v4+ style (ABGR) + when ( /\&H([a-f0-9]{2})([a-f0-9]{2})([a-f0-9]{2})([a-f0-9]{2})/i ) { + return(hex($4), hex($3), hex($2), hex($1)); + } + # color override? (BGR) + when ( /\&H([a-f0-9]{2})([a-f0-9]{2})([a-f0-9]{2})\&H/i ) { + return(0, hex($3), hex($2), hex($1)); + } + # alpha override? (A) + # (bug: bogus results with \c&H& with the first four zeros omitted) + when ( /\&H([a-f0-9]{2})\&/i ) { + return(hex($1), 0, 0, 0); + } + # try HTML format for laffs (RGB) + when ( /\#([a-f0-9]{2})([a-f0-9]{2})?([a-f0-9]{2})?/i ) { + return(0, (hex($2) or 0), (hex($2) or 0), (hex($3) or 0)); + } + default { + return(undef, undef, undef, undef); + } + } +} + +# Given a a style color string, returns the alpha part formatted as override +sub alpha_from_style { + my $color_string = shift(@_); + my ($r, $g, $b, $a) = extract_color($color_string); + return(ass_alpha($a or 0)); +} + +# Given a style color string, returns the color part formatted as override +sub color_from_style { + my $color_string = shift(@_); + my ($r, $g, $b, $a) = extract_color($color_string); + return(ass_color(($r or 0), ($g or 0), ($b or 0))); +} + + +# Converts 3 integers H, S, V (hue, saturation, value) to R, G, B +sub HSV_to_RGB { + my ($H, $S, $V) = @_; + my ($r, $g, $b); + + # saturation is zero, make grey + if ($S == 0) { + $r = $V * 255; + $r = clamp($r, 0, 255); + ($g, $b) = ($r, $r); + } + # else calculate color + else { + # calculate subvalues + $H = $H % 360; # put $h in range [0,360] + my $Hi = POSIX::floor($H/60); + my $f = $H/60 - $Hi; + my $p = $V * (1 - $S); + my $q = $V * (1 - $f * $S); + my $t = $V * (1 - (1 - $f) * $S); + + # do math based on hue index + if ($Hi == 0) { $r = $V*255; $g = $t*255; $b = $p*255; } + elsif ($Hi == 1) { $r = $q*255; $g = $V*255; $b = $p*255; } + elsif ($Hi == 2) { $r = $p*255; $g = $V*255; $b = $t*255; } + elsif ($Hi == 3) { $r = $p*255; $g = $q*255; $b = $V*255; } + elsif ($Hi == 4) { $r = $t*255; $g = $p*255; $b = $V*255; } + elsif ($Hi == 5) { $r = $V*255; $g = $p*255; $b = $q*255; } + # TODO: replace this with Aegisub::Script::debug_out() or whatever it is + else { warn("HSV_to_RGB: Hi got an unexpected value: $Hi"); } + } + + $r = POSIX::floor($r); + $g = POSIX::floor($g); + $b = POSIX::floor($b); + return($r, $g, $b); +} + + +# Converts 3 integers H, S, L (hue, saturation, luminance) to R, G, B +# Routine is best performed to "The HSL Song" by Diablo-D3 and the #darkhold idlers. +# The lyrics are as follows: +# I see a little silluetto of a man +# It's in color, its in color, can you convert to HSL? +# Cyan, yellow and magenta, very very outdated now +# Alvy Smith, Alvy Smith, Alvy Smith, Alvy Smith, Fiigaarrooo +# I'm just a poor boy, stuck with RGB +# (He's just a poor boy, from a poor colorspace, spare him his eyes from this monstrosity) +# +# Easy come, easy go, will you let me HSL? +# (No! We will not let you HSL!) +# Let him HSL! +# (No! We will not let you HSL!) +# Let him HSL! +# (No! We will not let you HSL!) +# Let me HSL! +# (Will not HSL!) +# Let me HSL! +# (Will not HSL!) +# Let me HSL! Let me HSL! +# (Never never never never never!) +# Let me HHHHHSSSSSLLLLL! +# (No no no no no no no!) +# +# [70's rock/bad humour segment ends here. We now return to your regularily scheduled Perl hacking...] +sub HSL_to_RGB { + my ($H, $S, $L) = @_; + my ($r, $g, $b, $Q); + + # make sure input is in range + $H = $H % 360; + $S = clamp($S, 0, 1); + $L = clamp($L, 0, 1); + + # simple case if saturation is 0, all grey + if ($S == 0) { + ($r, $g, $b) = ($L, $L, $L); + } + # more common case, saturated color + else { + if ($L < 0.5) { $Q = $L * (1 + $S); } + else { $Q = $L + $S - ($L * $S); } + + my $P = 2 * $L - $Q; + my $Hk = $H / 360; + + my ($Tr, $Tg, $Tb); + $Tg = $Hk; + if ($Hk < 1/3) { $Tr = $Hk + 1/3; $Tb = $Hk + 2/3; } + elsif ($Hk > 2/3) { $Tr = $Hk - 2/3; $Tb = $Hk - 1/3; } + else { $Tr = $Hk + 1/3; $Tb = $Hk - 1/3; } + + # anonymous subroutine required for closure reasons + my $get_component = sub { + my $T = shift(@_); + if ($T < 1/6) { return($P + (($Q - $P) * 6 * $T)) } + elsif (1/6 <= $T and $T < 1/2) { return($Q) } + elsif (1/2 <= $T and $T < 2/3) { return($P + (($Q - $P) * (2/3 - $T) * 6)) } + else { return($P) } + }; + + $r = $get_component->($Tr); + $g = $get_component->($Tg); + $b = $get_component->($Tb); + } + + return($r, $g, $b); +} + + +# Removes whitespace at the start and end of a string +# (will anyone ever use this in a perl program?) +sub string_trim { + my $string = shift(@_); + $string =~ s!^\s*(.+?)\s*$!$1!; + return($string); +} + + +# Clamp a numeric value to a range +sub clamp { + my ($val, $min, $max) = @_; + if ($val < $min) { return($min) } + elsif ($val > $max) { return($max) } + else { return($val) } +} + +# interpolate between two numbers +sub interpolate { + my ($pct, $min, $max) = @_; + if ($pct <= 0) { return($min) } + elsif ($pct >= 1) { return($max) } + else { return($pct * ($max - $min) + $min) } +} + +# interpolate between two color values (given as &HBBGGRR strings) +# returns string formatted with \c&H override format +sub interpolate_color { + my ($pct, $start, $end) = @_; + my ($r1, $g1, $b1) = extract_color($start); + my ($r2, $g2, $b2) = extract_color($end); + my ($r, $g, $b) = + (interpolate($pct, $r1, $r2), interpolate($pct, $g1, $g2), interpolate($pct, $b1, $b2)); + return(ass_color($r, $g, $b)); +} + +# interpolate between two alpha values (given as either override or part of style color strings) +# returns string formatted with \c&H override format +sub interpolate_alpha { + my ($pct, $start, $end) = @_; + my ($r1, $g1, $b1, $a1) = extract_color($start); + my ($r2, $g2, $b2, $a2) = extract_color($end); + return(ass_alpha(interpolate($pct, $a1, $a2))); +} \ No newline at end of file