Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

delirium

by beppu (Friar)
on Jul 05, 2000 at 03:23 UTC ( #21070=sourcecode: print w/ replies, xml ) Need Help??

Category: HTML utility
Author/Contact Info John Beppu <beppu@lineo.com>
Description: a filter to make your HTML delirioius
#!/usr/bin/perl -w

use strict;

# I want to make it into a module, someday
package Text::Delirium;

$Text::Delirium::default_amplitude = 2;
$Text::Delirium::default_palette   = [
    '#FF9900',
    '#FFFF00',
    '#009900',
    '#0099FF',
    '#0000FF',
    '#6600FF',
    '#FF00FF',
]

# constructor 
#   amplitude   ((absolute(magnitude - 1)) of font size variations)
#   palette     (array ref of colors to be used)
# ______________________________________
sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = { };

    if (@_) {
        (@_ & 1) || die "Odd number of parameters\n";
        my %opt = @_;
        $self->{palette}   = (defined ($opt{palette}))
            ? $opt{palette}
            : $Text::Delirium::default_palette;
        $self->{amplitude} = (defined ($opt{amplitude}))
            ? $opt{amplitude}
            : $Text::Delirium::default_amplitude;
    } else {
        $self->{palette}   = $Text::Delirium::default_palette;
        $self->{amplitude} = $Text::Delirium::default_amplitude;
    }
    bless($self => $class);
}

# ______________________________________
sub __random_color {
    my $self = shift;
    my $palette_len = scalar @{$self->{palette}};
    return $self->{palette}int rand $palette_len;
}

# ______________________________________
sub __random_size {
    my $self  = shift;
    my $delta = int rand($self->{amplitude});
    my $sign  = (int rand(2)) ? "+" : "-";
    if ($delta) {
        return sprintf(' size="%s%d"', $sign, $delta);
    } else {
        return "";
    }
}

# ______________________________________
sub convert_char {
    my $self = shift;
    my $c    = shift;
    my ($r, $rc, $rs);

    if ($c =~ /\s/) {
        $r = $c;
    } else {
        $rc = $self->__random_color();
        $rs = $self->__random_size();
        $r = sprintf(qq{<font%s color="%s">%s</font>}, $rs, $rc, $c);
    }
    return $r;
}

# ______________________________________
sub convert_string {
    my $self = shift;
    my $s    = shift;
    return join("", map { $self->convert_char($_) } split("", $s));
}

# ______________________________________
sub convert_file {
    my $self = shift;
    my $in   = shift || *STDIN;
    my $out  = shift || *STDOUT;

    while (<$in>) {
        print $out $self->convert_string($_);
    }
}

#
#
# "http://ccwf.cc.utexas.edu/~brenna/delirium/index.html";
#
#

package main;
# use Text::Delirium
use HTML::Parser;
use Getopt::Std;

#______________________________________
sub text {
    my $p    = shift;
    my $text = shift;
    print $text;
}

# arg1 -> filter
# arg2 -> file handle
#______________________________________
sub filter_factory {
    my $filter = shift;
    my $stream = shift;
    return sub {
        my $p    = shift;
        my $text = shift;
        print $stream $filter->convert_string($text);
    };
}

my $delirium = filter_factory (
    Text::Delirium->new(),
    *STDOUT,
);

my $p = HTML::Parser->new (
    api_version => 3,
    start_h     => [ \&text,    "self, text" ],
    end_h       => [ \&text,    "self, text" ],
    text_h      => [ $delirium, "self, text" ],
    comment_h   => [ \&text,    "self, text" ],
);
$p->unbroken_text(1);

$p->parse_file(*STDIN);

__END__

=head1 NAME

delirium - filter to make your HTML delirious

=head1 SYNOPSIS

delirium < STDIN > STDOUT

=head1 DESCRIPTION

Each character in the stream is given a pseudo-random size and color.
Basically, it turns:

    blah

into:

    b
    l
    a
    h

It really bloats your HTML by a large factor, but it looks interesting
enough to justify its use on special occasions.

I was inspired to write this script when I saw someone post a very
colourful message on the AfterY2K Forum.

    http://www.geekculture.com/ultimatebb/Forum9/HTML/000018.html

Apparently, he used emacs lisp to do this.  Of course, I used Perl.

=head1 OPTIONS

none, yet.

=head1 SEE ALSO

http://ccwf.cc.utexas.edu/~brenna/delirium/index.html

=head1 AUTHOR

John BEPPU 

=cut

# $Id: delirium,v 1.6 2000/07/04 00:12:19 beppu Exp $

Comment on delirium

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://21070]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (6)
As of 2014-08-29 02:51 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (275 votes), past polls