#!/usr/local/bin/perl
#################################################################
#### NOTE: THIS COPY HAS HAD LIBRARIES AUTOMATICALLY INLINED ####
#################################################################
## NOTE:  Replace the first line above with the path containing your perl
##	  program.  If you don't know where it is, either ask your
##	  system administrator, or try typing 'perl -v' at the command 
##	  line.  If you get a version number and info back, then you can
##	  run this script like this:  perl xtxt2gif EUCfile.  This script
##	  requires perl version 5.0 or greater.
#################################################################
##
## xtxt2gif is a modified version of txt2gif, by Jeffrey Friedl
##   (jfriedl@yahoo.com)
##
## Modified by WFMS 04-Feb-1997 replaced inlined librairies.
## Modified by WFMS 04-Jun-1997 added foreground colour choices.
## Modified by WFMS 05-Jun-1997 to include background colour choices.
## Modified by WFMS 05-Jun-1997 fixed background colour vs transparency.
## Ibid. - 18-Jul-1997	bug '=' vs. '==' fixed.
##
## WFMS is wmaton@miredespa.com.  Send comments, questions and pizzas
## (or tacos) there.  Blueberry muffins are acceptable as well.
##
## WARNING:  This file has also been modified to accept choice of colour
## 	     foreground.  It also has had its internals ripped out and
##	     replaced by newer versions of nested (inlined) libraries.
##	     Consider this release to be ALPHA CODE.  See below for the
##	     colour choices.
##
## WARNING #2:	This version supports background colour choices.  It will
##		not check to see if you do something silly as black-on-black
##		or some such thing with the colours.  Your silliness will
##		be justly rewarded if you do.
##
## BLURB:
## Given a Japanese EUC encoded text file, txt2gif produces the graphical
## representation of the contents as GIFs.  The output is sent to STDERR,
## but can be redirected to a file.
##
## (A future release will let you specify the following via the command
## line, if there is enough interest.)
##
## Configurable parameters:
##
## The function:
##
##       &japgif'generate('', $_, $fgc, $bgc, $kf, $af, $trans)
##
## also allows you to control the appearance of the GIF file:
##
## First arg:  Only useful if you want to output the resulting GIF with say,
## an HTTP content type header, such as "Content-type: image/gif\n\n".
## Second arg:  This is the text file being acted upon.  Don't change!
## Third arg:  This is the foreground colour.  The choices are:
##
##		r(ed)
##		g(reen)
##		bl(ue)
##		c(yan)
##		m(agenta)
##		y(ellow)
##		b(lack)
##		w(hite)
##
## Letters in parentheses are optional.
##
## The fourth argument, which controls the background colour, uses the
## same colour choices as the foreground.
##
## The next two args: these are the names of the font files.
## $kf:  this points to the location of either the kanji48.snf or kanji26.snf
##       files, depending on the size kanji you want.
## $af:  This points to the location of the ascii26.snf file.
##
## The last arg: create a (possibly) transparent GIF.
##
## As you'll see just below, you can change the sizes of the fonts by
## simply changing the defined $kf and $af variables to point to the
## appropriate font file.
##
## Font files, as well as other goodies related to the Japanese language
## may be found at ftp://ftp.cc.monash.edu.au/pub/nihongo/00INDEX.html
##

&package_lib_perl_snffont_pl_init; ## automatic inline of "snffont.pl"
&package_lib_perl_japgif_pl_init; ## automatic inline of "japgif.pl"
&package_lib_perl_gif_pl_init; ## automatic inline of "gif.pl"

## ** BEGIN CONFIGURATION ** ##

## Edit these to change the font size.
$kf = "./kanji26.snf";
$af = "./ascii26.snf";

## Edit this to control transparency (1=transparent).
$trans = 1;

## Edit this to change the colour.
$fgc = 'bl';
$bgc = 'b';

## ** END CONFIGURATION ** ##

local($/) = undef;          ## next <> sucks entire input.
$_= <>;                     ## sluuuurp.
print STDERR &japgif'generate('', $_, $fgc, $bgc, $kf, $af, $trans), "\n";
exit 0;


## start of inline of lib/perl/snffont.pl
######################################################################

package main; sub package_lib_perl_snffont_pl_init {
package snf;
#$version = "92-11-04";
$version  = "95-06-08";










$SNFversion = 4;
$headersize = 108;
$charinfosize = 16;

sub main'closeSNFfont {
local(*SNF) = @_;
return 0 if !defined($SNF{'open'});
close(SNF);
delete $SNF{'open'};
return 1;
}

sub main'openSNFfont {
local(*SNF, $file) = @_;
if (!open(SNF, $file)) {
# print STDERR "no such file $file\n";
return 0;
}
local($tmp) = '';
if (!read(SNF, $tmp, $headersize)) {
# print STDERR "read from [$file]: $!";
return 0;
}

$SNF{'open'} = $file;

(
$SNF{'version1'},
$SNF{'allExist'},
$SNF{'drawDirection'},
$SNF{'noOverlap'},
$SNF{'constantMetrics'},
$SNF{'terminalFont'},

$SNF{'flags'},

$SNF{'firstCol'},
$SNF{'lastCol'},
$SNF{'firstRow'},
$SNF{'lastRow'},
$SNF{'nProps'},
$SNF{'lenstrings'},
$SNF{'chDefault'},
$SNF{'fontDescent'},
$SNF{'fontAscent'},

$SNF{'MinL'},
$SNF{'MinR'},
$SNF{'MinW'},
$SNF{'MinA'},
$SNF{'MinD'},
$SNF{'MinAttr'},
$tmp,

$SNF{'MaxL'},
$SNF{'MaxR'},
$SNF{'MaxW'},
$SNF{'MaxA'},
$SNF{'MaxD'},
$SNF{'MaxAttr'},

$SNF{'GlyphSize'},
$SNF{'pixDepth'},
$SNF{'glphySets'},
$SNF{'version2'}
) = unpack('NNNNNN N NNNNNNNNN n6N n6N NNN', $tmp);

$SNF{'GlyphSize'} >>= 8;

$SNF{'rows'} = $SNF{'lastRow'} - $SNF{'firstRow'} +1;
$SNF{'cols'} = $SNF{'lastCol'} - $SNF{'firstCol'} +1;
$SNF{'chars'} = $SNF{'rows'} * $SNF{'cols'};
$SNF{'width'} = $SNF{'MaxW'};
$SNF{'height'} = $SNF{'MaxD'} + $SNF{'MaxA'};
$SNF{'BytesPerScanLine'} = int(($SNF{'width'} / 8) + 3) & 0xffC;
$SNF{'BytesPerChar'} = $SNF{'height'} * $SNF{'BytesPerScanLine'};
$SNF{'glyphdata'} = $headersize + $charinfosize * $SNF{'chars'};

1;
}

sub main'SNFchar {
local(*SNF, $code) = @_;
local($row) = (($code >> 8) & 0xff) - $SNF{'firstRow'};
local($col) = (($code     ) & 0xff) - $SNF{'firstCol'};
local($loc) = $headersize+$charinfosize * ($SNF{'cols'}*$row + $col);

seek(SNF, $loc, 0) || &error("seek($loc): $!");
local($charinfo) = '';
read(SNF, $charinfo, $charinfosize) ||
&error("fontread($charinfosize) at $loc: $!");




local($a,$b,$c, $exists) = unpack('x12 C3 C', $charinfo);

return '' if $exists == 0;
local($offset) = ((($a<<8)|$b)<<8)|$c;
seek(SNF, $SNF{'glyphdata'}+$offset, 0) || &error('SNF raw seek');
local($rawdata) = '';
read(SNF, $rawdata, $SNF{'BytesPerChar'}) || &error("SNF raw: $!");

$bpsl = $SNF{'BytesPerScanLine'};
$width = $SNF{'width'};
$height = $SNF{'height'};
$ptr = 0;
@tmp = ();

for ($i = 0; $i < $height; $ptr += $bpsl, $i++) {
push(@tmp, unpack("B$width", substr($rawdata, $ptr, $bpsl)));
}
@tmp;
}

1;


__FILE__

} # end of inline of lib/perl/snffont.pl

## start of inline of lib/perl/gif.pl
######################################################################

package main; sub package_lib_perl_gif_pl_init {
package gif;
## Routines to write a two-color GIF.
## Jeffrey Friedl (jfriedl@omron.co.jp)
## Copyrighted 19...oh hell, just take it.
##
$version = "961207.02";

## 961207.02
##    oops, had foreground and background mixed up :-/
##
## 940706.01
##    base
##
## BLURB:
## Routines to create monochrome (and possibly transparent) gifs.
## Very simpleton.
##
##>
##
## Three public routines:
##
##   gif'start(FH, w, h, R,G,B, r,g,b, transparent)
##
##      Prepare to write a stream of bits to the named file handle (as a
##      string). The w and h are the width and height of the image.
##      The first R G B are for the foreground, the 2nd for the background.
##      If $transparent is given and is true, the GIF89a "transparent color"
##      will be used for the background (otherwise it's a GIF87a).
##
##  gif'bits(text...)
##      Text should be a string (or strings) of 0s and/or 1s which are
##      taken as background and/or foreground bits of the image. The stream
##      should be sent row by row, starting with the top row, left to right.
##	Any number of bits may be sent with any one call to &gif'bits... it
##	makes no difference.
##
##	For example, to create a rediculously small (3x2) "picture" that
##	looks like  +------+
##                  |[][]  |
##                  |    []|
##                  +------+
##	The calls could look like:
##	   &gif'start("STDOUT", 3, 2, 255,255,255, 0,0,0);
##         &gif'bits("110"); ## the top row
##         &gif'bits("001"); ## the bottom row
##	   &gif'end;
##	or
##	   &gif'start("STDOUT", 3, 2, 255,255,255, 0,0,0);
##         &gif'bits("110001"); ## the bits for both rows
##	   &gif'end;
##	or
##	   &gif'start("STDOUT", 3, 2, 255,255,255, 0,0,0);
##         &gif'bits("1");   ## the first bit
##         &gif'bits("1");   ## the 2nd bit
##         &gif'bits("000"); ## 3rd,4th,and 5th bits
##         &gif'bits("11");  ## last two bits
##	   &gif'end;
##      Etc.
##
##  gif'end()
##      Finalizes things (you still need to close the file, though).
##
##<
###########################################################################

## a bit of initialization
$MAX = 1 << 12; ## maximum GIF compression value

sub start
{
    local($trans);
    ($FH, $w, $h, $fg_r, $fg_g, $fg_b, $bg_r, $bg_g, $bg_b, $trans) = @_;

    ## force unqualified filehandles into callers' package
    ## (this line stolen from E. Spafford)
    $FH = (caller)[$[] . "'$FH" if $FH !~ m/'/; #'

    $w    =   0 if !defined $w;
    $h    =   0 if !defined $h;
    $fg_r = 255 if !defined $fg_r;
    $fg_g = 255 if !defined $fg_g;
    $fg_b = 255 if !defined $fg_b;
    $bg_r =   0 if !defined $bg_r;
    $bg_g =   0 if !defined $bg_g;
    $bg_b =   0 if !defined $bg_b;
    $trans =  0 if !defined($trans);

    print $FH ($trans ? "GIF89a" : "GIF87a"),
	pack('CC CC C C C  CCC CCC',
	  $w & 0xff, ($w >> 8),
	  $h & 0xff, ($h >> 8),
	  0x80,                  # global color map. no color. 1 bit/pixel
	  0,                     # background is color 0
	  0,                     # pad
          $bg_r, $bg_g, $bg_b, $fg_r, $fg_g, $fg_b,
	  0);

    if ($trans)
    {
	print $FH pack('CCC CCCC C',
	    0x21,  ## magic: "Extension Introducer"
	    0xf9,  ## magic: "Graphic Control Label"
	       4,  ## bytes in block (between here and terminator)
	    0x01,  ## indicates that 'transparet index' is given
	    0, 0,  ## delay time.
	       0,  ## index of "transparent" color.
	    0x00); ## terminator.
    }

    print $FH ',', pack('CC CC CC CC CC',
	0,0,0,0,
	$w & 0xff, $w >> 8,
	$h & 0xff, $h >> 8,
	0, 2);

    &lzw_clear_dic();
}


sub end
{
    &lzw_out();
    &lzw_raw_out($EOF);
    &lzw_flush_raw();
    print $FH pack("C", 0);
    undef $FH;
}

sub bits
{
    return 0 if !defined $FH;
    local($cleartext) = join('',@_);
    local($index) = 0;
    local($len) = length $cleartext;
    $working = substr($cleartext, $index++, 1) if !defined $working;

    while ($index < $len)
    {
	$K = substr($cleartext, $index++, 1);
	if (defined $dic{$working.$K}) {
	    $working .= $K;
	} else {
	    &lzw_out();
	    $dic{$working.$K} = $code++;
	    $working = $K;
	}
    }
    1;
}

###########################################################################
###########################################################################

sub lzw_clear_dic
{
    undef %dic;
    $bits  = 2;
    $Clear = 1 << $bits;
    $EOF   = $Clear + 1;
    $code  = $Clear + 2;
    $nextbump = 1 << ++$bits;
    $WaitingBits = ''; ## init stuff.
    &lzw_raw_out($Clear);
    undef $working;
}

##
## Inherits: $bits, $working %dic
## Output the appropriate code for $working.
##
sub lzw_out
{
   &lzw_raw_out(($working eq '0' || $working eq '1')?$working:$dic{$working});
   if ($code >= $nextbump) {
       &lzw_clear_dic() if ($nextbump = 1 << ++$bits) > $MAX;
   }
}

##
## Given a raw value, write it out as a $bit-wide value.
##
## Inherits: $WaitingBits, $bits
##
sub lzw_raw_out
{
    local($raw) = @_;
    for ($b = 1; $b < $nextbump; $b <<= 1) {
	$WaitingBits .= ($raw & $b) ? '1' : '0';
    }
    while (length $WaitingBits >= 8) {
	&send_data_byte(unpack("C", pack("b8", $WaitingBits)));
	substr($WaitingBits, 0, 8) = '';
    }
}

##
## Flush out a byte to represent the remaining bits in $WaitingBits,
## if there are any.
## Inherits: $WaitingBits
##
sub lzw_flush_raw
{
    if (length $WaitingBits) {
	$WaitingBits .= "00000000"; ## enough padded 0's to make a byte
	&send_data_byte(unpack("C", pack("b8", $WaitingBits)));
	$WaitingBits = '';
    }
    &flush_data();
}

sub send_data_byte
{
    push(@out, @_);
    if (@out == 255) {
	print $FH pack("C256", 255, @out);
	@out = ();
    }
}

sub flush_data
{
    local($count) = scalar(@out);
    if ($count) {
	local($c2) = $count + 1;
	print $FH pack("C$c2", $count, @out);
	undef @out;
    }
}

1;

} # end of inline of lib/perl/gif.pl

## start of inline of lib/perl/japgif.pl
######################################################################

package main; sub package_lib_perl_japgif_pl_init {
package japgif;
$version = "960502.02";











sub generate
{
local($header, $input_text, $fg, $bg, $kanjifile, $asciifile, $transparent)= @_;

return "no text" if $input_text !~ m/[\x20-\xff]/;
local(*AF, *KF);

## background colour doesn't matter if transparent.
$bg = 'b' if $transparent == 1;

if ($input_text =~ m/[\x20-\x7f]/) {
if (!defined $open{$asciifile}) {
&main'openSNFfont(*AF, $asciifile) || #'
return "internal error, ascii font[$asciifile]";
}
}

if ($input_text =~ m/[\x80-\xff]/) {
if (!defined $open{$kanjifile}) {
&main'openSNFfont(*KF, $kanjifile) || #'
return "internal error, kanji font[$kanjifile]";
}
}

if    ($fg =~ /^r(ed)?$/)    { @color_map = (255, 0, 0) }
elsif ($fg =~ /^g(reen)?$/)  { @color_map = (0, 255, 0) }
elsif ($fg =~ /^bl(ue)?$/)   { @color_map = (0, 0, 255) }
elsif ($fg =~ /^c(yan)?$/)   { @color_map = (0,255,255) }
elsif ($fg =~ /^m(agenta)?$/){ @color_map = (255,0,255) }
elsif ($fg =~ /^y(elow)?$/)  { @color_map = (255,255,0) }
elsif ($fg =~ /^b(lack)?$/)  { @color_map = (0, 0, 0  ) }
else                         { @color_map = (255, 255, 255) }

if    ($bg =~ /^r(ed)?$/)    { push @color_map, (255, 0, 0) }
elsif ($bg =~ /^g(reen)?$/)  { push @color_map, (0,255,0) }
elsif ($bg =~ /^bl(ue)?$/)   { push @color_map, (0,0,255) }
elsif ($bg =~ /^c(yan)?$/)   { push @color_map, (0,255,255) }
elsif ($bg =~ /^m(agenta)?$/){ push @color_map, (255,0,255) }
elsif ($bg =~ /^y(elow)?$/)  { push @color_map, (255,255,0) }
elsif ($bg =~ /^b(lack)?$/)  { push @color_map, (0, 0, 0) }
else                         { push @color_map, (255, 255, 255) }
 

$w = $h = 0;
@text = split(/\n/,$input_text);
foreach $text (@text) {
$this_w = $this_h = 0;
$len = length($text);
for ($i = 0; $i < $len; $i++) {
$char = ord(substr($text, $i, 1));
if ($char < 0x20) {

} elsif ($char < 0x80) {
$this_w += $AF{'width'};
$this_h = $AF{'height'} if $this_h < $AF{'height'};
} else {
$i++;
$this_w += $KF{'width'};
$this_h = $KF{'height'} if $this_h < $KF{'height'};
}
}
$h += $this_h;
$w = $this_w if $this_w > $w;
}


print $header if defined $header;
&gif'start("main'STDOUT", $w, $h, @color_map, $transparent);#"

foreach $text (@text)
{
$charcount = $this_h = 0;
$len = length($text);
for ($i = 0; $i < $len; $i++) {
$char = ord(substr($text, $i, 1));
if ($char < 0x20) {

} elsif ($char < 0x80) {
eval("\@C$charcount = &main'SNFchar(*AF, \$char)");#'
return("gif eval: $@") if $@;
$charcount++;
$this_h = $AF{'height'} if $this_h < $AF{'height'};
} else {
$JIS = unpack("n", substr($text, $i, 2)) & 0x7f7f;
eval("\@C$charcount = &main'SNFchar(*KF, \$JIS)");#'
return("gif eval: $@") if $@;

$i++;
$charcount++;
$this_h = $KF{'height'} if $this_h < $KF{'height'};
}
}

for ($row = 0; $row < $this_h; $row++) {
$thisline = 0;
for ($j = 0; $j < $charcount; $j++) {
eval("\$text = '0' x length(\$C$j\[0])
if !defined(\$text = \$C$j\[\$row]);");
$thisline += length($text);
&gif'bits($text);#'
}
&gif'bits('0' x ($w - $thisline)) if $thisline < $w;#'
}
}

&gif'end();#'
undef;
}

1;

} # end of inline of lib/perl/japgif.pl

__END__