#!/usr/bin/perl
# $Revision: 1.8 $
use hkpcore;
use Win32::OLE::Variant;
use constant PLUGIN_NAME => 'js29a_rbow_p';
sub min3($$$){
my $res=$_[0];
$res=$_[1] if $res > $_[1];
$res=$_[2] if $res > $_[2];
$res;
}
sub max3($$$){
my $res=$_[0];
$res=$_[1] if $res < $_[1];
$res=$_[2] if $res < $_[2];
$res;
}
sub hue_2_rgb($$$){
my ($v1,$v2,$vh)=@_;
$vh+=1.0 if $vh < 0.0;
$vh-=1.0 if $vh > 1.0;
return $v1 + ($v2 - $v1) * 6.0 * $vh if 6.0 * $vh < 1;
return $v2 if 2.0 * $vh < 1;
return $v1 + ($v2 - $v1) * ((2.0/3.0) - $vh)*6.0 if 3.0 * $vh < 2;
return $v1;
}
sub rgb_to_hsl {
return unless defined wantarray;
my ($r,$g,$b);
my ($h,$s,$l)=(0,0,0);
if(ref $_[0] eq 'HASH'){
($r,$g,$b)=($_[0]->{R},$_[0]->{G},$_[0]->{B});
}else{
($r,$g,$b)=@_;
}
my $var_Min = min3($r,$g,$b);
my $var_Max = max3($r,$g,$b);
my $del_Max = $var_Max - $var_Min;
$l = ( $var_Max + $var_Min ) / 2.0;
if( $del_Max == 0.0 ){
$h=$s=0.0;
}else{
$s=$del_Max / (2.0 - $var_Max - $var_Min);
$s=$del_Max / ($var_Max + $var_Min) if $l < 0.5;
my $del_R=( ( ( $var_Max - $r ) / 6.0 ) + ( $del_Max / 2.0 ) ) / $del_Max;
my $del_G=( ( ( $var_Max - $g ) / 6.0 ) + ( $del_Max / 2.0 ) ) / $del_Max;
my $del_B=( ( ( $var_Max - $b ) / 6.0 ) + ( $del_Max / 2.0 ) ) / $del_Max;
if ( $r == $var_Max ) {$h = $del_B - $del_G }
elsif ( $g == $var_Max ) {$h = ( 1.0 / 3.0 ) + $del_R - $del_B}
elsif ( $b == $var_Max ) {$h = ( 2.0 / 3.0 ) + $del_G - $del_R};
$h+=1.0 if $h < 0;
$h-=1.0 if $h > 1.0;
}
return ($h,$s,$l) if wantarray;
return {H=>$h, S=>$s, L=>$l};
}
sub hsl_to_rgb {
return unless defined wantarray;
my ($h,$s,$l);
my ($r,$g,$b)=(0,0,0);
if(ref $_[0] eq 'HASH'){
($h,$s,$l)=($_[0]->{H},$_[0]->{S},$_[0]->{L});
}else{
($h,$s,$l)=@_;
}
my ($var_1,$var_2);
if (!$s){
$r=$g=$b=$l;
}else{
if( $l < 0.5 ){ $var_2 = $l * ( 1 + $s ); }
else { $var_2 = ( $l + $s ) - ( $s * $l ) };
$var_1 = 2.0 * $l - $var_2;
$r = hue_2_rgb( $var_1, $var_2, $h + ( 1.0 / 3.0 ) ) ;
$g = hue_2_rgb( $var_1, $var_2, $h );
$b = hue_2_rgb( $var_1, $var_2, $h - ( 1.0/ 3.0 ) );
}
return ($r,$g,$b) if wantarray;
return {R=>$r, G=>$g, B=>$b};
}
sub prop_put($$$){
my $v=shift;
my ($key,$value)=@_;
$v->hkp_FuncOpen($hkp_f_PluginDataWrite);
$v->hkp_DataAdd($hkp_FUNC_P1,PLUGIN_NAME);
$v->hkp_DataAdd($hkp_FUNC_P2,$key);
$v->hkp_DataAdd($hkp_FUNC_P3,$value);
$v->hkp_FuncRun();
$v->hkp_FuncClose();
}
sub prop_get($$$){
my $v=shift;
my ($key,$defl)=@_;
$v->hkp_FuncOpen($hkp_f_PluginDataRead);
$v->hkp_DataAdd($hkp_FUNC_P1,PLUGIN_NAME);
$v->hkp_DataAdd($hkp_FUNC_P2,$key);
$v->hkp_DataAdd($hkp_FUNC_P3,$defl);
$v->hkp_FuncRun();
my $res=$v->hkp_DataGetStr($hkp_FUNC_P1,'');
$v->hkp_FuncClose();
return $res;
}
sub wizard($$) {
my $v=$_[0];
my $text=$_[1];
$text=prop_get($v,'text','enter some text here') if $text eq '';
$text=~s/&/&/g;
$text=~s/</g;
$text=~s/>/>/g;
my $c0=prop_get($v,'c0','#dead00');
my $c1=prop_get($v,'c1','#00beef');
$v->hkp_FuncOpen($hkp_f_InputWizard);
$v->hkp_DataAddInt($hkp_FUNC_P1, 1);
$v->hkp_DataAdd($hkp_FUNC_P2, "Rainbow text and color selection");
$v->hkp_DataAdd($hkp_FUNC_P3, "pick two colors");
$v->hkp_DataAdd($hkp_FUNC_P4, <<"EOS");
EOS
$v->hkp_DataAddInt($hkp_FUNC_P5, 0);
$v->hkp_DataAdd($hkp_FUNC_P6, "about:");
$v->hkp_FuncRun();
$v->hkp_FuncClose();
$v->hkp_FuncOpen($hkp_f_InputWizard);
$v->hkp_DataAddInt($hkp_FUNC_P1, 2);
$v->hkp_DataAdd($hkp_FUNC_P2, 'c0');
$v->hkp_FuncRun();
$c0=$v->hkp_DataGetStr($hkp_FUNC_P2,'');
$v->hkp_DataAdd($hkp_FUNC_P2, 'c1');
$v->hkp_FuncRun();
$c1=$v->hkp_DataGetStr($hkp_FUNC_P2,'');
$v->hkp_DataAdd($hkp_FUNC_P2, 'txt');
$v->hkp_FuncRun();
$text=$v->hkp_DataGetStr($hkp_FUNC_P2,'');
$v->hkp_FuncClose();
return (undef,undef,undef) if $c0 eq '' or $c1 eq '' or $text eq '';
# # + 6 hex digits
$c0=undef if $c0 !~ /^\#[0-9a-fA-F]{6,6}$/;
$c1=undef if $c1 !~ /^\#[0-9a-fA-F]{6,6}$/;
return (undef,undef,undef) if !defined $c0 or !defined $c1;
prop_put $v,'c0',$c0;
prop_put $v,'c1',$c1;
prop_put $v,'text',$text;
return ($c0,$c1,$text);
}
sub esc($){
my $chr=$_[0];
return '&' if $chr eq '&';
return '<' if $chr eq '<';
return '>' if $chr eq '>';
return $chr;
}
sub emit($$$$){
my $chr=$_[0];
my ($r,$g,$b)=@_[1..3];
$r=int($r*255.0);
$g=int($g*255.0);
$b=int($b*255.0);
my $txt=''.esc($chr)."";
return $txt;
}
sub blend($$$){
my $txt=$_[0];
my ($r0,$g0,$b0)=@{$_[1]};
my ($r1,$g1,$b1)=@{$_[2]};
($r0,$g0,$b0,
$r1,$g1,$b1) = map {$_/255.0} ($r0,$g0,$b0,$r1,$g1,$b1);
my ($h0,$s0,$l0)=rgb_to_hsl($r0,$g0,$b0);
my ($h1,$s1,$l1)=rgb_to_hsl($r1,$g1,$b1);
my $out;
my $last=(length $txt)-1;
for $pos (0..$last){
my $hx=($h1-$h0)*$pos/$last+$h0;
my $sx=($s1-$s0)*$pos/$last+$s0;
my $lx=($l1-$l0)*$pos/$last+$l0;
my ($rx,$gx,$bx)=hsl_to_rgb($hx,$sx,$lx);
$out.=emit((substr $txt,$pos,1),$rx,$gx,$bx);
}
return $out;
}
if('-hkpreg' eq $ARGV[0]){
my $icon=
'AAABAAEAEBAEAAAAAAAoAQAAFgAAACgAAAAQAAAAIAAAAAEABAAAAAAAgAAAAAAAAAAAAA'
.'AAAAAAAAAAAAAAAAAAAACAAACAAAAAgIAAgAAAAIAAgACAgAAAgICAAMDAwAAAAP8AAP8A'
.'AAD//wD/AAAA/wD/AP//AAD///8AAAAAAAAAAAAA7u67u6qqAADu7ru7qqoAAO7uu7uqqg'
.'AA7u67u6qqAADu7ru7qqoAAO7uu7uqqgAA7u67u6qqAADu7ru7qqoAAO7uu7uqqgAA7u67'
.'u6qqAADu7ru7qqoAAO7uu7uqqgAA7u67u6qqAADu7ru7qqoAAAAAAAAAAAD//wAAwAMAAM'
.'ADAADAAwAAwAMAAMADAADAAwAAwAMAAMADAADAAwAAwAMAAMADAADAAwAAwAMAAMADAAD/'
.'/wAA';
my $v = hkp_CreateObjectHKPCore();
$v->hkp_DataSetGlobalSuffix('_1');
$v->hkp_DataAdd($hkp_NAME,'Rainbow');
$v->hkp_DataAdd($hkp_VERSION,'1.0');
$v->hkp_DataAdd($hkp_SECTION,'js29a');
$v->hkp_DataAdd($hkp_DESCRIPTION,'Rainbow text. Uses HSV color model.');
$v->hkp_DataAdd($hkp_HINT,'make a rainbow text');
$v->hkp_DataAdd($hkp_COPYRIGHT_SHORT,'Copyright (C) 2002,2005 by js29a.');
$v->hkp_DataAdd($hkp_COPYRIGHT_LONG,'Copyright (C) 2002,2005 by js29a.\nAll rights reserved.');
$v->hkp_DataAdd($hkp_AUTHOR,'js29a');
$v->hkp_DataAdd($hkp_EMAIL,'js29a@o2.pl');
$v->hkp_DataAdd($hkp_ICON_SMALL,$icon);
$v->hkp_DataAdd($hkp_LICENSE_TYPE,'freeware');
$v->hkp_DataAddInt($hkp_MODE_IN_TEXT_SELECTED,1);
$v->hkp_DataAddInt($hkp_MODE_ICON,$hkp_c_MODE_ICON_DATA);
$v->hkp_DataSetGlobalSuffix('');
}
elsif('-hkprun' eq $ARGV[0]){
my $v = hkp_CreateObjectHKPCore();
my $text = Variant(VT_BSTR|VT_BYREF, '');
my $want_struct=0;
$v->hkp_DataGet($hkp_INPUT_SELECTED, $text);
my ($c0,$c1,$txt)=wizard($v,$text);
my $out=undef;
if(defined $c0 && defined $c1 && defined $txt){
$out="c0=$c0\nc1=$c1\ntxt=$txt";
my ($r0,$g0,$b0)=unpack 'xA2A2A2',$c0;
my ($r1,$g1,$b1)=unpack 'xA2A2A2',$c1;
$r0=hex $r0; $g0=hex $g0; $b0=hex $b0;
$r1=hex $r1; $g1=hex $g1; $b1=hex $b1;
my $rgb_str_0=sprintf("rgb(%3d,%3d,%3d)",$r0,$g0,$b0);
my $rgb_str_1=sprintf("rgb(%3d,%3d,%3d)",$r1,$g1,$b1);
$out=<<"EOS";
EOS
$out .= blend $txt,[$r0,$g0,$b0],[$r1,$g1,$b1];
}
$v->hkp_DataAdd('OUTPUT',$out) if defined $out;
}
Just a few comments on this:
The code has no use strict;, but most of the variables appear to be lexicalised. Would it run under strict?
What is hkpcore, and where can you get it?
This may be a cool use of perl to you, but why? You present no accompanying documentation or POD. Who would use the code, what for and how?
I have an aversion to prototypes, and can see no reason why min3, max3, etc need them.
My $0.02
--
Oh Lord, wont you burn me a Knoppix CD ?
My friends all rate Windows, I must disagree.
Your powers of persuasion will set them all free,
So oh Lord, wont you burn me a Knoppix CD ?
(Missquoting Janis Joplin)
I guess that this script should be named 'js29a_rbow_p', right?
And how is it called? I haven't had the time to study more about this great editor. I once made a plugin with the standard way (SDK).
Perhaps, you could help us all and describe more about how to use it. I would love to make some plugin, also. For example, one that would create a figglet title of a new file.
Any further explanation would be thanked a lot:)!
perlmonks.org content © perlmonks.org and chanio, js29a, rinceWind
prlmnks.org © 2006 edmund von der burg (eccles & toad)
v 0.03