HTML-Kit plugin - rainbow text generator (HSL color model)
js29a
created: 2005-12-20 06:03:33
#!/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;

  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;
}
Re: HTML-Kit plugin - rainbow text generator (HSL color model)
created: 2005-12-20 06:22:53

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, won’t 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, won’t you burn me a Knoppix CD ?
(Missquoting Janis Joplin)

Re: HTML-Kit plugin - rainbow text generator (HSL color model)
created: 2006-01-05 11:33:09
Thank you for showing how to make a plugin for HTML-Kit!

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