F:\WEBSITES\testbed\zipped\yabb_svn_new\branches\2.5.2\cgi-bin\yabb2\Sources\Captcha.pl F:\WEBSITES\testbed\zipped\yabb_svn_new\trunk\cgi-bin\yabb2\Sources\Captcha.pm
############################################################################### ###############################################################################
# Captcha.pl                                                                  # # Captcha.pm                                                                  #
  # $Date: 01.05.16 $                                                           #
############################################################################### ###############################################################################
# YaBB: Yet another Bulletin Board                                            # # YaBB: Yet another Bulletin Board                                            #
# Open-Source Community Software for Webmasters                               # # Open-Source Community Software for Webmasters                               #
# Version:        YaBB 2.5.2                                                  # # Version:        YaBB 2.6.12                                                 #
# Packaged:       October 21, 2012                                            # # Packaged:       January 5, 2016                                             #
# Distributed by: http://www.yabbforum.com                                    # # Distributed by: http://www.yabbforum.com                                    #
# =========================================================================== # # =========================================================================== #
# Copyright (c) 2000-2012 YaBB (www.yabbforum.com) - All Rights Reserved.     # # Copyright (c) 2000-2016 YaBB (www.yabbforum.com) - All Rights Reserved.     #
# Software by:  The YaBB Development Team                                     # # Software by:  The YaBB Development Team                                     #
#               with assistance from the YaBB community.                      # #               with assistance from the YaBB community.                      #
############################################################################### ###############################################################################
   
$captchaplver = 'YaBB 2.5.2 $Revision: 1.0 $';  
if ($action eq 'detailedversion') { return 1; }  
   
$| = 1;  
   
# Generate GIF image of a message # Generate GIF image of a message
# Version 1.5 # Version 1.5
# by Andrew Gregory # by Andrew Gregory
# 17 February 2007 # 17 February 2007
# #
# http://www.scss.com.au/family/andrew/webdesign/msgimg/ # http://www.scss.com.au/family/andrew/webdesign/msgimg/
# #
# This work is licensed under the Creative Commons # This work is licensed under the Creative Commons
# Attribution-NonCommercial-ShareAlike License. To view a copy of this license, # Attribution-NonCommercial-ShareAlike License. To view a copy of this license,
# visit http://creativecommons.org/licenses/by-nc-sa/1.0/ or send a letter to # visit http://creativecommons.org/licenses/by-nc-sa/1.0/ or send a letter to
# Creative Commons, 559 Nathan Abbott Way, Stanford, California 94305, USA. # Creative Commons, 559 Nathan Abbott Way, Stanford, California 94305, USA.
   
if(!$rgb_foreground){  # use strict; 
   $rgb_foreground = "0000EE";  # use warnings; 
  no warnings qw(uninitialized once redefine);
  use CGI::Carp qw(fatalsToBrowser);
  use English '-no_match_vars';
  our $VERSION = '2.6.12';
   
  $captchapmver = 'YaBB 2.6.12 $Revision: 1651 $';
  if ( $action eq 'detailedversion' ) { return 1; }
   
  $OUTPUT_AUTOFLUSH = 1;
   
  if ( !$rgb_foreground ) {
     $rgb_foreground = '0000EE';
} }
   
if(!$rgb_shade){  if ( !$rgb_shade ) { 
   $rgb_shade = "999999";     $rgb_shade = '999999'; 
} }
   
if(!$rgb_background){  if ( !$rgb_background ) { 
   $rgb_background = "FFFFFF";     $rgb_background = 'FFFFFF'; 
} }
   
sub captcha { sub captcha {
   my $msg = $_[0];     my ($msg) = @_; 
   ## make colors for validation image into hex again ##    ## make colors for validation image into hex again ##
   $rgb_foreground =~ s/\#//g;     $rgb_foreground =~ s/\#//gxsm; 
   $rgb_shade =~ s/\#//g;     $rgb_shade      =~ s/\#//gxsm; 
   $rgb_background =~ s/\#//g;     $rgb_background =~ s/\#//gxsm; 
   $r_f = substr($rgb_foreground,0,2);     $r_f = substr $rgb_foreground, 0, 2; 
   $g_f = substr($rgb_foreground,2,2);     $g_f = substr $rgb_foreground, 2, 2; 
   $b_f = substr($rgb_foreground,4,2);     $b_f = substr $rgb_foreground, 4, 2; 
   $r_s = substr($rgb_shade,0,2);     $r_s = substr $rgb_shade,      0, 2; 
   $g_s = substr($rgb_shade,2,2);     $g_s = substr $rgb_shade,      2, 2; 
   $b_s = substr($rgb_shade,4,2);     $b_s = substr $rgb_shade,      4, 2; 
   $r_b = substr($rgb_background,0,2);     $r_b = substr $rgb_background, 0, 2; 
   $g_b = substr($rgb_background,2,2);     $g_b = substr $rgb_background, 2, 2; 
   $b_b = substr($rgb_background,4,2);     $b_b = substr $rgb_background, 4, 2; 
   
   # color for center cross of the dots (RGB)    # color for center cross of the dots (RGB)
   $highcolor = pack("H2",$r_f);     $highcolor = pack 'H2', $r_f; 
   $highcolor .= pack("H2",$g_f);     $highcolor .= pack 'H2', $g_f; 
   $highcolor .= pack("H2",$b_f);     $highcolor .= pack 'H2', $b_f; 
   
   # color for shade in the dots (RGB)    # color for shade in the dots (RGB)
   $shadecolor = pack("H2",$r_s);     $shadecolor = pack 'H2', $r_s; 
   $shadecolor .= pack("H2",$g_s);     $shadecolor .= pack 'H2', $g_s; 
   $shadecolor .= pack("H2",$b_s);     $shadecolor .= pack 'H2', $b_s; 
   
     # color for background of the dots (RGB)
   # color for background of the dots (RGB)     $backcolor = pack 'H2', $r_b; 
   $backcolor = pack("H2",$r_b);     $backcolor .= pack 'H2', $g_b; 
   $backcolor .= pack("H2",$g_b);     $backcolor .= pack 'H2', $b_b; 
   $backcolor .= pack("H2",$b_b);  
     if   ( !$translayer || $translayer eq '0' ) { $TRANSPARENT_INDEX = "\3"; }
   if (!$translayer || $translayer == "0") { $TRANSPARENT_INDEX = "\3"; }    else                                        { $TRANSPARENT_INDEX = "\0"; }
   else { $TRANSPARENT_INDEX = "\0"; }  
     # Palette
   # Palette  
     $BITS_PER_PIXEL = 7;    # DON'T CHANGE THIS!!!
   $BITS_PER_PIXEL = 7;    # DON'T CHANGE THIS!!!  
  # A note about BITS_PER_PIXEL: GIF data is bit packed. For example, if the code
   # A note about BITS_PER_PIXEL: GIF data is bit packed. For example, if the code  # size is 6 bits, then 4 codes can be packed into 3 bytes. This script does not 
   # size is 6 bits, then 4 codes can be packed into 3 bytes. This script does not  # implement bit packing. 7 bits per pixel translates into 8 bits per code which 
   # implement bit packing. 7 bits per pixel translates into 8 bits per code which  # exactly matches a byte and therefore bit packing is not needed. 
   # exactly matches a byte and therefore bit packing is not needed.  
     $palette .= "$backcolor";     # 0 = white
   $palette .= "$backcolor";     # 0 = white     $palette .= "$shadecolor";    # 1 = grey 
   $palette .= "$shadecolor";    # 1 = grey     $palette .= "$highcolor";     # 2 = almost black 
   $palette .= "$highcolor";     # 2 = almost black  
   
     # Dot definition
     # Defines a dot in terms of palette colours.
   
   # Dot definition     $DOT_WIDTH  = 3; 
   # Defines a dot in terms of palette colours.     $DOT_HEIGHT = 3; 
   
   $DOT_WIDTH  = 3;     $dot = qq~ 
   $DOT_HEIGHT = 3;  
   
   $dot = qq~  
\1\2\1 \1\2\1
\2\2\2 \2\2\2
\1\2\1 \1\2\1
~; ~;
   $nodot = qq~    $nodot = qq~
\0\0\0 \0\0\0
\0\0\0 \0\0\0
\0\0\0 \0\0\0
~; ~;
   
   $invdot = qq~    $invdot = qq~
\1\0\1 \1\0\1
\0\0\0 \0\0\0
\1\0\1 \1\0\1
~; ~;
   $invnodot = qq~    $invnodot = qq~
\1\1\1 \1\1\1
\1\1\1 \1\1\1
\1\1\1 \1\1\1
~; ~;
   
   ###############################################    ###############################################
   ###############################################    ###############################################
   
   # Character definitions    # Character definitions
   my($CHAR_WIDTH, $CHAR_HEIGHT, %ci);     my ( $CHAR_WIDTH, $CHAR_HEIGHT, %ci ); 
   
   $CHAR_WIDTH  = 7;    $CHAR_WIDTH  = 7;
   $CHAR_HEIGHT = 10;    $CHAR_HEIGHT = 10;
   
$ci{' '} = qq~    $ci{' '} = qq~
....... .......
....... .......
....... .......
....... .......
....... .......
....... .......
....... .......
....... .......
....... .......
....... .......
~; ~;
$ci{'!'} = qq~    $ci{'!'} = qq~
....... .......
...X... ...X...
...X... ...X...
...X... ...X...
...X... ...X...
...X... ...X...
....... .......
...X... ...X...
....... .......
....... .......
~; ~;
$ci{'"'} = qq~    $ci{'"'} = qq~
....... .......
..X.X.. ..X.X..
..X.X.. ..X.X..
..X.X.. ..X.X..
....... .......
....... .......
....... .......
....... .......
....... .......
....... .......
~; ~;
$ci{'#'} = qq~    $ci{'#'} = qq~
....... .......
..X.X.. ..X.X..
..X.X.. ..X.X..
.XXXXX. .XXXXX.
..X.X.. ..X.X..
.XXXXX. .XXXXX.
..X.X.. ..X.X..
..X.X.. ..X.X..
....... .......
....... .......
~; ~;
$ci{'$'} = qq~    $ci{'$'} = qq~
....... .......
...X... ...X...
..XXXX. ..XXXX.
.X.X... .X.X...
..XXX.. ..XXX..
...X.X. ...X.X.
.XXXX.. .XXXX..
...X... ...X...
....... .......
....... .......
~; ~;
$ci{'%'} = qq~    $ci{'%'} = qq~
....... .......
.XX.... .XX....
.XX..X. .XX..X.
....X.. ....X..
...X... ...X...
..X.... ..X....
.X..XX. .X..XX.
....XX. ....XX.
....... .......
....... .......
~; ~;
$ci{'&'} = qq~    $ci{'&'} = qq~
....... .......
..X.... ..X....
.X.X... .X.X...
.X.X... .X.X...
..X.... ..X....
.X.X.X. .X.X.X.
.X..X.. .X..X..
..XX.X. ..XX.X.
....... .......
....... .......
~; ~;
$ci{'\''} = qq~    $ci{'\x27'} = qq~
....... .......
...X... ...X...
...X... ...X...
...X... ...X...
....... .......
....... .......
....... .......
....... .......
....... .......
....... .......
~; ~;
$ci{'('} = qq~    $ci{'('} = qq~
....... .......
....X.. ....X..
...X... ...X...
..X.... ..X....
..X.... ..X....
..X.... ..X....
...X... ...X...
....X.. ....X..
....... .......
....... .......
~; ~;
$ci{')'} = qq~    $ci{')'} = qq~
....... .......
..X.... ..X....
...X... ...X...
....X.. ....X..
....X.. ....X..
....X.. ....X..
...X... ...X...
..X.... ..X....
....... .......
....... .......
~; ~;
$ci{'*'} = qq~    $ci{'*'} = qq~
....... .......
...X... ...X...
.X.X.X. .X.X.X.
..XXX.. ..XXX..
...X... ...X...
..XXX.. ..XXX..
.X.X.X. .X.X.X.
...X... ...X...
....... .......
....... .......
~; ~;
$ci{'+'} = qq~    $ci{'+'} = qq~
....... .......
....... .......
...X... ...X...
...X... ...X...
.XXXXX. .XXXXX.
...X... ...X...
...X... ...X...
....... .......
....... .......
....... .......
~; ~;
$ci{','} = qq~    $ci{','} = qq~
....... .......
....... .......
....... .......
....... .......
....... .......
....... .......
...X... ...X...
...X... ...X...
..X.... ..X....
....... .......
~; ~;
$ci{'-'} = qq~    $ci{'-'} = qq~
....... .......
....... .......
....... .......
....... .......
.XXXXX. .XXXXX.
....... .......
....... .......
....... .......
....... .......
....... .......
~; ~;
$ci{'.'} = qq~    $ci{'.'} = qq~
....... .......
....... .......
....... .......
....... .......
....... .......
....... .......
....... .......
...X... ...X...
....... .......
....... .......
~; ~;
$ci{'/'} = qq~    $ci{'/'} = qq~
....... .......
....... .......
.....X. .....X.
....X.. ....X..
...X... ...X...
..X.... ..X....
.X..... .X.....
....... .......
....... .......
....... .......
~; ~;
$ci{':'} = qq~    $ci{':'} = qq~
....... .......
....... .......
....... .......
....... .......
...X... ...X...
....... .......
...X... ...X...
....... .......
....... .......
....... .......
~; ~;
$ci{';'} = qq~    $ci{';'} = qq~
....... .......
....... .......
....... .......
....... .......
...X... ...X...
....... .......
...X... ...X...
...X... ...X...
..X.... ..X....
....... .......
~; ~;
$ci{'<'} = qq~    $ci{'<'} = qq~
....... .......
....X.. ....X..
...X... ...X...
..X.... ..X....
.X..... .X.....
..X.... ..X....
...X... ...X...
....X.. ....X..
....... .......
....... .......
~; ~;
$ci{'='} = qq~    $ci{'='} = qq~
....... .......
....... .......
....... .......
.XXXXX. .XXXXX.
....... .......
.XXXXX. .XXXXX.
....... .......
....... .......
....... .......
....... .......
~; ~;
$ci{'>'} = qq~    $ci{'>'} = qq~
....... .......
..X.... ..X....
...X... ...X...
....X.. ....X..
.....X. .....X.
....X.. ....X..
...X... ...X...
..X.... ..X....
....... .......
....... .......
~; ~;
$ci{'?'} = qq~    $ci{'?'} = qq~
....... .......
..XXX.. ..XXX..
.X...X. .X...X.
....X.. ....X..
...X... ...X...
...X... ...X...
....... .......
...X... ...X...
....... .......
....... .......
~; ~;
$ci{'@'} = qq~    $ci{'@'} = qq~
....... .......
..XXX.. ..XXX..
.X...X. .X...X.
.X.X.X. .X.X.X.
.X.XXX. .X.XXX.
.X.XX.. .X.XX..
.X..... .X.....
..XXXX. ..XXXX.
....... .......
....... .......
~; ~;
$ci{'['} = qq~    $ci{'['} = qq~
....... .......
.XXXXX. .XXXXX.
.XX.... .XX....
.XX.... .XX....
.XX.... .XX....
.XX.... .XX....
.XX.... .XX....
.XXXXX. .XXXXX.
....... .......
....... .......
~; ~;
$ci{'\\'} = qq~    $ci{'\\'} = qq~
....... .......
....... .......
.X..... .X.....
..X.... ..X....
...X... ...X...
....X.. ....X..
.....X. .....X.
....... .......
....... .......
....... .......
~; ~;
$ci{']'} = qq~    $ci{']'} = qq~
....... .......
.XXXXX. .XXXXX.
....XX. ....XX.
....XX. ....XX.
....XX. ....XX.
....XX. ....XX.
....XX. ....XX.
.XXXXX. .XXXXX.
....... .......
....... .......
~; ~;
$ci{'^'} = qq~    $ci{'^'} = qq~
....... .......
....... .......
....... .......
...X... ...X...
..X.X.. ..X.X..
.X...X. .X...X.
....... .......
....... .......
....... .......
....... .......
~; ~;
$ci{'_'} = qq~    $ci{'_'} = qq~
....... .......
....... .......
....... .......
....... .......
....... .......
....... .......
....... .......
.XXXXX. .XXXXX.
....... .......
....... .......
~; ~;
$ci{'`'} = qq~    $ci{'`'} = qq~
....... .......
...X... ...X...
...X... ...X...
....X.. ....X..
....... .......
....... .......
....... .......
....... .......
....... .......
....... .......
~; ~;
$ci{'{'} = qq~    $ci{'{'} = qq~
....... .......
....XX. ....XX.
...X... ...X...
...X... ...X...
..X.... ..X....
...X... ...X...
...X... ...X...
....XX. ....XX.
....... .......
....... .......
~; ~;
$ci{'|'} = qq~    $ci{'|'} = qq~
....... .......
...X... ...X...
...X... ...X...
...X... ...X...
....... .......
...X... ...X...
...X... ...X...
...X... ...X...
....... .......
....... .......
~; ~;
$ci{'}'} = qq~    $ci{'}'} = qq~
....... .......
..XX... ..XX...
....X.. ....X..
....X.. ....X..
.....X. .....X.
....X.. ....X..
....X.. ....X..
..XX... ..XX...
....... .......
....... .......
~; ~;
$ci{'~'} = qq~    $ci{'~'} = qq~
....... .......
..X.... ..X....
.X.X.X. .X.X.X.
....X.. ....X..
....... .......
....... .......
....... .......
....... .......
....... .......
....... .......
~; ~;
$ci{'0'} = qq~    $ci{'0'} = qq~
....... .......
..XXX.. ..XXX..
.X...X. .X...X.
.X..XX. .X..XX.
.X.X.X. .X.X.X.
.XX..X. .XX..X.
.X...X. .X...X.
..XXX.. ..XXX..
....... .......
....... .......
~; ~;
$ci{'1'} = qq~    $ci{'1'} = qq~
....... .......
...X... ...X...
..XX... ..XX...
...X... ...X...
...X... ...X...
...X... ...X...
...X... ...X...
..XXX.. ..XXX..
....... .......
....... .......
~; ~;
$ci{'2'} = qq~    $ci{'2'} = qq~
....... .......
..XXX.. ..XXX..
.X...X. .X...X.
.....X. .....X.
...XX.. ...XX..
..X.... ..X....
.X..... .X.....
.XXXXX. .XXXXX.
....... .......
....... .......
~; ~;
$ci{'3'} = qq~    $ci{'3'} = qq~
....... .......
.XXXXX. .XXXXX.
.....X. .....X.
....X.. ....X..
...XX.. ...XX..
.....X. .....X.
.X...X. .X...X.
..XXX.. ..XXX..
....... .......
....... .......
~; ~;
$ci{'4'} = qq~    $ci{'4'} = qq~
....... .......
....X.. ....X..
...XX.. ...XX..
..X.X.. ..X.X..
.X..X.. .X..X..
.XXXXX. .XXXXX.
....X.. ....X..
....X.. ....X..
....... .......
....... .......
~; ~;
$ci{'5'} = qq~    $ci{'5'} = qq~
....... .......
.XXXXX. .XXXXX.
.X..... .X.....
.XXXX.. .XXXX..
.....X. .....X.
.....X. .....X.
.X...X. .X...X.
..XXX.. ..XXX..
....... .......
....... .......
~; ~;
$ci{'6'} = qq~    $ci{'6'} = qq~
....... .......
...XXX. ...XXX.
..X.... ..X....
.X..... .X.....
.XXXX.. .XXXX..
.X...X. .X...X.
.X...X. .X...X.
..XXX.. ..XXX..
....... .......
....... .......
~; ~;
$ci{'7'} = qq~    $ci{'7'} = qq~
....... .......
.XXXXX. .XXXXX.
.....X. .....X.
....X.. ....X..
...X... ...X...
..X.... ..X....
..X.... ..X....
..X.... ..X....
....... .......
....... .......
~; ~;
$ci{'8'} = qq~    $ci{'8'} = qq~
....... .......
..XXX.. ..XXX..
.X...X. .X...X.
.X...X. .X...X.
..XXX.. ..XXX..
.X...X. .X...X.
.X...X. .X...X.
..XXX.. ..XXX..
....... .......
....... .......
~; ~;
$ci{'9'} = qq~    $ci{'9'} = qq~
....... .......
..XXX.. ..XXX..
.X...X. .X...X.
.X...X. .X...X.
..XXXX. ..XXXX.
.....X. .....X.
....X.. ....X..
.XXX... .XXX...
....... .......
....... .......
~; ~;
$ci{'A'} = qq~    $ci{'A'} = qq~
....... .......
...X... ...X...
..X.X.. ..X.X..
.X...X. .X...X.
.X...X. .X...X.
.XXXXX. .XXXXX.
.X...X. .X...X.
.X...X. .X...X.
....... .......
....... .......
~; ~;
$ci{'a'} = qq~    $ci{'a'} = qq~
....... .......
....... .......
....... .......
..XXX.. ..XXX..
.....X. .....X.
..XXXX. ..XXXX.
.X...X. .X...X.
..XXXX. ..XXXX.
....... .......
....... .......
~; ~;
$ci{'B'} = qq~    $ci{'B'} = qq~
....... .......
.XXXX.. .XXXX..
.X...X. .X...X.
.X...X. .X...X.
.XXXX.. .XXXX..
.X...X. .X...X.
.X...X. .X...X.
.XXXX.. .XXXX..
....... .......
....... .......
~; ~;
$ci{'b'} = qq~    $ci{'b'} = qq~
....... .......
.X..... .X.....
.X..... .X.....
.XXXX.. .XXXX..
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
.XXXX.. .XXXX..
....... .......
....... .......
~; ~;
$ci{'C'} = qq~    $ci{'C'} = qq~
....... .......
..XXX.. ..XXX..
.X...X. .X...X.
.X..... .X.....
.X..... .X.....
.X..... .X.....
.X...X. .X...X.
..XXX.. ..XXX..
....... .......
....... .......
~; ~;
$ci{'c'} = qq~    $ci{'c'} = qq~
....... .......
....... .......
....... .......
..XXXX. ..XXXX.
.X..... .X.....
.X..... .X.....
.X..... .X.....
..XXXX. ..XXXX.
....... .......
....... .......
~; ~;
$ci{'D'} = qq~    $ci{'D'} = qq~
....... .......
.XXXX.. .XXXX..
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
.XXXX.. .XXXX..
....... .......
....... .......
~; ~;
$ci{'d'} = qq~    $ci{'d'} = qq~
....... .......
.....X. .....X.
.....X. .....X.
..XXXX. ..XXXX.
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
..XXXX. ..XXXX.
....... .......
....... .......
~; ~;
$ci{'E'} = qq~    $ci{'E'} = qq~
....... .......
.XXXXX. .XXXXX.
.X..... .X.....
.X..... .X.....
.XXXX.. .XXXX..
.X..... .X.....
.X..... .X.....
.XXXXX. .XXXXX.
....... .......
....... .......
~; ~;
$ci{'e'} = qq~    $ci{'e'} = qq~
....... .......
....... .......
....... .......
..XXX.. ..XXX..
.X...X. .X...X.
.XXXXX. .XXXXX.
.X..... .X.....
..XXXX. ..XXXX.
....... .......
....... .......
~; ~;
$ci{'F'} = qq~    $ci{'F'} = qq~
....... .......
.XXXXX. .XXXXX.
.X..... .X.....
.X..... .X.....
.XXXX.. .XXXX..
.X..... .X.....
.X..... .X.....
.X..... .X.....
....... .......
....... .......
~; ~;
$ci{'f'} = qq~    $ci{'f'} = qq~
....... .......
...XX.. ...XX..
..X..X. ..X..X.
..X.... ..X....
.XXXX.. .XXXX..
..X.... ..X....
..X.... ..X....
..X.... ..X....
....... .......
....... .......
~; ~;
$ci{'G'} = qq~    $ci{'G'} = qq~
....... .......
..XXXX. ..XXXX.
.X..... .X.....
.X..... .X.....
.X..... .X.....
.X..XX. .X..XX.
.X...X. .X...X.
..XXXX. ..XXXX.
....... .......
....... .......
~; ~;
$ci{'g'} = qq~    $ci{'g'} = qq~
....... .......
....... .......
....... .......
..XXX.. ..XXX..
.X...X. .X...X.
.X...X. .X...X.
..XXXX. ..XXXX.
.....X. .....X.
..XXX.. ..XXX..
....... .......
~; ~;
$ci{'H'} = qq~    $ci{'H'} = qq~
....... .......
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
.XXXXX. .XXXXX.
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
....... .......
....... .......
~; ~;
$ci{'h'} = qq~    $ci{'h'} = qq~
....... .......
.X..... .X.....
.X..... .X.....
.XXXX.. .XXXX..
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
....... .......
....... .......
~; ~;
$ci{'I'} = qq~    $ci{'I'} = qq~
....... .......
..XXX.. ..XXX..
...X... ...X...
...X... ...X...
...X... ...X...
...X... ...X...
...X... ...X...
..XXX.. ..XXX..
....... .......
....... .......
~; ~;
$ci{'i'} = qq~    $ci{'i'} = qq~
....... .......
...X... ...X...
....... .......
..XX... ..XX...
...X... ...X...
...X... ...X...
...X... ...X...
..XXX.. ..XXX..
....... .......
....... .......
~; ~;
$ci{'J'} = qq~    $ci{'J'} = qq~
....... .......
.....X. .....X.
.....X. .....X.
.....X. .....X.
.....X. .....X.
.....X. .....X.
.X...X. .X...X.
..XXX.. ..XXX..
....... .......
....... .......
~; ~;
$ci{'j'} = qq~    $ci{'j'} = qq~
....... .......
....X.. ....X..
....... .......
...XX.. ...XX..
....X.. ....X..
....X.. ....X..
....X.. ....X..
.X..X.. .X..X..
..XX... ..XX...
....... .......
~; ~;
$ci{'K'} = qq~    $ci{'K'} = qq~
....... .......
.X...X. .X...X.
.X..X.. .X..X..
.X.X... .X.X...
.XX.... .XX....
.X.X... .X.X...
.X..X.. .X..X..
.X...X. .X...X.
....... .......
....... .......
~; ~;
$ci{'k'} = qq~    $ci{'k'} = qq~
....... .......
.X..... .X.....
.X..... .X.....
.X...X. .X...X.
.X..X.. .X..X..
.XXX... .XXX...
.X..X.. .X..X..
.X...X. .X...X.
....... .......
....... .......
~; ~;
$ci{'L'} = qq~    $ci{'L'} = qq~
....... .......
.X..... .X.....
.X..... .X.....
.X..... .X.....
.X..... .X.....
.X..... .X.....
.X..... .X.....
.XXXXX. .XXXXX.
....... .......
....... .......
~; ~;
$ci{'l'} = qq~    $ci{'l'} = qq~
....... .......
..XX... ..XX...
...X... ...X...
...X... ...X...
...X... ...X...
...X... ...X...
...X... ...X...
..XXX.. ..XXX..
....... .......
....... .......
~; ~;
$ci{'M'} = qq~    $ci{'M'} = qq~
....... .......
.X...X. .X...X.
.XX.XX. .XX.XX.
.X.X.X. .X.X.X.
.X.X.X. .X.X.X.
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
....... .......
....... .......
~; ~;
$ci{'m'} = qq~    $ci{'m'} = qq~
....... .......
....... .......
....... .......
.XX.XX. .XX.XX.
.X.X.X. .X.X.X.
.X.X.X. .X.X.X.
.X.X.X. .X.X.X.
.X...X. .X...X.
....... .......
....... .......
~; ~;
$ci{'N'} = qq~    $ci{'N'} = qq~
....... .......
.X...X. .X...X.
.X...X. .X...X.
.XX..X. .XX..X.
.X.X.X. .X.X.X.
.X..XX. .X..XX.
.X...X. .X...X.
.X...X. .X...X.
....... .......
....... .......
~; ~;
$ci{'n'} = qq~    $ci{'n'} = qq~
....... .......
....... .......
....... .......
.XXXX.. .XXXX..
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
....... .......
....... .......
~; ~;
$ci{'O'} = qq~    $ci{'O'} = qq~
....... .......
..XXX.. ..XXX..
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
..XXX.. ..XXX..
....... .......
....... .......
~; ~;
$ci{'o'} = qq~    $ci{'o'} = qq~
....... .......
....... .......
....... .......
..XXX.. ..XXX..
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
..XXX.. ..XXX..
....... .......
....... .......
~; ~;
$ci{'P'} = qq~    $ci{'P'} = qq~
....... .......
.XXXX.. .XXXX..
.X...X. .X...X.
.X...X. .X...X.
.XXXX.. .XXXX..
.X..... .X.....
.X..... .X.....
.X..... .X.....
....... .......
....... .......
~; ~;
$ci{'p'} = qq~    $ci{'p'} = qq~
....... .......
....... .......
....... .......
.XXXX.. .XXXX..
.X...X. .X...X.
.X...X. .X...X.
.XXXX.. .XXXX..
.X..... .X.....
.X..... .X.....
....... .......
~; ~;
$ci{'Q'} = qq~    $ci{'Q'} = qq~
....... .......
..XXX.. ..XXX..
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
.X.X.X. .X.X.X.
.X..X.. .X..X..
..XX.X. ..XX.X.
....... .......
....... .......
~; ~;
$ci{'q'} = qq~    $ci{'q'} = qq~
....... .......
....... .......
....... .......
..XXXX. ..XXXX.
.X...X. .X...X.
.X...X. .X...X.
..XXXX. ..XXXX.
.....X. .....X.
.....X. .....X.
....... .......
~; ~;
$ci{'R'} = qq~    $ci{'R'} = qq~
....... .......
.XXXX.. .XXXX..
.X...X. .X...X.
.X...X. .X...X.
.XXXX.. .XXXX..
.X.X... .X.X...
.X..X.. .X..X..
.X...X. .X...X.
....... .......
....... .......
~; ~;
$ci{'r'} = qq~    $ci{'r'} = qq~
....... .......
....... .......
....... .......
.X.XXX. .X.XXX.
.XX.... .XX....
.X..... .X.....
.X..... .X.....
.X..... .X.....
....... .......
....... .......
~; ~;
$ci{'S'} = qq~    $ci{'S'} = qq~
....... .......
..XXX.. ..XXX..
.X...X. .X...X.
.X..... .X.....
..XXX.. ..XXX..
.....X. .....X.
.X...X. .X...X.
..XXX.. ..XXX..
....... .......
....... .......
~; ~;
$ci{'s'} = qq~    $ci{'s'} = qq~
....... .......
....... .......
....... .......
..XXXX. ..XXXX.
.X..... .X.....
..XXX.. ..XXX..
.....X. .....X.
.XXXX.. .XXXX..
....... .......
....... .......
~; ~;
$ci{'T'} = qq~    $ci{'T'} = qq~
....... .......
.XXXXX. .XXXXX.
...X... ...X...
...X... ...X...
...X... ...X...
...X... ...X...
...X... ...X...
...X... ...X...
....... .......
....... .......
~; ~;
$ci{'t'} = qq~    $ci{'t'} = qq~
....... .......
..X.... ..X....
.XXXX.. .XXXX..
..X.... ..X....
..X.... ..X....
..X.... ..X....
..X..X. ..X..X.
...XX.. ...XX..
....... .......
....... .......
~; ~;
$ci{'U'} = qq~    $ci{'U'} = qq~
....... .......
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
..XXX.. ..XXX..
....... .......
....... .......
~; ~;
$ci{'u'} = qq~    $ci{'u'} = qq~
....... .......
....... .......
....... .......
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
.X..XX. .X..XX.
..XX.X. ..XX.X.
....... .......
....... .......
~; ~;
$ci{'V'} = qq~    $ci{'V'} = qq~
....... .......
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
..X.X.. ..X.X..
...X... ...X...
....... .......
....... .......
~; ~;
$ci{'v'} = qq~    $ci{'v'} = qq~
....... .......
....... .......
....... .......
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
..X.X.. ..X.X..
...X... ...X...
....... .......
....... .......
~; ~;
$ci{'W'} = qq~    $ci{'W'} = qq~
....... .......
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
.X.X.X. .X.X.X.
.X.X.X. .X.X.X.
.XX.XX. .XX.XX.
..X.X.. ..X.X..
....... .......
....... .......
~; ~;
$ci{'w'} = qq~    $ci{'w'} = qq~
....... .......
....... .......
....... .......
.X...X. .X...X.
.X...X. .X...X.
.X.X.X. .X.X.X.
.X.X.X. .X.X.X.
..X.X.. ..X.X..
....... .......
....... .......
~; ~;
$ci{'X'} = qq~    $ci{'X'} = qq~
....... .......
.X...X. .X...X.
.X...X. .X...X.
..X.X.. ..X.X..
...X... ...X...
..X.X.. ..X.X..
.X...X. .X...X.
.X...X. .X...X.
....... .......
....... .......
~; ~;
$ci{'x'} = qq~    $ci{'x'} = qq~
....... .......
....... .......
....... .......
.X...X. .X...X.
..X.X.. ..X.X..
...X... ...X...
..X.X.. ..X.X..
.X...X. .X...X.
....... .......
....... .......
~; ~;
$ci{'Y'} = qq~    $ci{'Y'} = qq~
....... .......
.X...X. .X...X.
.X...X. .X...X.
..X.X.. ..X.X..
...X... ...X...
...X... ...X...
...X... ...X...
...X... ...X...
....... .......
....... .......
~; ~;
$ci{'y'} = qq~    $ci{'y'} = qq~
....... .......
....... .......
....... .......
.X...X. .X...X.
.X...X. .X...X.
.X...X. .X...X.
..XXXX. ..XXXX.
.....X. .....X.
..XXX.. ..XXX..
....... .......
~; ~;
$ci{'Z'} = qq~    $ci{'Z'} = qq~
....... .......
.XXXXX. .XXXXX.
.....X. .....X.
....X.. ....X..
...X... ...X...
..X.... ..X....
.X..... .X.....
.XXXXX. .XXXXX.
....... .......
....... .......
~; ~;
$ci{'z'} = qq~    $ci{'z'} = qq~
....... .......
....... .......
....... .......
.XXXXX. .XXXXX.
....X.. ....X..
...X... ...X...
..X.... ..X....
.XXXXX. .XXXXX.
....... .......
....... .......
~; ~;
   
   ###############################################    ###############################################
   
   my ($nl, @lines, $len, $w, $h, $LINE_HEIGHT, $BLOCK_LIMIT);     my ( $nl, @lines, $len, $w, $h, $LINE_HEIGHT, $BLOCK_LIMIT ); 
   
   # to measure length of the 'newline' character (cross platform LF vs CR+LF ???) # to measure length of the 'newline' character (cross platform LF vs CR+LF ???)
   $nl = length qq~    $nl = length qq~
~; ~;
   
   $LINE_HEIGHT = $CHAR_HEIGHT * $DOT_HEIGHT;    $LINE_HEIGHT = $CHAR_HEIGHT * $DOT_HEIGHT;
   @lines = split("\n", $msg);     @lines       = split /\n/xsm, $msg; 
   $len = 0;    $len         = 0;
   foreach (@lines) { $len = length $_ if (length $_ > $len); }     foreach (@lines) { 
   $w = $len * $CHAR_WIDTH * $DOT_WIDTH;         if ( length $_ > $len ) { $len = length $_; } 
   $h = @lines * $LINE_HEIGHT;     } 
   # LZW block limit - cannot allow the LZW code size to change from the initial     $w = $len * $CHAR_WIDTH * $DOT_WIDTH; 
   # code size (we can't know when the code size will change because we aren't     $h = @lines * $LINE_HEIGHT; 
   # implementing compression). The 3 is a fudge factor.  
   $BLOCK_LIMIT = 2**$BITS_PER_PIXEL - 3;    # LZW block limit - cannot allow the LZW code size to change from the initial 
    # code size (we can't know when the code size will change because we aren't
   # Implementation notes:    # implementing compression). The 3 is a fudge factor. 
   # * Image is NOT compressed! - Does not use LZW compression!     $BLOCK_LIMIT = 2**$BITS_PER_PIXEL - 3; 
   # * For ease of output things are arranged so that the expected LZW code size is  
   #   always 8 bits. The initial LZW code size is determined by the number of bits  # Implementation notes: 
   #   required to represent all possible colour indices, plus two additional codes  # * Image is NOT compressed! - Does not use LZW compression! 
   #   used to (1) reset the LZW decode table and (2) mark the end of LZW data. By  # * For ease of output things are arranged so that the expected LZW code size is 
   #   selecting a 128 entry colour table, the total of 130 initial LZW codes  #   always 8 bits. The initial LZW code size is determined by the number of bits 
   #   require 8 bits. During output, the decoding table is reset at regular  #   required to represent all possible colour indices, plus two additional codes 
   #   intervals to prevent it from adding so many entries that the decoder would  #   used to (1) reset the LZW decode table and (2) mark the end of LZW data. By 
   #   increase the expected code size to 9 bits.  #   selecting a 128 entry colour table, the total of 130 initial LZW codes 
  #   require 8 bits. During output, the decoding table is reset at regular
   # GIF Signature  #   intervals to prevent it from adding so many entries that the decoder would 
   print 'Content-type: image/gif', "\x0A\x0A";  #   increase the expected code size to 9 bits. 
   
   # Screen Descriptor     # GIF Signature 
   print $TRANSPARENT_INDEX ? 'GIF89a' : 'GIF87a';     print 'Content-type: image/gif', "\n\n" or croak "$croak{'print'}"; 
   
   # width, height     # Screen Descriptor 
   print pack 'v2', $w, $h;     print $TRANSPARENT_INDEX ? 'GIF89a' : 'GIF87a' or croak "$croak{'print'}"; 
   
   # global colour map, 8 bits colour resolution, 7 bits per pixel     # width, height 
   print pack 'C1', 0xF0 + $BITS_PER_PIXEL - 1;     print pack 'v2', $w, $h or croak "$croak{'print'}"; 
   
   # background colour = 0     # global colour map, 8 bits colour resolution, 7 bits per pixel 
   print "\0";     print pack 'C1', 0xF0 + $BITS_PER_PIXEL - 1 or croak "$croak{'print'}"; 
   
   # reserved     # background colour = 0 
   print "\0";     print "\0" or croak "$croak{'print'}"; 
   
   # Global Colour Map     # reserved 
   print $palette;     print "\0" or croak "$croak{'print'}"; 
   print "\0" x ((2**$BITS_PER_PIXEL * 3) - length $palette);  
     # Global Colour Map
   if ($TRANSPARENT_INDEX) {     print $palette or croak "$croak{'print'}"; 
       # Graphic Control Extension     print "\0" x ( ( 2**$BITS_PER_PIXEL * 3 ) - length $palette ) or croak "$croak{'print'}"; 
       # extension introducer  
       print "\x21";     if ($TRANSPARENT_INDEX) { 
       # graphic control label  
       print "\xF9";         # Graphic Control Extension 
       # block size         # extension introducer 
       print "\x04";         print "\x21" or croak "$croak{'print'}"; 
       # no disposal method, no user input, transparent colour present  
       print "\x01";         # graphic control label 
       # delay time         print "\xF9" or croak "$croak{'print'}"; 
       print "\0\0";  
       # transparent colour index         # block size 
       print $TRANSPARENT_INDEX;         print "\x04" or croak "$croak{'print'}"; 
       # block terminator  
       print "\0";         # no disposal method, no user input, transparent colour present 
   }         print "\x01" or croak "$croak{'print'}"; 
   
   # Image Descriptor         # delay time 
         print "\0\0" or croak "$croak{'print'}";
   # image separator  
   print ',';         # transparent colour index 
         print $TRANSPARENT_INDEX or croak "$croak{'print'}";
   # left, top  
   print "\0\0\0\0";         # block terminator 
         print "\0" or croak "$croak{'print'}";
   # width, height     } 
   print pack 'v2', $w, $h;  
     # Image Descriptor
   # use global colour map (not local), sequential (not interlaced)  
   print "\0";     # image separator 
     print q{,} or croak "$croak{'print'}";
   # Raster Data  
     # left, top
   # code size     print "\0\0\0\0" or croak "$croak{'print'}"; 
   print pack 'C', $BITS_PER_PIXEL;  
     # width, height
   # the data is output in blocks with a leading byte count     print pack 'v2', $w, $h or croak "$croak{'print'}"; 
   my ($img, $line, $random_number);  
   my ($y, $cy, $dy);     # use global colour map (not local), sequential (not interlaced) 
   my ($x, $cx, $i, $c, $d, $di, $r);     print "\0" or croak "$croak{'print'}"; 
   $range = 10;  
   for ($y = 0; $y < $h; $y++) {     # Raster Data 
       $cy = int($y / $DOT_HEIGHT) % $CHAR_HEIGHT; # y coord in character dots  
       $dy = $y % $DOT_HEIGHT;     # code size 
       for ($x = 0; $x < $w; $x += $DOT_WIDTH) {     print pack 'C', $BITS_PER_PIXEL or croak "$croak{'print'}"; 
           $random_number = int(rand($range));  
           $cx = int($x / $DOT_WIDTH) % $CHAR_WIDTH; # x coord in character dots     # the data is output in blocks with a leading byte count 
           $i = int($x / $DOT_WIDTH / $CHAR_WIDTH); # index into message string     my ( $img, $line, $random_number ); 
           $line = $lines[$y / $LINE_HEIGHT];     my ( $y,   $cy,   $dy ); 
           $c = ($i < length $line) ? substr $line, $i, 1 : ' ';     my ( $x,   $cx,   $i, $c, $d, $di, $r ); 
           $d = substr $ci{$c}, $cy * ($CHAR_WIDTH + $nl) + $cx + $nl, 1; # dot in character definition     $range = 10; 
           if ($distortion > 0) {    for my $y ( 0 .. ( $h - 1 ) ) {
               $dis_level = 9 - $distortion;         $cy = 
               if ($random_number <= $dis_level) { $di = ($d eq 'X') ? $dot : $nodot;} elsif ($random_number > $dis_level){ $di = ($d eq 'X') ? $dot : $invnodot;}           int( $y / $DOT_HEIGHT ) % $CHAR_HEIGHT;    # y coord in character dots 
           } else {         $dy = $y % $DOT_HEIGHT; 
               $di = ($d eq 'X') ? $dot : $nodot;         for ( $x = 0 ; $x < $w ; $x += $DOT_WIDTH ) { 
           }             $random_number = int rand $range; 
           $di = substr $di, $dy * ($DOT_WIDTH + $nl) + $nl, $DOT_WIDTH;             $cx = 
           for ($i = 0; $i < length $di; $i++) {               int( $x / $DOT_WIDTH ) % $CHAR_WIDTH;  # x coord in character dots 
               $c = ord substr $di, $i, 1;             $i = 
               if ($randomizer > 0) {               int( $x / $DOT_WIDTH / $CHAR_WIDTH );  # index into message string 
                   # Start of randomizer - comment this block out if you don't like it!             $line = $lines[ $y / $LINE_HEIGHT ]; 
                   if($randomizer == 1){$rc1 = 1; $rc2 = 1;}             $c    = ( $i < length $line ) ? substr $line, $i, 1 : q{ }; 
                   if($randomizer == 2){$rc1 = 2; $rc2 = 2;}             $d    = substr $ci{$c}, $cy * ( $CHAR_WIDTH + $nl ) + $cx + $nl, 1; 
                   if($randomizer == 3){$rc1 = 1; $rc2 = 2;}                # dot in character definition 
                   $r = rand;             if ( $distortion > 0 ) { 
                   if ($r < .1) {                 $dis_level = 9 - $distortion; 
                       $c += $rc1;                 if ( $random_number <= $dis_level ) { 
                   } elsif ($r > .9) {                     $di = ( $d eq 'X' ) ? $dot : $nodot; 
                       $c += $rc2;                 } 
                   }                 elsif ( $random_number > $dis_level ) { 
                   # End of randomizer                     $di = ( $d eq 'X' ) ? $dot : $invnodot; 
               }                }
               $c = chr $c;             } 
               $img .= $c;             else { 
           }                 $di = ( $d eq 'X' ) ? $dot : $nodot; 
       }            }
   }             $di = substr $di, $dy * ( $DOT_WIDTH + $nl ) + $nl, $DOT_WIDTH; 
             for my $i ( 0 .. ( length $di - 1 ) ) {
   # Re-arrange the image data so it's bit-packed                 $c = ord substr $di, $i, 1; 
   my ($cnt, $pkdimg, $buf, $bufbits);                 if ( $randomizer > 0 ) { 
   $i = 0;  
   $buf = 0;             # Start of randomizer - comment this block out if you don't like it! 
   $bufbits = 0;                     if ( $randomizer == 1 ) { $rc1 = 1; $rc2 = 1; } 
   while ($i <= length $img) {                     if ( $randomizer == 2 ) { $rc1 = 2; $rc2 = 2; } 
       if ($i < length $img) {                     if ( $randomizer == 3 ) { $rc1 = 1; $rc2 = 2; } 
           # Output each pixel                     $r = rand; 
           $c = ord substr $img, $i, 1;                     if ( $r < .1 ) { 
           $c &= 2**$BITS_PER_PIXEL-1;                         $c += $rc1; 
           $buf |= $c << $bufbits;                     } 
           $bufbits += $BITS_PER_PIXEL + 1;                     elsif ( $r > .9 ) { 
           $i++;                         $c += $rc2; 
           # Insert LZW table clear code before the decoder will grow the bit size                     } 
           # The minus 2 is a fudge factor  
           if ($i % (2**$BITS_PER_PIXEL-2) == 0) {                     # End of randomizer 
               $c = 2**$BITS_PER_PIXEL;                 } 
               $buf |= $c << $bufbits;                 $c = chr $c; 
               $bufbits += $BITS_PER_PIXEL + 1;                 $img .= $c; 
           }            }
       } else {         } 
           #Output LZW end code     } 
           $c = 2**$BITS_PER_PIXEL+1;  
           $buf |= $c << $bufbits;     # Re-arrange the image data so it's bit-packed 
           $bufbits += $BITS_PER_PIXEL + 1;     my ( $cnt, $pkdimg, $buf, $bufbits ); 
           $i++;     $i       = 0; 
       }     $buf     = 0; 
       while ($bufbits >= 8) {     $bufbits = 0; 
           $c = chr ($buf & 255);     while ( $i <= length $img ) { 
           $pkdimg .= $c;         if ( $i < length $img ) { 
           $buf >>= 8;  
           $bufbits -= 8;             # Output each pixel 
       }             $c = ord substr $img, $i, 1; 
   }             $c &= 2**$BITS_PER_PIXEL - 1; 
   $pkdimg .= chr $buf;             $buf |= $c << $bufbits; 
             $bufbits += $BITS_PER_PIXEL + 1;
   # Output image data             $i++; 
   $i = 0;  
   while ($i < length $pkdimg) {          # Insert LZW table clear code before the decoder will grow the bit size 
       $cnt = (length $pkdimg) - $i;          # The minus 2 is a fudge factor 
       $cnt = 255 if ($cnt > 255);             if ( $i % ( 2**$BITS_PER_PIXEL - 2 ) == 0 ) { 
       print pack 'C', $cnt;                 $c = 2**$BITS_PER_PIXEL; 
       print substr $pkdimg, $i, $cnt;                 $buf |= $c << $bufbits; 
       $i += $cnt;                 $bufbits += $BITS_PER_PIXEL + 1; 
   }            }
         }
         else {
   
             #Output LZW end code
             $c = 2**$BITS_PER_PIXEL + 1;
             $buf |= $c << $bufbits;
             $bufbits += $BITS_PER_PIXEL + 1;
             $i++;
         }
         while ( $bufbits >= 8 ) {
             $c = chr( $buf & 255 );
             $pkdimg .= $c;
             $buf >>= 8;
             $bufbits -= 8;
         }
     }
     $pkdimg .= chr $buf;
   
     # Output image data
     $i = 0;
     while ( $i < length $pkdimg ) {
         $cnt = ( length $pkdimg ) - $i;
         if ( $cnt > 255 ) { $cnt = 255; }
         print pack 'C', $cnt or croak "$croak{'print'}";
         print substr $pkdimg, $i, $cnt or croak "$croak{'print'}";
         $i += $cnt;
     }
   
   # Finish up    # Finish up
   print "\0"; # zero byte count (end of raster data)    print "\0" or croak "$croak{'print'}";    # zero byte count (end of raster data)
   
   # GIF Terminator    # GIF Terminator
   print ';';     print ';' or croak "$croak{'print'}"; 
   
   exit;    exit;
} }
   
1; 1;