#!/usr/local/bin/tkperl
# $Id: zview.pl,v 2.8 2002/10/06 09:23:15 kono Exp kono $

# Copyright (C) 2002, Shinji Kono, University of the Ryukyus
# Copyright (C) 1996, Shinji Kono, Sony Computer Science Laboratory, Inc.
#
#  Everyone is permitted to copy and distribute verbatim copies
#  of this license, but changing it is not allowed.  You can also
#  use this wording to make the terms for other programs.
# 
#  send your comments to kono@ie.u-ryukyu.ac.jp
# 

require "getopts.pl";

# Perl 5.8
# Perl 5.002b2 and Tk-b9.01
# if you remove TkPerl part, this should run on Perl 4.036

# Detect variosus format, put into files, or
# View directly in TkPerl
# Accept
#     CSV data
#     Tab separated data
#     Mail attachment data
#     Attribute data format
#     Dump( not supported )
# Translate 
#     Image
#     Hand Text
#     Schedule

sub main {
    &Getopts('df:tpx:y:Fsh');

    $debug = $opt_d;
    if($opt_h) {
	print STDERR "Various Zaurus Data Viewer\n";
	print STDERR "Usage: $0 -[ftsdtpF] [-xn] [-yn] [-f name]\n";
	print STDERR "   -f name generate name00.{xbm,tk,ps,plot,txt} file\n";
	print STDERR "   -t stdout output\n";
	print STDERR "   -s single and sequential output\n";
	# print STDERR "   -d mail attachment data detail\n";
	print STDERR "   -t Tcl/Tk output in hand text\n";
	print STDERR "   -p PostScript output in hand text\n";
	print STDERR "   -F word frame in hand text\n";
	print STDERR "   -x2 -x3   .. image scale\n";
	print STDERR "   -y1.5 -y3 .. ps    scale\n";
	exit(0);
    } 
    if($opt_f) {
	$bname = $name = $opt_f;
        $tkperl = 0;
    }
    if($opt_x>1) {
	# (0<$opt_x && $opt_x<5) || die("$opt_x scale not allowed in image");
        &make_times($opt_x);
    }
    if($opt_y) {
	$ps_scale = $opt_y;
    }
    if($opt_t) {
        $tkperl = 0;
    }
    $retain_window = 1;
    if($opt_s) {
        $retain_window = 0;
    }
    $update = "update;";
    if($opt_u) {
	$update='';
    }
    if(!$tkperl && ! $opt_f) {
	$opt_f = $bname = $name;
    }

    &detect;

    &TkWait while($tkperl && $tops && ($retain_window || $tktext));
}

# decode data format
#    put into one $_ line
#    $_ is passed to decode routine
#    if file mode, output into file."ext"
#       .txt  SJIS text in Attribute data format
#       .xbm  X bitmap format
#       .tk   Tcl/Tk
#       .ps   PostScript

$mail_max = 300;

sub detect 
{
    local($buf,$i);

top_loop:
    while(<>) {
        # print STDERR $_;
	$tab_mode = 0;

        ##################
        # Image?
	#    hex string

	if (/^IMG1:/) {
	    s/^IMG1:\s*//; &image;
	} elsif (/^image:/) {
	    s/^image:\s*//; &image;
	} elsif (/\"i\",\"SCRT\",\"CLAS\",\"IMG1\"/i) { # CSV
	    while(<>) {
		redo top_loop if (/\"i\"\,/i && ! /\"IMG1\"/i);
		next if (/"t",/i);
		if( s/^\"D\",//i) {
		    s/"[\r\n]*$//; 
		    s/^(.*)"//;
		    $title = $1;
		    &image;
		} else {
		    redo top_loop ;
		}
	    }
	    # remember <> fails only once
	    last if (eof());
	    next;
	} elsif (/^i\tSCRT\tCLAS\tIMG1/i) { # TSV
	    while(<>) {
		redo top_loop if (/^i\t/i && ! /\IMG1/i);
		next if (/^t\t/i);
		if(s/^D\t[^\t]*\t([^\t]*)\t//i) {
		    $title = $1;
		    &image;
		} else {
		    redo top_loop ;
		}
	    }
	    last if (eof());
	    next;

        ##################
        # Hand Text?
	#   encoded bit stream

	} elsif (/^HTXT:/) {
	    s/^HTXT:\s*//; &hand_text(pack("H*",$_));
	} elsif (/^hand-text:/) {
	    s/^hand-text:\s*//; chop; s/#.*//; s/ //g;
	    $buf = $_;
	    while(<>) {
		if(/^hand-text:/) {
		    s/^hand-text:\s*//; chop; s/#.*//; s/ //g;
		    $buf .= $_;
		} else {
		    &hand_text(pack("H*",$buf)); $buf = '';
		    redo top_loop;
		}
	    }
	    &hand_text(pack("H*",$buf)) if($buf);
	    $buf = '';
	    last if (eof());
	} elsif (/\"i\",\"SCRT\",\"TIM1\",\"HTXT\"/io) {
	    while(<>) {
		redo top_loop if (/\"i\"\,/i && ! /\"HTXT\"/i);
		next if (/"t",/i);
		if (s/^\"D\",\"[^"]*\",\"(\d*)\",\"//i) {
		    $title=&decode_date($1);
		    s/"[\r\n]*$//; 
		    &z_decode;
		    &hand_text;
		} else {
		    redo top_loop ;
		}
	    }
	    # remember <> fails only once
	    last if (eof());
	    next;
	} elsif (/i\tSCRT\tTIM1\tHTXT/io) {
	    while(<>) {
		redo top_loop if (/i\t/i && ! /\tHTXT/i);
		next if (/^t\t/i);
		if(s/^D\t[^\t]*\t([^\t]*)\t//) {
		    $title=&decode_date($1);
		    &z_decode;
		    &hand_text;
		} else {
		    redo top_loop ;
		}
	    }
	    last if (eof());
	    next;

        ##################
        # Mail and Attatchment

	} elsif (/### MAIL START ###/) {
	    &TextOpen;
	    $i = 0; 
	    while(<>) {
		last if(/### MAIL END ###/);
		if (/### TENPU START ###/) {
		    $buf = '';
		    while(<>) {
			last if(/### TENPU END ###/); 
			chop;
			$buf .= $_;
		    }
		    $_ = $buf;
		    &z_decode;
		    &attatchment;
		} else {
		    &Print($_);
		}
	    }
	    &TextClose;
	    last if (eof());
	} elsif (/Mail_id:/) {
	    # There are no obvious way to detect the end of a Mail
	    &TextOpen;
	    $tab_mode = 1 if(s/^D\s//);
	    $i = 0; 
	    $buf = '';
	    if(! s/^(.*)\#\@TP//) {
		$buf .= $_;
		while(<>) {
		    last if (s/^(.*)\#\@TP//);
		    if ($tab_mode && s/^D\s//) {
			$buf .= $_;
			next;
		    } elsif (eof) {
			&Print($buf."\n");
			next top_loop;
		    } elsif ($i++ < $mail_max) {
			next;
		    } else {
			&Print($buf."\n");
			next top_loop;
		    }
		}
	    }
	    &Print($buf . $1 . "\n");
	    &TextClose;
	    if(! $_) { # no attachment
		last if (eof());
		next;
	    }
	    if(! eof()) {
		$buf = $_;
		while(<>) {
		    chop;
		    last if ($tab_mode && ! s/^D\s+//);
		    last if (/[^:;a-zA-Z0-9\r\s]/);
		    $buf .= $_;
		    last if (eof);
		}
		$_ = $buf;
	    }
	    &z_decode;
	    &attatchment;
	    last if (eof());
        ##################
        # Backup Data

	} elsif (/^\xff\x00\x10/) {
	    while(! eof) {
		$_ .= <>;
	    }
	    &decode_box_data({},$_);
	} elsif (s/^\032*PABAK//) {
	    &TextOpen;
	    $buf = '';
	    while(<>) {
		if (s/^\032*PABAK//) {
		    $_ = $buf;
		    &Backup; 
		    $buf = '';
		    next;
		} elsif (/^\032/) {
		    $_ = $buf;
		    &Backup; 
		    $backup_dir = 0;
		    $buf = '';
		    last;
		}
		chop;
		$buf .= $_;
	    }
	    &TextClose;
	    last if (eof());
	}
    }
}

##########################################################
#
# Data Initialization
#
##########################################################


$name="zau";
$bname = $name;
$detail = 0;
$page = 1000;
$number = 0;

$XMAX = 600;
$YMAX = 400;
$std_height = 30;

# 2's complement binary encoding (for hand text)

for($i=0;$i<8;$i++) {
    $bit{&binary($i,3)} = ($i>3?$i-8:$i);
}
for($i=0;$i<32;$i++) {
    $bit{&binary($i,5)} = ($i>15?$i-32:$i);
}
sub binary {
    local($d,$n) = @_;
    $o = '';
    vec($o,0,32) = $d;
    return substr(unpack("B*",$o),32-$n,$n);
}

$fd = "fd00";

sub decode_date {
    local($data) = @_;
    if ($data =~ /(\d\d\d\d)(\d\d)(\d\d)/) {
        return "$1/$2/$3";
    }
}


sub Opening
{
    local($ext) = @_;
    local($file);

    if($opt_f) {
	push(@files,select);
	push(@files,++$fd);
	$file = $bname.sprintf("%02d",$number++).".".$ext;
	print STDERR ">$file ";
	if($text_open) {
	    print TXT ">$file ";
	}
	open($fd,">$file");
	select($fd);
	return 1;
    } elsif ($tkperl) {
	&TkOpening($ext);
	return 1;
    }
    &Print("\n");
    return 1;
}

sub Closing
{
    local($wait) = @_;

    if($opt_f) {
	close(pop(@files));
	select(pop(@files));
	$fd--;
	print STDERR "\n";
    } elsif ($tkperl) {
	&TkClosing($wait);
    }
}

sub TextOpen 
{
    if($tkperl) {
	if(! defined($tktext)) {
	    &TkTextOpen;
	}
    } else {
	if($opt_f) {
	    if(! defined($text_file)) {
		$text_file = $bname.sprintf("%02d",$number++).".txt";
		print STDERR ">$text_file\n";
		open(TXT,">$text_file");
	    }
	} 
    }
}

sub TextClose
{
    if($tkperl) {
	&TkClosing(0);
    }
}

sub Print
{
    if($tkperl) {
	&TkText($_[0]);
    } else { if($opt_f) {
	    print TXT $_[0];
	} else {
	    print $_[0];
	}
    }
}

##########################################################
#
# Zaurus Binary Encoding
#
##########################################################

# alphabet encoding
#
# 0-5        "0".."5"
# 6-0x1f     "A".."Z"
# 0x20-0x25  "6"..";"
# 0x26-0x3f  "a".."z"
#
# make character replacement code
#
$ya = '';
$yb = '';
for($i=0;$i<0x40;$i++) {
    if( $i <= 0x05 ) { $ya .= pack("C",($i + 0x30));}
    elsif( $i <= 0x1f ) { $ya .= pack("C",($i + 0x3b));}
    elsif( $i <= 0x25 ) { $ya .= pack("C",($i + 0x16));}
    else { $ya .= pack("C",($i + 0x3b)); }
# since . never matches \n, 0x40 is added
    $yb .= sprintf("\\%03o",$i+0x40);
}
eval "sub a_decode \{ y\/" . $ya . "/" . $yb . "/;}\n";
eval "sub a_encode \{ y\/" . $yb . "/" . $ya . "/;}\n";

# bit encoding
# s/..../&decode($&)/eg;
# 76543210765432107654321076543210
# 00      11      22        001122
# 33221100332211003322110033221100
# 00      11      22        001122

sub bit_decode {
    $bit = substr($_[0],0,3); 
    vec($bit, 3,2) =  vec($_[0],14,2);
    vec($bit, 7,2) =  vec($_[0],13,2);
    vec($bit,11,2) =  vec($_[0],12,2);
    return $bit;
}

sub bit_encode {
    $bit = $_[0];
    vec($bit,14,2) = vec($bit, 3,2);
    vec($bit,13,2) = vec($bit, 7,2);
    vec($bit,12,2) = vec($bit,11,2);
# since . never matches \n, 0x40 is added
    vec($bit,11,2) = vec($bit,7,2) = vec($bit,3,2) = 1;
    return $bit;
}

sub z_encode {
    local($i);
    $i = (length()%3);
    $_ .= "\0" x (3-$i) if($i);
    s/.../&bit_encode($&)/eg;
    &a_encode;
}

sub z_decode {
    local($i);
    s/\s//g;
    &a_decode;
    $i = (length()%4);
    $_ .= "\0" x (4-$i) if($i);
    s/..../&bit_decode($&)/eg;
}

##########################################################
#
# Mail Attachment Format
#
##########################################################

#
#   header of mail tenpu data
#       header  1 byte appnum, form, 1 byte name length, name string
#   Field type
#       2 byte length, data_id, 4char data name + 
#       1 byte type
#       type 
#       1    CLAS,MSG1   n byte string
#       2    IMG1        byte stream
#       3    HTXT        bit stream
#       4    TIM1,ALRM   32bit time structure
#       5    ????        unknown (to me...)
#       6    ATTR        n byte integer
#

sub attatchment
{
    local($length);
    local($i)=0;

    &TextOpen;
    $length = ord(substr($_,$i++,1));
    $length += ord(substr($_,$i++,1)) << 8;
    while($length>0) {     
        ##################
        # Header

	$appnum = ord(substr($_,$i++,1));
	$appnum += ord(substr($_,$i++,1)) << 8;
	if($appnum>30) {
	    printf STDERR "Unknown appnum %d, skip\n",$appnum;
	    $length-=2; $i+= $length;
	    $length = ord(substr($_,$i++,1));
	    $length += ord(substr($_,$i++,1)) << 8;
	    next;
	}
	# header part 
	$form = $appnum += ord(substr($_,$i++,1));
	if(! $tkperl) {
	    printf("app:\t%d\nform:\t%d\n",$appnum,$form) if ($detail);
#	    printf("name:\t");
	}
	$length = ord(substr($_,$i++,1));
	&Print(substr($_,$i,$length)."\n");
	$i += $length;
	$length = ord(substr($_,$i++,1));
	$length += ord(substr($_,$i++,1)) << 8;

	while($length>0) {    # item parts 
	    $t = ord(substr($_,$i,1));
	    print "parts:\t",$t,"\n" if ($detail);
	    $i++;
	    &Print(substr($_,$i,4).":\t") unless ($t==2 || $t==3);
	    $length -= 5;$i+=4;
	    if($t == 1) {
		##################
		# string
		$s = substr($_,$i,$length); 
		$s =~ s/\n/\n /g;
		&Print($s."\n");
		$i+=$length;
	    } elsif ($t == 2) {
		##################
		# image
		# image routine requires hex string
		&image(unpack("H*",substr($_,$i,$length)));
		$i+=$length;
	    } elsif ($t == 3) {
		##################
		# hand text
		# bit stream
		&hand_text(substr($_,$i,$length));
		$i+=$length;
	    } elsif ($t == 4) {
		##################
		# scheduler
		if($length>0) {
		    $i++; $length--; #skip time type
    		    &Print(&decode_time(substr($_,$i,$length))."\n");
		    $i += $length;
		} else { 
		    &Print("\n");
		}
	    } elsif ($t == 6) {
		##################
		# Unknown or other
		&Print(hex(unpack("H*",substr($_,$i,$length)))."\n");
		$i+=$length;
	    } else {
		print STDERR "unknown type $t\n";
		$i+=4; $length -= 5; 
		&Print(unpack("H*",substr($_,$i,$length))."\n");
		$i+=$length;
	    }
	    $length = ord(substr($_,$i++,1));
	    $length += ord(substr($_,$i++,1)) << 8;
	} 
	&Print("\n");
	# * continue;     # * length already read *# 
	$length = ord(substr($_,$i++,1));
	$length += ord(substr($_,$i++,1)) << 8;
    }
}


##########################################################
#
# Bit Image (Tegaki)
#
##########################################################

sub jpg {
    my ($jpg) = @_;
    return if (! $tkperl);
    return; # Tk does not support JPEG
    &Opening("jpg");
    use MIME::Base64;
    &TkPhoto(encode_base64($jpg),'jpg');
    &Closing(1);
}

sub gif {
    my ($gif) = @_;
    return if (! $tkperl);
    &Opening("gif");

    use MIME::Base64;
    &TkPhoto(encode_base64($gif),'gif');

    # use File::Temp qw/ tempfile tempdir /;
    # my ($fh, $filename) = tempfile( $template, SUFFIX => '.gif');
    # print $fh $gif; close $fh;
    # &TkPhoto($filename,'');
    # unlink $filename;

    &Closing(1);
}

# this routine requires Hex string


sub image 
{
return;
    local($_) = @_ if ($#_>=0);
    local($header,$length,$width,$height,$qp,$type);
    local($count,$repeat,$pos,$line,$r1);

    if($tkperl) {
	$tkbitmap = '';   # delayed open
    } else {
	&Opening("xbm");
    }

    $header = substr($_,0,16); substr($_,0,16) = '';
    ($length,$l1,$width,$w1,$height,$h1,$qp,$type) =
        unpack("C*",pack("H*",$header));
    $length = $length + $l1*0x100;
    $width  += $w1*0x100+1;
    $height += $h1*0x100+1;
    $bwidth = int(($width+8)/8)*2;
    &xbm_header;
    $count = 0;
    $bcount = 0;

    $pos = 0;
    $last = length;
    while($pos < $last) {
        if($type==1 && $count==0) { 
            ($repeat,$r1) = unpack("CC",pack("H*",substr($_,$pos,4))); 
            $pos += 4; $count = $repeat+$r1*0x100;
	    last if (! $count);
        }
        $repeat = unpack("C",pack("H*",substr($_,$pos,2))); $count--;
        $pos += 2;
        if($repeat < 0x80) {
            $repeat++;
            $count -= $repeat; 
	    $repeat *= 2;
	    &xbm(substr($_,$pos,$repeat));
	    $pos += $repeat;
	} else {
	    $count--;
	    &xbm(substr($_,$pos,2) x (0x101-$repeat));
	    $pos += 2;
	}
    }
    &xbm_end;
    &Opening("xbm") if ($tkperl);
    &Closing(1);
}

sub xbm_header
{
    if($opt_x>1) {
	$width *= $opt_x; $height *= $opt_x;
	$width += $opt_x*2;
    }
    if($tkperl) {
	$tkbitmap .= "#define ".$bname."_width ". ($width). "\n";
	$tkbitmap .= "#define ".$bname."_height ".($height)."\n";
	$tkbitmap .= "static char ".$bname."_bits[] = {\n";
    } else {
	print "#define ",$bname,"_width ", $width, "\n";
	print "#define ",$bname,"_height ",$height,"\n";
	print "static char ",$bname,"_bits[] = {\n";
    }
}

sub xbm_end
{
    if($tkperl) {
	if($opt_x>1) {
	    $line =~ s/../$times{$&}/g;
	    $line = ($line."\n") x $opt_x;
	    $tkbitmap .= $line;
	}
	$tkbitmap .= "\n};\n";
    } else {
	if($opt_x>1) {
	    $line =~ s/../$times[hex($&)]/eg;
	    $line = ($line."\n") x $opt_x;
	    print $line ;
	}
	print "\n};\n";
    }
}


sub xbm
{
    if(!($opt_x >1)) {
	local($buf) = @_;
	$buf =~ y/0123456789ABCDEFabcdef/084c2a6e195d3b7f5d3b7f/;
	$buf =~ s/(.)(.)/0x$2$1,\n/g;
	if($tkperl) {
	    $tkbitmap.=  $buf;
	} else {
	    print $buf;
	}
    } else {
	local($i,$o,$len,$buf);
	$line .= $_[0];
	$len = length($line);
	return if ($len < $bwidth);
	for($i=$bwidth;$i<=$len;$i+=$bwidth) {
	    $buf = substr($line,0,$bwidth);
	    $buf =~ s/../$times[hex($&)]/eg;
	    $buf = ($buf."\n") x $opt_x;
	    if($tkperl) {
		$tkbitmap .=  $buf;
	    } else {
		print $buf;
	    }
	    substr($line,0,$bwidth) = '';
	}
    }
}

sub make_times
{
    local($n) = @_;
    local($i,$out,$mask,$form) ;
    if ($n < 2) {
	$opt_x = 1;
	return;
    }
    #        0123 4567
    # x1     7654 3210
    # x2     3322 1100 7766 5544
    # x3     22111000 54443332 77766655
    # x4     11110000 33332222 55554444 77776666
    for($i=0;$i<256;$i++) {
	$out = unpack("B*",pack("C",$i));
	$out =~ s/./$& x $opt_x/ego;
	$out =~ s/......../"0x".unpack("H*",pack("b*",$&)).","/ego;
	$times[$i] = $out;
    }
}


##########################################################
#
# Hand Text Ink wapro data
#
##########################################################

#  Hand Text (Ink Wapro) Data is z3to4 encoded bit stream
#    This analyzed by S. Kono. Could be wrong.
# 
#     Byte stream
#
# (1)    1200       Boundary
# 
# (2)    1100       CR LF
# 
# (3)    10         stroke bit stream
#        len        1byte length of data
#        010002     version or so
#        len        1byte length of data (again)
#        width      2 byte width (LSB first) 
#        height     2 byte height (LSB first) 
#        bit stream data (3)-1..(3)-3
#        0000       2 byte footer
# (3)    13         normal text?
#	 len
#        010033
#        len (01)
#        0005         width (05)
#        0400         height ?
#        0000ff02
#        length
#        shift-jis char

sub hand_text
{
    local($_) = @_ if ($#_>=0);
    local($width,$height,$x,$y,$dx,$dy,$c,$length);
    local($scale);

    if ($opt_t) {
	$X0 = 10; $Y0 = 10;
	&Opening("tk");
    } elsif ($opt_p) {
	$X0 = 0; $Y0 = 0; 
	&Opening("ps");
    } elsif ($tkperl) {
	$X0 = 10; $Y0 = 10; 
	&Opening("plot");
    } else {
	$X0 = 0; $Y0 = 0; 
	&Opening("plot");
    }
    $tkwait = 1;

    $X = $X0; $Y = $Y0; $max_height = 0;
    &tk_open if($opt_t);
    &ps_open if($opt_p); 

    while($_) {
	if(s/^\020// || s/^\220// ) {
	    ##################
	    # Word data header
	    if($& eq '\220') {
		local($tmp) = $_;
		&Closing(1);
		$X0 = 0; $Y0 = 0; 
		&Opening("plot");
		&tk_open if($opt_t);
		&ps_open if($opt_p); 
		$X = $X0; $Y = $Y0; $max_height = 0;
		$_ = $tmp;
	    }
	    $length = ord(substr($_,0,1));
	    print STDERR "line:",unpack("H*",substr($_,0,$length)),"\n" if ($debug); 
	    if (! s/[\000-\377]\001\000([\002\x33])[\000-\377]//) {
		print STDERR "bad line ",unpack("H*",substr($_,0,$length)),"\n"; 
		last;
	    }
	    $ver = ord($1);
	    $length -= 5;

	    if ($ver == 0x33) {
		$width = ord(substr($_,0,1)) + 
		    ord(substr($_,1,1))*0x100;
		$height = ord(substr($_,2,1)) + 
		    ord(substr($_,3,1))*0x100;
		substr($_,0,8) = '';
		$length -= 8;
		$X = $100; $Y = $100; $max_height = 100;
	    } else {
		$width = ord(substr($_,0,1)) + 
		    ord(substr($_,1,1))*0x100;
		$height = ord(substr($_,2,1)) + 
		    ord(substr($_,3,1))*0x100;
		$scale = ($height>$std_height)?($std_height/$height):1;
		# $scale = 1;
		$height = int($height*$scale);
		$width = int($width*$scale);
		substr($_,0,4) = '';
		$length -= 4;
	    }


	    if($opt_p) { 
		print "% w $width h $height $scale $X $Y $com\n";
	    } elsif($opt_t) {
		print "# w $width h $height $scale $X $Y $com\n";
	    }

	    ##################
	    # Parse stroke data

	    @points = (unpack("B*",substr($_,0,$length)) =~
		/0.......|10...........|110.................../g);
	    # $i = 0;
	    # grep($i+=length,@points);
	    # print "$length = $i\n" if ($debug);
	    substr($_,0,$length) = '';
	    print STDERR "." if ($opt_f);

	    ##################
	    # Word position

	    $x = $X, $y = $Y;
	    $X += $width + 1;
	    if($X > $XMAX) {
		$Y += $max_height + 5;
		$X = $X0;
		if($Y > $YMAX) {
		    # $Y = $Y0;
		    $max_height = 0;
		    if($page-- <= 0) {
			last top_loop;
		    }
		}
		$x = $X, $y = $Y;
		$X += $width + 1;
	    }
	    if($height>$max_height) { $max_height = $height; }

	    &frame if($opt_F);
	    &code;
	    $x += $width  if ($dx<0) ;
	    $y += $height if ($dy<0) ;
	    $x0 = 0; $y0 = 0;

	    ##################
	    # Tcl/Tk output
	    if($opt_t) {
		$arg_count = 0;
		$prev_x = $x0; $prev_y = $y0;
		while(@points) {
		    $x0 += $dx; $y0 += $dy;
		    if($c) {
			if($arg_count==2) {
			    # Tcl/Tk is dumb enough to complain
			    print "$prev_x $prev_y"; 
			}
			$prev_x = $x+int($x0*$scale); 
			$prev_y = $y+int($y0*$scale);
			$arg_count = 0;
		    }  else {
			if($arg_count==0) {
			    print "\n$update\$c create line ";
			}
			$prev_x = $x+int($x0*$scale); 
			$prev_y = $y+int($y0*$scale);
			print $prev_x," ",$prev_y," ";
			$arg_count += 2;
		    } 
		    &code;
		}
		if($arg_count==2) {
		    # Tcl/Tk is dumb enough to complain
		    print "$prev_x $prev_y "; 
		}
	    ##################
	    # PostScript output
	    } elsif ($opt_p) {
		print "newpath ";
		$arg_count = 0;
		while(@points) {
		    $x0 += $dx; $y0 += $dy;
		    if($c) {
			print "stroke\nnewpath ";
			print "\n";
			$arg_count = 0;
		    }  else {
			print $x+int($x0*$scale)," ";
			print $y+int($y0*$scale)," ";
			if($arg_count++) {
			   print "lineto ";
			} else {
			   print "moveto ";
			}
		    }
		    &code;
		}
	    ##################
	    # TkPerl output
	    } elsif($tkperl) {
		@line = ();
		while(@points) {
		    $x0 += $dx; $y0 += $dy;
		    if($c) {
			if($#line>2) { 
			    &TkLine(*line);
			    return if(! $tkwait);
			}
			@line = ();
		    }  else {
			push(@line,$x+int($x0*$scale),$y+int($y0*$scale));
		    } 
		    &code;
		}
		if($#line>2) { 
		    &TkLine(*line);
		}
	    } else {
	    ##################
	    # plot output
		while(@points) {
		    $x0 += $dx; $y0 += $dy;
		    if($c) {
			print "\n" unless ($debug);
		    }  else {
			print $x+int($x0*$scale)," ";
			print -($y+int($y0*$scale)),"\n";
		    } 
		    &code;
		}
	    }
	    print "\n" if (! $tkperl);

	##################
	# other word data

	} elsif (s/^\022\000//) { ;
	    print "\n" if (! $tkperl);
	} elsif (s/^\021\000//) { ;
	    $X += $XMAX;
	    print "\n" if (! $tkperl);
	} elsif (s/^\000\000//) { ; # end code
	    $X += $XMAX;
	} elsif (s/^\000//) { ; # end code
	} elsif (s/^\042//) { ; # end code?
	} elsif (s/^\x13(.)//) { 
	    $len = ord($1)-2;
	    $save = "\x13".$1.substr($_,0,$len);
	    substr($_,0,$len)='';
	    print STDERR "13:",unpack("H*",$save),"\n" if ($debug);
	    print STDERR "13:",substr($save,15),"\n" if ($debug);
	} elsif (s/^.//) {
	    print STDERR "unknown htxt word code ",unpack("H*",$&),"\n";
	} else { s/^.//; }
    }

    ##################
    # Ending

    if($opt_p) {
	print "stroke\n\nshowpage\n";
	print "%%Trailer\nend\n";
    }
#    print STDERR "\n";

    &Closing(1);
}

$ps_scale = 1;

sub ps_open
{
    local($x,$y);

    print <<"EOF";
%!PS-Adobe-2.0 EPSF-1.2
%%Creator: zview.pl
%%DocumentFonts: Times-Roman
%%Pages: 1
EOF
    $x = $ps_scale * (-25) + 0; 
    $y = $ps_scale * (-$std_height); 
    print "%%BoundingBox: $x ",$y," ";
    $x = $ps_scale * ($XMAX/2+100) + 0; 
    $y = $ps_scale * (+$std_height) + $YMAX + $std_height/2; 
    print $x," ",$y,"\n";
    print "%%EndComments\n\n";
    printf "[$ps_scale 0 0 -$ps_scale 25 %d] concat\n",
	$YMAX+$std_height/2;
}

sub 
tk_open
{
    # print "wm geometry . -0-0\n";
    print "wm minsize . $XMAX $YMAX\n";
print <<'EOF';
set w ""
catch {destroy $w}
set c $w.c
frame $w.frame
button $w.frame.ok -text "OK" -command "destroy $w."
button $w.frame.big -text "Enlarge"   -command "canvaswh $c 1.6"
button $w.frame.small -text "Shrink" -command "canvaswh $c 0.625"

proc canvaswh {c scale} {
   regexp {([0-9]+)x([0-9]+)} [wm geometry .] dm w h
   $c scale all [$c canvasx [expr $w/2 ] ] \
		[$c canvasy [expr $h/2 ] ] $scale $scale
}

bind . <Key-q> { destroy . }
bind . <Shift-Key-q> { destroy . }
bind . <Key-End> { destroy . }

canvas $c -scrollincrement 150
scrollbar $w.vscroll  -relief sunken -command "$c yview"
scrollbar $w.hscroll -orient horiz -relief sunken -command "$c xview"
pack append $w.frame \
	$w.frame.ok {left expand} $w.frame.big {right} \
	$w.frame.small {right}
pack append $w. \
	$w.frame {bottom fill pady 10} \
	$w.hscroll {bottom fillx} $w.vscroll {right filly } \
	$c {top expand fill}
$c config -xscroll "$w.hscroll set" -yscroll "$w.vscroll set"
EOF
}

sub frame
{
    if($opt_t) {
	print "\$c create line ";
	print $x," ",$y," ";
	print $x+$width," ",$y," ";
	print $x+$width," ",$y+$height," ";
	print $x," ",$y+$height," ";
	print $x," ",$y," -fill red \n";
    } elsif($tkperl) {
#	&TkLine([$x,$y,$x+$width,$y,$x+$width,$y+$height,$x,$y+$height,$x,$y]);
	&TkLine0($x,$y,$x+$width,$y,$x+$width,$y+$height,$x,$y+$height,$x,$y);
    } elsif($opt_p) {
	print "newpath ";
	print $x," ",$y," moveto ";
	print $x+$width," ",$y," lineto ";
	print $x+$width," ",$y+$height," lineto ";
	print $x," ",$y+$height," lineto ";
	print $x," ",$y," lineto stroke\n";
    } else {
	print $x," ",-$y,"\n";
	print $x+$width," ",-$y,"\n";
	print $x+$width," ",-$y-$height,"\n";
	print $x," ",-$y-$height,"\n";
	print $x," ",-$y,"\n\n";
    }
}

# 
#     INK Warpro Bit stream (MSB first)
#        these data are not aligned to byte boundary.
#  (3)-1
#     8bit relative position
#              0bsx             s ... sign    b  ... silent move
#              xsyy             x, y  3bit 2's complement value
# 
#         silemnt movement represets disconnected segment
#  (3)-2
#     13bit relative position
#              10bs             
#              xxxx
#              syyy
#              y
#  (3)-3
#     22bit relative position
#              110b         
#              sxxx
#              xxxx
#              xsyy
#              yyyy
#              yy
# 
#     1110 format is unknown
# 

sub code 
{
    local($_) = shift(@points);
    if(/^00/) {
	$c = 0; $dx = $bit{substr($_,2,3)}; $dy = $bit{substr($_,5,3)};
    } elsif(/^01/) {
	$c = 1; $dx = $bit{substr($_,2,3)}; $dy = $bit{substr($_,5,3)};
    } elsif(/^100/) {
	$c = 0; $dx = $bit{substr($_,3,5)}; $dy = $bit{substr($_,8,5)};
    } elsif(/^101/) {
	$c = 1; $dx = $bit{substr($_,3,5)}; $dy = $bit{substr($_,8,5)};
    } elsif(/^1100/) {
	$c = 0;
	$dx = ord(pack("B*",substr($_,5,8)))-((substr($_,4,1) eq '1')?256:0); 
	$dy = ord(pack("B*",substr($_,14,8)))-((substr($_,13,1) eq '1')?256:0); 
    } elsif(/^1101/) {
	$c = 1;
	$dx = ord(pack("B*",substr($_,5,8)))-((substr($_,4,1) eq '1')?256:0); 
	$dy = ord(pack("B*",substr($_,14,8)))-((substr($_,13,1) eq '1')?256:0); 
    }  else {
	$dx = 0; $dy = 0; $c = 0;
    }
print STDERR "$& $c $dx $dy\n" if ($debug);
}

##########################################################
#
# Backup Data  (Not Yet Implemented)
#
##########################################################

sub Backup 
{
    if(! $backup_dir) { 
	&Print("\nBackup Directory\n");
	&z_decode;
	@title = (); @attr = ();
	$len = length($_) - 20; $j = 0;
	for($i=6;$i<$len;$i+=20) {
	    $title[$j] = substr($_,$i,12);
	    $attr[$j] = unpack("H*",substr($_,$i+12,5));
	    $size[$j] = (ord(substr($_,$i+17,1))
                 +ord(substr($_,$i+18,1))*0x100
                 +ord(substr($_,$i+19,1))*0x10000);
	    &Print($title[$j]."\t");
	    &Print($attr[$j]."\t");
	    &Print($size[$j]."\n");
	    $j++;
	}
	$backup_dir = 1; $backup_count++;
        $zaurus_files = 0;
        $zaurus_files_max = $j;
	if ($file_recovery) { 
	    mkdir "backup_dir$backup_count",0755 or die("Can't make directory zaurus_backup\n");
	}
        &Print("\n");
    } else {
        &z_decode;
	if ($file_recovery) { 
	    $name = $title[$zaurus_files]; $name =~ s/ //g;
	    open(OUT,"> backup_dir$backup_count/".$name)
		or die "can't open $name $!\n";
	    print OUT $_;
	    close(OUT);
	    print STDERR "backup: $name $size[$zaurus_files] ",length($_),"\n";
	    $zaurus_files ++;
	    if ($zaurus_files+1 > $zaurus_files_max) {
		$backup_dir = 0;
	    }
	} else {
	    print "backup file: $title[$zaurus_files]\n" if ($debug);
	    return if ($title[$zaurus_files++] !~ /BOX/);
	    &decode_box_data({},$_);
	    if ($zaurus_files > $zaurus_files_max) {
		$backup_dir = 0;
	    }
	    # &Print($_);
	}
    }
}

##########################################################
#
# TkPerl Part (remove from here to main if you don't use TkPerl)
#
##########################################################

use Tk;

$tkperl = 1;

sub TkOpening
{
    my($mytop);
    local($ext) = @_;
    # &Print("\n$ext: $title : $ARGV\n");

    if((!  $tktop) || ($retain_window && $tktop_used)) {
	if($tkmain) {
	    $tktop = $tkmain->Toplevel;
	    $mytop = $tktop;
	    $tops++; 
	} else {
	    $tkmain = MainWindow->new();
	    $tktop = $tkmain;
	    $mytop = 'main';
	    $tops++; 
	}
	print STDERR "Open $mytop, $tktop\n" if ($debug);
	$tktop_used = 0;
	$tkcanvas = $tktop->Canvas(
	     -bg=>'white'
	);
	$tkcanvas->pack;
	$tktop->Button(-text=>'Next',-command=>sub{&TkNext;})
           ->pack(-side=>'left',-expand=>1) if (! $retain_window);
	$tktop->bind('<space>'=>sub{&TkNext});

	$tktop->Button(-text=>'Quit',-command=>sub{&TkQuit($mytop);})
	   ->pack(-side=>'left',-expand=>1);
	$tktop->Button(-text=>'Quit All',-command=>sub{&TkQuitAll;})
	   ->pack(-side=>'left',-expand=>1);
	$tktop->bind('<q>'=>sub{&TkQuitAll;});
    }
    if($title=~/[\200-\377]/) {
	# no support for kanji on title (on many wm)
	$tktop->title("$ext $ARGV");
    } else {
	$tktop->title("$ext $title $ARGV");
    }
    # $tktop->update;
    if($ext eq "plot") {
	&TkClear; &TkSize(600,400); 
	$tktop_used = 1;
    } 
}

sub TkTextOpen
{
    my($mytop);
    if(! $tktext) {
	if($tkmain) {
	    $tktextop = $tkmain->Toplevel;
	    $mytop = $tktextop;
	    $tops++; 
	} else {
	    $tkmain = MainWindow->new();
	    $tktextop = $tkmain;
	    $mytop = 'main';
	    $tops++; 
	}
    print STDERR "Open $mytop\n" if ($debug);
    }

    $tktext = $tktextop->Text(-bg=>'white');
    $tktexts = $tktextop->Scrollbar(-command => [$tktext => 'yview']);
    $tktext->configure(-yscrollcommand => [$tktexts => 'set']);
    $tktexts->pack(-side => 'right', -fill => 'y');
    $tktext->pack(-expand => 'yes', -fill => 'both');

    $tktextop->Button(-text=>'Quit',-command=>sub{&TkQuit($mytop);})
       ->pack(-side=>'left',-expand=>1);
    $tktextop->Button(-text=>'Quit All',-command=>sub{&TkQuitAll;})
       ->pack(-side=>'left',-expand=>1);
    $tktextop->bind('<q>'=>sub{&TkQuitAll;});
    $tktextop->Button(-text=>'Next',-command=>sub{&TkNext;})
       ->pack(-side=>'left',-expand=>1) if (! $retain_window);
    $tktextop->bind('<space>'=>sub{&TkNext});
}

sub TkClosing {
    local($wait) = @_;

    if($tkbitmap) {
	&TkBitmap(*tkbitmap);
	$tkbitmap='';
	$tktop_used = 1;
    }
    $tkmain->update;
    &TkWait if ($wait && ! $retain_window);
}

sub TkSize {
    local($w,$h) = @_;
    $tkcanvas->configure(-width=>$w,-height=>$h);
}

sub TkPhoto {
    my ($data,$type) = @_;
    local($im);
    if ($type) {
	$im = $tktop->Photo( '-data' => $data, -format => $type);
    } else {
	$im = $tktop->Photo( '-file' => $data);
    }
    # $tkcanvas->delete('-tag'=>'image');
    $tkcanvas->delete('-tag'=>'all');
    $tkcanvas->configure(-width=>($im->width),-height=>($im->height));
    $tkcanvas->create('image',10,10,
	'-image'=>$im,
	-tag=>'image',
	-anchor=>'nw'
    );
}

sub TkBitmap {
    local(*data) = @_;
    local($im);
    $im = $tktop->Bitmap( '-data' => $data),
    # $tkcanvas->delete('-tag'=>'image');
    $tkcanvas->delete('-tag'=>'all');
    $tkcanvas->configure(-width=>($im->width),-height=>($im->height));
    $tkcanvas->create('image',10,10,
	'-image'=>$im,
	-tag=>'image',
	-anchor=>'nw'
    );
}

sub TkLine {
    local(*line) = @_;
    $tkcanvas->create('line',@line);
    $tkcanvas->update if($update) ;
}

sub TkLine0 {  # for Perl4 syntax..
    $tkcanvas->create('line',@_);
    $tkcanvas->update if($update) ;
}

sub TkQuit
{
    local($top)=@_;
    print STDERR "Quit $top $tops\n" if ($debug);
    if($top eq 'main') {
	$tkmain->UnmapWindow;
    } else {
	$top->destroy if (Exists($top));
    }
    if(-- $tops == 0) {
	exit(0);
    }
}

sub TkQuitAll 
{
    exit(0);
}

sub TkText {
    $tktext->insert('end',$_[0]);
    $tktext->see('end');
}

sub TkClear {
    $tkcanvas->delete('-tag'=>'all');
}

sub TkWait {
    $tkwait = 1;
    DoOneEvent(0) while($tkwait);
}

sub TkNext {
    $tkwait = 0;
}

##########################################################
#
# Decode .BOX file
#
##########################################################


my %item_type = (
'ADR1'=>'s', 'ADR2'=>'s', 'ALRM'=>'d', 'ANN1'=>'d', 'ANN2'=>'d', 'ATSC'=>'u',
'ATTM'=>'u', 'ATTR'=>'u', 'BRTH'=>'d', 'CFIP'=>'s', 'CHK1'=>'b', 'CHK2'=>'b',
'CHK3'=>'b', 'CHK4'=>'b', 'CLAS'=>'s', 'CLSC'=>'u', 'CNTC'=>'u', 'COLR'=>'u',
'CPS1'=>'s', 'CTGR'=>'u', 'DB01'=>'u', 'DB02'=>'u', 'DB03'=>'u', 'DB04'=>'u',
'DB05'=>'u', 'DB06'=>'u', 'DB07'=>'u', 'DB08'=>'u', 'DB09'=>'u', 'DB10'=>'u',
'DB11'=>'u', 'DB12'=>'u', 'DB13'=>'u', 'DB14'=>'u', 'DB15'=>'u', 'DB16'=>'u',
'DB17'=>'u', 'DB18'=>'u', 'DB19'=>'u', 'DB20'=>'u', 'DB21'=>'u', 'DB22'=>'u',
'DB23'=>'u', 'DB24'=>'u', 'DB25'=>'u', 'DB26'=>'u', 'DB27'=>'u', 'DB28'=>'u',
'DBFN'=>'u', 'DBID'=>'u', 'DBIT'=>'u', 'DBSI'=>'u', 'DBST'=>'u', 'DNS1'=>'s',
'DNS2'=>'s', 'ECDT'=>'u', 'EDDY'=>'d', 'EDTM'=>'d', 'ETDY'=>'d', 'FAX1'=>'s',
'FAX2'=>'s', 'FINF'=>'b', 'FNDY'=>'d', 'HOL1'=>'d', 'HTXT'=>'h', 'IMG1'=>'i',
'IMGF'=>'g', 'IMJG'=>'j', 'IORR'=>'b', 'LKDT'=>'d', 'LKIF'=>'u', 'LTDY'=>'d',
'MAL1'=>'s', 'MARK'=>'u', 'MEM1'=>'s', 'MLAD'=>'s', 'MLCC'=>'s', 'MLFM'=>'s',
'MLID'=>'u', 'MLRP'=>'s', 'MLTO'=>'u', 'MPFB'=>'s', 'NAME'=>'s', 'NAPR'=>'s',
'NMSK'=>'s', 'OFCE'=>'s', 'OFPR'=>'s', 'OPT1'=>'u', 'OPT2'=>'u', 'PGR1'=>'s',
'POPA'=>'s', 'POPP'=>'s', 'PRBD'=>'u', 'PRF1'=>'u', 'PRTY'=>'u', 'PSTN'=>'s',
'PSWD'=>'s', 'RCCK'=>'b', 'RDCK'=>'b', 'RMRK'=>'s', 'RVTM'=>'u', 'SBJT'=>'u',
'SCCP'=>'s', 'SCTG'=>'u', 'SCTN'=>'s', 'SDDT'=>'d', 'SDTM'=>'u', 'SPKS'=>'s',
'STDY'=>'d', 'SVAD'=>'s', 'TCPS'=>'u', 'TEL1'=>'s', 'TEL2'=>'s', 'TIM1'=>'d',
'TIM2'=>'d', 'TITL'=>'s', 'TMNL'=>'u', 'USID'=>'s', 'XLIF'=>'u', 'ZCCP'=>'s',
'ZIP2'=>'s', 'ZIPC'=>'s', 'ZPKS'=>'s', 'ZRTF'=>'u', 'ZXLS'=>'u', 'mDTM'=>'d',
'mISC'=>'u', 'tPID'=>'u', 
);

my %item_name = (
    'FNDY'=>'finish-date',
    'ETDY'=>'start-date',
    'LTDY'=>'deadline',
    'STDY'=>'start-date',
    'ADR1'=>'home-address',
    'ADR2'=>'address',
    'ANN1'=>'anniversary',
    'BRTH'=>'birth',
    'CLAS'=>'class',
    'CPS1'=>'mobile-tel',
    'DNS1'=>'DNS 1',
    'DNS2'=>'DNS 2',
    'EDTM'=>'edit-time',
    'FAX1'=>'home-fax',
    'FAX2'=>'fax',
    'HTXT'=>'hand-text',
    'IMG1'=>'image',
    'IMGF'=>'gif',
    'IMJG'=>'jpg',
    'LKDT'=>'link-date',
    'MAL1'=>'mail',
    'MEM1'=>'memo',
    'MLAD'=>'mail-adderess',
    'MLTO'=>'mail-to',
    'NAME'=>'name',
    'NAPR'=>'name-yomi',
    'NMSK'=>'mask',
    'OFCE'=>'office',
    'OFPR'=>'office-yomi',
    'POPA'=>'pop 1',
    'POPP'=>'pop p',
    'PSTN'=>'position',
    'PSWD'=>'password',
    'RMRK'=>'remark',
    'SCCP'=>'sccp',
    'SCTN'=>'section',
    'SDTM'=>'sdtm',
    'SPKS'=>'spks',
    'SVAD'=>'cvad',
    'TEL1'=>'home-tel',
    'TEL2'=>'tel',
    'TIM1'=>'date',
    'TIM2'=>'end-date',
    'TITL'=>'title',
    'USID'=>'user id',
    'ZCCP'=>'zccp',
    'ZIP2'=>'home-zip',
    'ZIPC'=>'zip',
    'ZPKS'=>'packats',
    'mDTM'=>'modify-date',
);


sub item_list {
    my ($self,$data) = @_;
    my ($value,@index);
    my ($debug) = $self->{'-debug'};

    my $title_offset;
    my $title_len = 0;
    my $field_offset;

    my $version = unpack("n",substr($data,2,2));
    $self->{'-zaurus-version'} = $version;
    # $title_offset += ($version < 0x1030)?2:0;

    if ($version <= 0x1002 ) {
	$title_offset = 0x15;
	$self->{'-title-begin'} = $title_offset;
	$field_offset = 1;
    } elsif ($version < 0x1030 ) {
	$title_offset =  unpack("V",substr($data,0x8,4));
	$self->{'-title-begin'} = $title_offset;
	$title_offset += 2;
	$field_offset = 2;
    } else {
	$title_offset =  unpack("V",substr($data,0x8,4));
	$self->{'-title-begin'} = $title_offset;
	$field_offset = 2;
    }

    my $title_count =  ord(substr($data,$title_offset,1));
    my $ptr = $title_offset+1;
    my $i = 0;
    print "\n\nfile:",$self->{'-file'},"\n\n" 
        if ($debug && defined ($self->{'-file'}));
    while($title_count-->0) {
	my $item_len =  ord(substr($data,$ptr,1));
	$ptr += 2;
	# print "item: ",unpack("H*",substr($data,$ptr,$item_len)) if ($debug);
	my $id = $self->{'-item_id'}->[$i] = substr($data,$ptr+$field_offset,4);
	my $name = $self->{'-item_name1'}->[$i] = 
		substr($data,$ptr+5,$item_len-5);
	print "list:\t$i:$id:$item_len:$name\n" if ($debug);
	$ptr += $item_len;
	$i++;
    }
    print "title-len: $version $title_len ",$ptr - $title_offset,"\n" if ($debug);
    $self->{'-item_name_count'} = $i;
    $self->{'-title-length'} = $ptr-$title_offset;
}



sub decode_box_data {
    my ($self,$data) = @_;
    $self->{'-debug'} = $opt_d;
    $self->{'-data'} = $data;
    $self->{'-item_type'} = \%item_type;
    $self->{'-item_name'} = \%item_name;
    $self->{'-offset'} = 8;
    $self->{'-output'} = $self;
    my $debug = $self->{'-debug'};
    bless $self;


    $self -> item_list($data);
    my $version = $self->{'-zaurus-version'};

    my @len = ();
    my $ptr;
    if ($version < 0x1020) {
	$ptr = $self->{'-title-begin'} + $self->{'-title-length'};
    } else {
	$ptr = unpack("V",substr($data,4,4));
    }
    printf "index: %x\n",$ptr if ($debug);

    my $old_number = 0;

    while(1) {
	my %record = ();
	my @key_list = ();
	my $record_number;
	my $record_length;
	my ($key,$item,$type);

	if ($version < 0x1020) {
	    $record_number = ord(substr($data,$ptr++,1));
	    my $optr = $ptr;
	    while ($record_number != $old_number+1) {
		$ptr++;
		$record_number = ord(substr($data,$ptr++,1));
		return if ($ptr>length($data));
	    }
	    $record_length = unpack("n",substr($data,$ptr,2));
	    print "offset: ",$ptr-$optr,"\n" if ($optr<$ptr && $debug);

	    print "record_number:  $record_number\n" if ($debug);
	    print "record_length:  $record_length\n" if ($debug);
	    $old_number = $record_number;
	    # last if ($record_length == 0);
	    $ptr+=2;
	    $ptr+=3;
	    printf "index: %x\n",$ptr if ($debug);
	    my $i = 0;
	    for(my $j=$self->{'-item_name_count'}; $j>0; $j--) {
		my $len=ord(substr($data,$ptr++,1));
		if ($len>=0x80) {
		    $len = ord(substr($data,$ptr,1))+($len-0x80)*256;
		    $ptr++; 
		}
		print "len:  $len\n" if ($debug);
		last if ($ptr+$len > length($data));
		print "data: ",substr($data,$ptr,$len),"\n" if ($debug);
		($key,$item,$type) = 
		    $self->decode_item($i,substr($data,$ptr,$len));
		if ($type eq 's' || $type eq 'd') {
		    push(@key_list,$key);
		    $record{$key} = $item;
		} elsif ($key eq 'hand-text') {
		    push(@key_list,$key);
		    $record{$key} = $item;
		} elsif ($key eq 'image') {
		    push(@key_list,$key);
		    $record{$key} = $item;
		} elsif ($key eq 'gif') {
		    push(@key_list,$key);
		    $record{$key} = $item;
		} elsif ($key eq 'jpg') {
		    push(@key_list,$key);
		    $record{$key} = $item;
		} elsif ($self->{'-all'}) {
		    push(@key_list,$key);
		    $record{$key} = $type.":".unpack("H*",$item);
		}
		$i++;
		$ptr += $len;
	    }
	} else {
	    my $index = $ptr;
	    $record_number=ord(substr($data,$index,1)) +
		ord(substr($data,$index+1,1))*256;
	    $record_length=ord(substr($data,$index+2,1)) +
		ord(substr($data,$index+3,1))*256;

	    my $item_count=ord(substr($data,$index+6,1));
	    my $item_dummy=ord(substr($data,$index+10,1));

	    if ($version >= 0x1030) {
		$ptr = $index + 10;
	    } else {
		$ptr = $index + 8;
	    }
	    printf "index: %x\n",$ptr if ($debug);
	    my @len = ();
	    my $total_len = 0;
	    for(my $j=$self->{'-item_name_count'}; $j>0; $j--) {
		my $i=ord(substr($data,$ptr,1));
		if ($i>=0x80) {
		    $ptr++; 
		    $i = ord(substr($data,$ptr,1))+($i-0x80)*256;
		}
		print "len:  $i\n" if ($debug);
		push(@len,$i);
		$total_len += $i;
		$ptr++;
	    }
	    print "offset: ",$ptr-$index-$item_count,"\n" if ($debug);
	    # $ptr = $index+8+$item_count;
	    my $i = 0;
	    foreach my $len (@len) {
		last if ($ptr+$len > length($data));
		($key,$item,$type) = 
		    $self->decode_item($i,substr($data,$ptr,$len));
		$i++;
		$ptr += $len;
		if ($type eq 's' || $type eq 'd') {
		    push(@key_list,$key);
		    $record{$key} = $item;
		} elsif ($key eq 'hand-text') {
		    push(@key_list,$key);
		    $record{$key} = $item;
		} elsif ($key eq 'image') {
		    push(@key_list,$key);
		    $record{$key} = $item;
		} elsif ($key eq 'gif') {
		    push(@key_list,$key);
		    $record{$key} = $item;
		} elsif ($key eq 'jpg') {
		    push(@key_list,$key);
		    $record{$key} = $item;
		} elsif ($self->{'-all'}) {
		    push(@key_list,$key);
		    $record{$key} = $type.":".unpack("H*",$item);
		}
	    }
	}
	print "\n" if ($debug);;
	# $self->date_normalize(\@key_list,\%record);
	$self->{'-output'}->record(\@key_list,\%record);
    }
}

sub decode_time {
    my ($self,$t) = @_;

    return '' if (! $t);
    # print unpack("H*",substr($t,1,4)),"\n";

    $t = hex(unpack("H*",substr($t,1,4)));
    my $year =  ($t&0x0000000f)*16 ;
    $year +=   (($t&0x0000f000)>>12) + 1900;
    my $month = ($t&0x00000f00)>>8;
    my $day =   ($t&0x00f80000)>>19;
    my $min =   ($t&0x3f000000)>>24;
    my $hour =((($t&0xc0000000)>>30)&0x3)<<0;
    $hour +=   (($t&0x00070000)>>16)<<2;
    if ($year == 2155) { # unspecified case
	$t = sprintf("%d/%d",$month,$day);
    } else {
	$t = sprintf("%04d/%d/%d",$year,$month,$day);
    }
    if($min!=63) {
        $t .= sprintf(" %02d:%02d",$hour,$min);
    }
    $t;
}

sub decode_item {
    my ($self,$i,$item) = @_;
    my $all = $self->{'-all'};
    my $debug = $self->{'-debug'};

    return if (! $item);
    # print $self->{'-item_id'}->[$i],": ",unpack("H*",$item),"\n";
    my $id_name =  $self->{'-item_id'}->[$i];
    my $id_type =  $self->{'-item_type'}->{$id_name};

    if ($self->{'-item_list'} eq 'original') {
	$id_name = $self->{'-item_name1'}->[$i];
    } elsif ($self->{'-item_list'} eq 'id') {
    } elsif (defined $self->{'-item_name'}->{$id_name}) {
	$id_name = $self->{'-item_name'}->{$id_name};
    }

    if ( $id_type eq 'd' ) {
	$item = $self->decode_time($item);
    }
    return ($id_name,$item,$id_type);
} 

sub record {
    my ($self,$keys,$records) = @_;
    if (defined $records->{'hand-text'}) {
	&hand_text($records->{'hand-text'});
    } elsif (defined $records->{'jpg'}) {
	&jpg($records->{'jpg'});
	undef $records->{'image'};
    } elsif (defined $records->{'gif'}) {
	&gif($records->{'gif'});
	undef $records->{'image'};
    } elsif (defined $records->{'image'}) {
	&image(unpack('H*',$records->{'image'}));
    } else {
	    &TextOpen;
	    # should be override
	    my $buf = '';
	    foreach my $key (@$keys) {
		$buf .= "$key: $records->{$key}\n"
		    if ($records->{$key});
	    }
	    &Print($buf) ;
	    &TextClose;
    } 
}

##########################################################
#
# Call main after data initilization
#
##########################################################

&main;

# end