#!/usr/local/bin/perl
#################################################################
#### NOTE: THIS COPY HAS HAD LIBRARIES AUTOMATICALLY INLINED ####
#################################################################
## Note also that Jim Breen runs this script with the following
## first line:
##	#!/usr/local/bin/perl4 -w
#################################################################
##
## 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.
##
## Configurable parameters:
##
## $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.
##
## (These font files can be obtained from the Monash Nihongo mirror nearest
## you.)
##
## The function:
##
##       &japgif'generate('', $_, 'w', $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: 'w' for a white foreground/black background, anything else 
## (i.e. "b") for the opposite.
## The next two args: these are the names of the font files already defined
## above.
## The last arg: create a (possibly) transparent GIF.
##

&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"
$kf = "./kanji26.snf";
$af = "./ascii26.snf";
$trans = 1;

local($/) = undef;          ## next <> sucks entire input.
$_= <>;                     ## sluuuurp.
print STDERR &japgif'generate('', $_, 'w', $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";

## An SNF file has the following format:
##   header (of $headersize bytes)
##   array of charinfo structs ($numchar elements, each $charinfosize bytes)
##   Glyph data
##   property data.
##
## This package doesn't care about the property data.
##

$SNFversion = 4; 	## this for version 4 SNF files...
$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) = @_;
    open(SNF, $file) || return 0;
    local($tmp) = '';
    sysread(SNF, $tmp, $headersize) || &error("read from [$file]: $!");
    $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("main'SNFchar: seek($loc): $!");
    local($charinfo) = '';
    sysread(SNF, $charinfo, $charinfosize) ||
	&error("fontread($charinfosize): $!");

    ## first 12 bytes of charinfo are metrics (junk to us).
    ## next three bytes are offset into glyph data for this char.
    ## next bit tells if this char is really in glyph data or not.
    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 char seek');
    local($rawdata) = '';
    sysread(SNF, $rawdata, $SNF{'BytesPerChar'}) || &error('SNF sysread');

    return &raw2text(*SNF, $rawdata);
}

sub main'SNFchar_raw { 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) = '';
    sysread(SNF, $charinfo, $charinfosize) || &error("fontread($charinfosize) at $loc: $!");

    ## first 12 bytes of charinfo are metrics (junk to us).
    ## next three bytes are offset into glyph data for this char.
    ## next bit tells if this char is really in glyph data or not.
    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) = '';
    sysread(SNF, $rawdata, $SNF{'BytesPerChar'}) || &error("SNF raw: $!");
    return &raw2raw(*SNF, $rawdata);
}

sub raw2text { local(*SNF, $rawdata) = @_;
    local($bpsl) = $SNF{'BytesPerScanLine'};
    local($width) = $SNF{'width'};
    local($height) = $SNF{'height'};
    local($ptr, $tmp) = (0, '');
    for ($i = 0; $i < $height; $ptr += $bpsl, $i++) {
	$tmp .= unpack("B$width", substr($rawdata, $ptr, $bpsl)) . "\n";
    }
    $tmp =~ tr/01/ #/;
    $tmp;
}

sub raw2raw { local(*SNF, $rawdata) = @_;
    local($bpsl) = $SNF{'BytesPerScanLine'};
    local($width) = $SNF{'width'};
    local($height) = $SNF{'height'};
    local($ptr, $i) = 0;
    local(@tmp) = ();

    for ($i = 0; $i < $height; $ptr += $bpsl, $i++) {
	push(@tmp, unpack("B$width", substr($rawdata, $ptr, $bpsl)));
    }
    return join("\n", @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 = "940706.01";

## BLURB:
## Routines to create monochrome (and possibly transparent) gifs.
##
##>
##
## 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
          $fg_r, $fg_g, $fg_b, $bg_r, $bg_g, $bg_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; ## required for a required package


} # 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 = "940706.01";

##
## prints the GIF to STDOUT.
##
## header -- probably usually either blank or "Content-type: image/gif\n\n".
## input_text -- line(s) of text to be generated.
## fg -- 'b' for a black foreground/white background, anything else (i.e. "w")
##       for the opposite.
## kanjifile - font for kanji, if any
## asciifile - font for ascii, if any
##
sub generate
{
    local($header, $input_text, $fg, $kanjifile, $asciifile, $transparent)= @_;

    return "no text" if $input_text !~ m/[\x20-\xff]/;


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

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

    if ($fg eq 'b') {
	@color_map = (255, 255, 255, 0,0,0);
    } else {
	@color_map = (0,0,0, 255, 255, 255);
    }

    ## check overall width/height
    $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) {
		## skip
	    } elsif ($char < 0x80) {
		$this_w += $AF{'width'};
		$this_h = $AF{'height'} if $this_h < $AF{'height'};
	    } else {
		$i++; ## skip past 2nd byte of character.
		$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) {
		## skip
	    } elsif ($char < 0x80) {
		$bitmap = &main'SNFchar_raw(*AF, $char);
		eval("\@C$charcount = split(/\\n/,\$bitmap);1;")
		    || return "gif: eval $@";
		$charcount++;
		$this_h = $AF{'height'} if $this_h < $AF{'height'};
	    } else {
		$JIS = unpack("n", substr($text, $i, 2)) & 0x7f7f;
		$bitmap = &main'SNFchar_raw(*KF, $JIS);
		eval("\@C$charcount = split(/\\n/,\$bitmap);1;")
		    || return "gif: eval $@";

		$i++; ## skip past 2nd byte of character.
		$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; ## return "no error";
}

1;## required for packages.


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

__END__