Text::FIGlet - a perl module to provide FIGlet abilities, akin to banner

Text-FIGlet documentation Contained in the Text-FIGlet distribution.

Index

Code Index:

NAME

Top

Text::FIGlet - a perl module to provide FIGlet abilities, akin to banner

SYNOPSIS

Top

 my $font = Text::FIGlet-E<gt>new(-f=>"doh");
 $font->figify(-A=>"Hello World");

DESCRIPTION

Top

Text::FIGlet reproduces its input using large characters made up of other characters; usually ASCII, but not necessarily. The output is similar to that of many banner programs--although it is not oriented sideways--and reminiscent of the sort of signatures many people like to put at the end of e-mail and UseNet messages.

Text::FIGlet can print in a variety of fonts, both left-to-right and right-to-left, with adjacent characters kerned and smushed together in various ways. FIGlet fonts are stored in separate files, which can be identified by the suffix .flf. Most FIGlet font files will be stored in FIGlet's default font directory /usr/games/lib/figlet. Support for TOIlet fonts *.tlf, which are typically in the same location, has also been added.

Text::FIGlet can also use control files, which tell it to map input characters to others, similar to the Unix tr command. Control files can be identified by the suffix .flc. Most control files will be stored with the system fonts, as some fonts use control files to provide access to foreign character sets.

OPTIONS

Top

new

-C=>controlfile

Creates a control object. Text::File::Control for control object specific options to new, and how to use the object.

-f=>fontfile | \@fonts | \%fonts

Loads fontfile if specified, and creates a font object. Text::File::Font for font object specific options to new, and how to use the object.

With the other forms of -f, a number of fonts can be loaded and blended into a single font as a Text::FIGlet::Ransom object.

-d=>fontdir

Whence to load files.

Defaults to /usr/games/lib/figlet

fontfile and controlfile can be the (absolute or relative) path to the specified file, or simply the name of a file (with or without an extension) present in -d.

new with no options will create a font object using the default font.

EXAMPLES

Top

  perl -MText::FIGlet -e 'print ~~Text::FIGlet->new()->figify(-A=>"Hello World")'

To generate headings for webserver directory listings, for that warm and fuzzy BBS feeling.

Text based clocks or counters at the bottom of web pages.

Anti-bot obfuscation a la AUTHOR.

Other Things to Try

A variety of interesting effects can be obtained from dot-matrix-like fonts such as lean and block by passing them through tr. Hare are some to try:

  tr/|/]/
  tr[ _/][ ()]
  tr[ _/][./\\]
  tr[ _/][ //]
  tr[ _/][/  ]

If you're using FIGlet as some sort of CAPTCHA, or you'd just like a starry background for your text, you might consider adding noise to the results of figify e.g;

  #50% chance of replacing a space with an x
  s/( )/rand()>.5?$1:x/eg

  #50% chance of replacing a space with an entry from @F
  @F = qw/. x */; s/( )/$F[scalar@F*2*rand()]||$1/eg;

  #5% chance of substituting a random ASCII character
  #Note that this may yield unpleasant results if UTF is involved
  s/(.)/rand()<.05?chr(32+rand(94)):$1/eg

ENVIRONMENT

Top

Text::FIGlet will make use of these environment variables if present

FIGFONT

The default font to load. If undefined the default is standard.flf. It should reside in the directory specified by FIGLIB.

FIGLIB

The default location of fonts. If undefined the default is /usr/games/lib/figlet

FILES

Top

FIGlet font files and control files are available at

  ftp://ftp.figlet.org/pub/figlet/

SEE ALSO

Top

Module architecture: http://pthbb.org/manual/software/perl/T-F/

Animated FIGlet: Acme::Curses::Marquee::Extensions

Ancestors: figlet(6) http://www.figlet.org, banner(6), Text::Banner

NOTES

Top

If you are using perl 5.005 and wish to try to acces Unicode characters programatically, or are frustrated by perl 5.6's Unicode support, you may try importing UTF8chr from this module.

This module also offers UTF8ord and UTF8len, which are used internally, but may be of general use. To import all three functions, use the :Encode import tag.

AUTHOR

Top

Jerrad Pierce

                **                                    />>
     _         //                         _  _  _    / >>>
    (_)         **  ,adPPYba,  >< ><<<  _(_)(_)(_)  /   >>>
    | |        /** a8P_____88   ><<    (_)         >>    >>>
    | |  |~~\  /** 8PP"""""""   ><<    (_)         >>>>>>>>
   _/ |  |__/  /** "8b,   ,aa   ><<    (_)_  _  _  >>>>>>> @cpan.org
  |__/   |     /**  `"Ybbd8"'  ><<<      (_)(_)(_) >>
               //                                  >>>>    /
                                                    >>>>>>/
                                                     >>>>>
Text-FIGlet documentation Contained in the Text-FIGlet distribution. 
package Text::FIGlet;
use strict;
use vars qw'$VERSION %RE';
$VERSION = 2.18;               #Actual code version: 2.18

                               #~50us penalty w/ 2 constant calls for 5.005
use constant PRIVb => 0xF0000; #Map neg chars into Unicode's private area
use constant PRIVe => 0xFFFFD; #0-31 are also available but unused.
use Carp qw(carp croak);
use File::Spec;
use File::Basename 'fileparse';
use Text::FIGlet::Control;
use Text::FIGlet::Font;
use Text::FIGlet::Ransom;


if( $] >= 5.008 ){
    require Encode; #Run-time rather than compile-time, without an eval
    import Encode;
}   #Next block from Encode::compat, but broadened from 5.6.1 to 5.6
elsif ($] >= 5.006 and $] <= 5.007) {
    sub Encode::_utf8_on  { $_[0] = pack('U*', unpack('U0U*', $_[0])) }
    sub Encode::_utf8_off { $_[0] = pack('C*', unpack('C*',   $_[0])) }
}
else{
    local $^W = 0;
    eval "sub Encode::_utf8_off{}; sub Encode::_utf8_on{}";
}


my $thByte = '[\x80-\xBF]';
%RE = (
#XXX catch-all . necessary for Unicode/negative char to work :-/
#       UTFchar => qr/([\xC0-\xDF].|[\xE0-\xEF]..|[\xF0-\xFF]...|.)/s,
       UTFchar => qr/([\x20-\x7F]|[\xC2-\xDF]$thByte|[\xE0-\xEF]$thByte{2}|[\xF0-\xF4]$thByte{3})/,
       bytechar=> qr/(.)/s,
       no      => qr/(-?)((0?)(?:x[\da-fA-F]+|\d+))/,
       );


sub import{
  @_ = qw/UTF8chr UTF8ord UTF8len/ if grep(/:Encode/, @_);

  if( @_ ) {
    no strict 'refs';
    *{scalar(caller).'::'.$_} = $_ for grep/UTF8chr|UTF8ord|UTF8len/, @_;
  }
}


sub new {
  local $_;
  my $proto = shift;
  my %opt = @_;
  my($class, @isect, %count);
  my %class = (-f => 'Font', -C => 'Control');


  if( ref($opt{-f}) =~ /ARRAY|HASH/ ){
      $class = 'Text::FIGlet::Ransom';
  }
  else{
      $count{$_}++ for (keys %opt, keys %class);
      $count{$_} == 2 && push(@isect, $_) for keys %count;
      croak("Cannot new both -C and -f") if scalar @isect > 1;
      $class = 'Text::FIGlet::' . $class{shift(@isect) || '-f'};
  }
  $class->new(@_);
}


sub UTF8chr{
  my $ord = shift || $_;
  my @n;

  #x00-x7f        #1 byte
  if( $ord < 0x80 ){ 
    @n = $ord; }
  #x80-x7ff       #2 bytes
  elsif( $ord < 0x800 ){
    @n  = (0xc0|$ord>>6, 0x80|$ord&0x3F ); }
  #x800-xffff     #3 bytes
  elsif( $ord < 0x10000 ){
    @n  = (0xe0|$ord>>12, 
	   0x80|($ord>>6)&0x3F,
	   0x80|$ord&0x3F ); }
  #x10000-x10ffff #4 bytes
  elsif( $ord<0x20000 ){
    @n = (0xf0|$ord>>18,
	  0x80|($ord>>12)&0x3F,
	  0x80|($ord>>6)&0x3F,
	  0x80|$ord&0x3F); }
  else{
    warn "Out of range for UTF-8: $ord"; }

  return pack "C*", @n;
}


sub UTF8len{
  my $str = shift || $_;
  my $thByte = qr/[\x80-\xBF]/;
  #XXX Should perhaps put 1 byte UTF-8 last, as . instead, to catch ANSI-fonts?
  my $count = () = $str =~ m/$Text::FIGlet::RE{UTFchar}/g;
}


sub UTF8ord{
  my $str = shift || $_;
  my $len = length ($str);

  return ord($str) if $len == 1;
  #This is a FIGlet specific error value
  return 128       if $len > 4 || $len == 0;

  my @n = unpack "C*", $str;
  $str  = (($n[-2] & 0x3F) <<  6) + ($n[-1] & 0x3F);
  $str += (($n[-3] & 0x1F) << 12) if $len ==3;
  $str += (($n[-3] & 0x3F) << 12) if $len ==4;
  $str += (($n[-4] & 0x0F) << 18) if $len == 4;
  return $str;
}


sub _no{
  my($one, $two, $thr, $over) = @_;

  my $val = ($one ? -1 : 1) * ( $thr eq 0 ? oct($two) : $two);

  #+2 is to map -2 to offset zero (-1 is forbidden, modern systems have no -0)
  $val += PRIVe + 2 if $one;
  if( $one && $over && $val < PRIVb ){
    carp("Extended character out of bounds");
    return 0;
  }

  $val;
}


sub _canonical{
  my($defdir, $usrfile, $extre, $backslash) = @_;

  my($file, $path, $ext) = fileparse($usrfile, $extre);
  $path =~ y/\\/\// if $backslash;

  my $curdir = File::Spec->catfile(File::Spec->curdir, "");
  $path = $defdir if $path eq $curdir && index($usrfile, $curdir) < 0;

  return File::Spec->catfile($path, $file.$ext);
}

"Act kind of random and practice less beauty sense --ginoh";

__END__