Added pangotext.pl (#121)

Added pangotext.pl (#121)

diff --git a/scripts/pangotext.pl b/scripts/pangotext.pl
new file mode 100644 (file)
index 0000000..71d2b08
--- /dev/null
+++ b/scripts/pangotext.pl
@@ -0,0 +1,243 @@
+##############################################################################################
+# pangotext.pl - Specify color patterns in a text message using html-esque tags. In the
+#  same vein as pangotext.
+#
+# DESCRIPTION
+# The purpose of this script is to allow you to write text to the current channel with
+# complex color patterns, using simple html tag syntax. This allows you to do things like
+# send a rainbow-colored message where only part of the message is rainbow colored easily.
+#
+# USAGE
+# /pango <message text here>
+# NOTE: You can't put tags inside tags marked 'no inner tags' below
+# all other tags are fully nestable. Tags noted below with 'attributes'
+# also have attributes that can be specified (ie <tag attrib=value>) no spaces
+# are allowed in attribute names or values.
+# inverse,inv   Reverse foreground and background of text 
+# bold,b        Bold text 
+# underline,ul  Underlines text
+# rainbow,rb    Colorizes text with a rainbow (no inner tags)
+# checker       Colorizes text with a checker pattern (no inner tags)
+# gradiant      Colorizes text with a gradiant (no inner tags, attribs { start, end })
+# ...more to if you can think of any add more functions...
+#
+# EXAMPLES
+# This script makes most sense if you just use it and see how awesome it is. Here
+# are some example usages you should check out.
+#   # Send a message with a colorful rainbow
+#   /pango Hi guys, here's a <rainbow>rainbow</rainbow> for you.
+#   /pango Hi guys, here's a <inverse><rainbow>rainbow</rainbow></inverse> for you. # Shows an inverse rainbow
+#   /pango Hi guys, here's a <bold><rainbow>rainbow</rainbow></bold> for you.       # Shows a bright rainbow
+#
+#   # Send a message with a checker pattern and a rainbow and underlined text also
+#   /pango <b>Let's play a game</b> <ul>of</ul> <checker>checkers</checker>! Or do you like
+#     it better inversed <inverse><checker>inversed checkers</checker></inverse>!
+#
+#   # Gradiants allow start and end range specifier in by color name:
+#   /pango <gradiant start=green end=red>some gradiant text here</gradiant>
+#   /pango <gradiant>default gradiant range</gradiant>
+#   /pango <gradiant start=lightcyan end=white>a light gradiant</gradiant>
+# 
+##############################################################################################
+use warnings;
+
+use Irssi;
+use Irssi::Irc;
+
+$VERSION = "1.1";
+%IRSSI = (
+    authors     => 'fprintf',
+    contact     => 'fprintf@github.com',
+    name        => 'pangotext',
+    description => 'Render text with various color modifications using HTML tag syntax.',
+    license     => 'GNU GPLv2 or later',
+);
+
+# Color metadata
+my %color = (
+    white => 0,
+    black => 1,
+    blue => 2,
+    green => 3,
+    lightred => 4,
+    red => 5,
+    purple => 6,
+    orange => 7,
+    yellow => 8,
+    lightgreen => 9,
+    cyan => 10,
+    lightcyan => 11,
+    lightblue => 12,
+    lightpurple => 13,
+    gray => 14,
+    lightgray => 15,
+);
+
+my @color_order = (
+    'white', 'lightgray', 'lightcyan', 'lightblue', 'lightgreen',
+    'lightpurple', 'yellow', 'lightred', 'orange', 'red', 'purple',
+    'cyan', 'blue', 'green', 'gray', 'black' 
+);
+my %color_ordermap;
+for (my $i = 0; $i < @color_order; ++$i) {
+    $color_ordermap{$color_order[$i]} = $i;
+}
+
+# Allowed tags
+my %tag_registry = (
+    'rb' => \&rainbow,
+    'rainbow' => \&rainbow,
+    'checker' => \&checker,
+
+    'gradiant' => \&gradiant,
+    'gradient' => \&gradiant,
+    'grad' => \&gradiant,
+
+    'ul' => \&underline,
+    'underline' => \&underline,
+    'bold' => \&bold,
+    'b' => \&bold,
+    'inverse' => \&inverse,
+    'inv' => \&inverse,
+);
+
+
+##############################################################################################
+# Utils
+##############################################################################################
+
+sub palettize
+{
+    my ($text, $palette) = @_;
+    return $text if (!$palette || ref($palette) ne 'ARRAY');
+
+    # Colorize the text using the given palette
+    my $count = 0;
+    my $render = '';
+    foreach my $let (split(//,$text)) {
+        $let .= ',' if ($let eq ','); 
+        $render .= $let =~ /\s/ ? $let : sprintf("\003%02d%s", $$palette[$count++ % scalar(@$palette)], $let);
+    }
+    return sprintf("%s\003", $render);
+}
+
+##############################################################################################
+# Render tags
+##############################################################################################
+sub rainbow
+{
+    my $text = shift;
+    my @palette = (
+        2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13
+    );
+    return palettize($text, \@palette);
+}
+
+sub gradiant
+{
+    my ($text, $attribs) = @_;
+    $attribs ||= {};
+    $attribs->{start} ||= 'white';
+    $attribs->{end} ||= 'lightpurple';
+
+    # Build the palette based on the given color range
+    my @palette = ();
+    my ($start,$end) = ($color_ordermap{$attribs->{start}},$color_ordermap{$attribs->{end}});
+    # Fancy way to find min and max 
+    my $min = ($start,$end)[$start > $end];
+    my $max = ($start,$end)[$start < $end];
+    for (my $i = $min; $i <= $max; ++$i) {
+        push(@palette, $color{$color_order[$i % scalar(@color_order)]}); # Wrap colors around if they overlap
+    }
+
+    # Palettize the text
+    return palettize($text, \@palette);
+}
+
+sub checker
+{
+    my $text = shift;
+    my $rainbow = '';
+    my $count = 0;
+    # Black on red, red on black
+    my @palette = ('01,04', '04,01');
+    foreach my $let (split(//,$text)) { 
+        $let .= ',' if ($let eq ',');
+        $rainbow .= $let =~ /\s/ ? $let : sprintf("\003%s%s", $palette[$count++ % scalar(@palette)], $let);
+    }
+    return sprintf("%s\003", $rainbow);
+}
+
+sub bold
+{
+    my $text = shift;
+    return sprintf("\002%s\002", $text);
+}
+
+sub underline
+{
+    my $text = shift;
+    return sprintf("\037%s\037", $text);
+}
+
+sub inverse
+{
+    my $text = shift;
+    return sprintf("\026%s\026", $text);
+}
+
+##############################################################################################
+# Renderer function
+##############################################################################################
+
+sub render
+{
+    my ($text) = @_; 
+
+    while ($text =~ /<\s*([^>\s]+)\s*([^>]*)>(.+?)<\/?\1>/g) {
+        my ($action,$extra,$msg) = ($1,$2,$3);
+        my $mstart = $-[0];
+        my $mend = pos($text);
+        my %attribs = ();
+
+        (%attribs) = $extra =~ /(\S+)\s*=\s*(\S+)/g;
+
+        if (!exists($tag_registry{$action})) {
+            Irssi::print("[/pango error] invalid action: $action");
+            next;
+        }
+
+        # Render our text
+        $msg = $tag_registry{$action}->($msg,\%attribs);
+        my $len = $mend - $mstart;
+        my $index = $mend - $len;
+        # Insert it
+        substr($text, $index, $len, $msg);
+    }
+    return $text;
+}
+
+##############################################################################################
+# Irssi interface
+##############################################################################################
+# /pango
+# Send message to current channel
+# with rendered text
+# See functions above for available tags
+sub pango {
+    my ($text, $server, $dest) = @_;
+
+    if (!$server || !$server->{connected}) {
+        Irssi::print("[/pango error] not connected to server");
+        return;
+    }
+
+    return unless $dest;
+
+    if ($dest->{type} eq "CHANNEL" || $dest->{type} eq "QUERY") {
+        $dest->command("/msg " . $dest->{name} . " " . render($text));
+    }
+}
+
+
+Irssi::command_bind("pango", \&pango);