#!/usr/bin/perl

use POSIX;
use Getopt::Std;

# POSIX misses this one, and we absolutely must have it
sub CRTSCTS {020000000000};

%rates = (4800 => 0, 9600 => 1, 19200 => 2, 38400 => 3);
%posix = (4800 => POSIX::B4800, 9600 => POSIX::B9600,
	    19200 => POSIX::B19200, 38400 => POSIX::B38400);
$opt{n}="pic";
$opt{B}=19200;
$opt{p}="/dev/ttyS0";
$QUALFACTOR=1;

$SIG{INT} = sub {
    print "Cleaning up\n";
    while (sysread(PORT, $junk, 100)) {};
    setbaud(19200);
    exit(2);
};

getopts ("hB:lg:an:qp:eEctT:d", \%opt);

if ($opt{t})
{
    require Image::Magick;
    import Image::Magick;
}

if ($opt{h})
{
    print <<EOF;
$0 options:

    -B rate	Baud rate was left on this rate, not default of 19200
    -l		Get the number of pictures on the camera
    -g N,N2,...	Get listed pictures (numbers start at 1)
    -a		Get all
    -n name	Filename (or filename-base for getting all pictures)
    -q		Quiet operation (no messages)
    -p name	Port (default /dev/ttyS0)
    -e		Erase all
    -E		Erase last
    -c		Capture (take a picture)
    -d		Dump remainder of previous transaction
    -t		Make a preview of thumbnails.
    -T n	Just download the listed thumbnail and save it raw

If only one picture is being downloaded, the given name (default "pic")
will be used directly, with a .jpg extension added if it has no dot.
If multiple pictures are being downloaded, a number will be added to the
picture, and a .jpg extension will be added.

The -t option requires Image::Magick.  It saves as a PNG by default, but
this can be overridden by giving another extension with -n.
EOF

    exit;
}

sysopen PORT, "$opt{p}", 2 or die "Can't open $PORT\n";

speed($posix{$opt{B}});

# If we just want a count, don't bother changing the baud rate
if ($opt{l})
{
    my $sheets=getsheets();
    if ($opt{q}) {
	print $sheets . "\n";
    } else {
	print "Camera has $sheets pictures on it\n" ;
    }
    exit;
}

if ($opt{e})
{
    erase(1);
    exit;
}

if ($opt{E})
{
    erase(0);
    exit;
}

if ($opt{c})
{
    capture();
    exit;
}

if ($opt{d})
{
    while (sysread(PORT, $junk, 100)) {};
    exit;
}

if ($opt{g})
{
    setbaud(38400);
    if ($opt{g} !~ /,/)
    {
	$opt{n} .= ".jpg" unless $opt{n} =~ /\./;
	getnormal($opt{g}, $opt{n});
    }
    else
    {
	my @num=split ',', $opt{g};
	foreach $n (@num)
	{
	    my $name= sprintf"%s%02d.jpg", $opt{n}, $n;
	    getnormal($n, $name);
	}
    }
    setbaud(19200);
    exit;
}

if ($opt{a})
{
    setbaud(38400);
    my $sheets=getsheets();
    print "Getting $sheets pictures altogether\n" unless $opt{q};
    for ($n=1; $n<=$sheets; $n++)
    {
	my $name= sprintf"%s%02d.jpg", $opt{n}, $n;
	getnormal($n, $name);
    }
    setbaud(19200);
    exit;
}

if ($opt{T})
{
    setbaud(38400);
    my $pic=returnthumb($opt{T});
    open PIC, ">$opt{n}";
    print PIC $pic;
    close PIC;
    setbaud(19200);
    exit;
}

if ($opt{t})
{
    setbaud(38400);
    thumbmontage();
    setbaud(19200);
    exit;
}

print "You didn't give any options!  Use -h for help.\n";

sub setbaud
{
    my $baud=$_[0];
    my $chr=chr($rates{$baud});

TRYBAUDAGAIN:
    sysread (PORT, $junk, 100);
    syswrite PORT, "\xFC$chr";
    my $resp;
    sysread (PORT, $resp, 2);

    goto TRYBAUDAGAIN if (not $resp);

    if ($resp ne "\xFC$chr") # junk after for some reason
    {
#	my @chars = split '', $resp;
#	print "$#chars + 1 in response\n";
#	printf ("%x %x %x\n", ord($chars[0]), ord($chars[1]), ord($chars[2]));
	die "Error changing baud rate.  Is the camera connected and turned on?\n";
    }

    print "Set baud rate to $baud\n" unless $opt{q};
    
    speed($posix{$baud});
}

sub getsheets
{
    my $string="\xFA";
    sysread (PORT, $junk, 100);
    syswrite PORT, $string;
    my $resp;
    sysread(PORT, $resp, 2);
    my @chars = split '', $resp;
    if ($chars[0] ne "\xFA") {
	die "Error getting picture count.  Is the camera connected and on?\n";
    }
    return ord($chars[1]);
}

sub erase
{
    my $all=$_[0];
    my $string=sprintf("%c%c", 0xfc, 0x10+$all);
TRYERASEAGAIN:
    sysread (PORT, $junk, 100);
    syswrite PORT, $string;
    my $resp;
    sysread(PORT, $resp, 2);
    goto TRYERASEAGAIN if $resp ne $string;

    if ($all and not $opt{q}) {
	print "Begun erasing all pictures.\n";
    } elsif (not $opt{q}) {
	print "Begun erasing last picture.\n";
    }
}

sub capture
{
    my $string="\xFD";
TRYCAPAGAIN:
    sysread (PORT, $junk, 100);
    syswrite PORT, $string;
    my $resp;
    sysread(PORT, $resp, 3);
    goto TRYCAPAGAIN if not $resp;
    if ($resp eq "\xFD\xEE\xEE")
    {
	print "Memory full!  Can't capture.\n" unless $opt{q};
	exit(1);
    }
    if ($resp eq "\xFD\xFF\xFF")
    {
	print "Capturing.\n" unless $opt{q};
    } else
    {
	die "Unknown result code from capture\n";
    }
}

sub returnthumb
{
    my ($picnum)=@_;
    my $string=sprintf("%c%c%c", 0xfb, 00, $picnum);

TRYGETNAGAIN:
    sysread (PORT, $junk, 100);
    syswrite PORT, $string;
    my $resp;
    sysread(PORT, $resp, 7);

    goto TRYGETNAGAIN if (not $resp);

    my ($cmd, $big, $hi, $bytes) = unpack("CCCN", $resp);
    $QUALFACTOR=2-$hi;
    print "Thumbnail $picnum: $bytes bytes\n" unless $opt{q};
    my $pic;
    while (length($pic) < $bytes)
    {
	sysread(PORT, $resp, $bytes-length($pic));
	die "Not enough picture data" if (not $resp);
	$pic .= $resp;
#	printf ("%10d\r", length($pic)) unless $opt{q};
    }
    return $pic;
}

sub getnormal
{
    my ($picnum,$filename)=@_;
    my $string=sprintf("%c%c%c", 0xfb, 01, $picnum);

TRYGETNAGAIN:
    sysread (PORT, $junk, 100);
    syswrite PORT, $string;
    my $resp;
    sysread(PORT, $resp, 7);

    goto TRYGETNAGAIN if (not $resp);

    my ($cmd, $big, $num, $bytes) = unpack("CCCN", $resp);
    printf("Image %d:      /%5d%s", $num, $bytes, "\b"x6) unless $opt{q};
    my $pic;
    while (length($pic) < $bytes)
    {
	sysread(PORT, $resp, $bytes-length($pic));
	die "Not enough picture data" if (not $resp);
	$pic .= $resp;
	printf ("%s%5d", "\b"x5, length($pic), $bytes) unless $opt{q};
    }
    print "\n" unless $opt{q};
    open PIC, ">$filename";
    print PIC $pic;
    close PIC;
}

sub speed
{
    # This sets the speed, but it also sets all the other required parameters
    # of the serial port.

    $ti=POSIX::Termios->new;
    $ti->getattr(fileno(PORT));
    $ti->setispeed($_[0]);
    $ti->setospeed($_[0]);
    my $cflag=$ti->getcflag();
    my $oflag=$ti->getoflag();
    my $lflag=$ti->getlflag();
    my $iflag=$ti->getiflag();

    $iflag &= ~(IGNBRK|BRKING|PARMRK|ISTRIP|INLCR|IGNCR|ICRNL|IXON);
    $oflag &= ~(OPOST|CSTOPB);
    $lflag &= ~(ECHO|ECHONL|ICANON|ISIG|IEXTEN);
    $cflag &= ~(CSIZE|PARENB|CRTSCTS);
    $cflag |= CS8;
    $ti->setcc(VMIN, 0);
    $ti->setcc(VTIME, 3);

    $ti->setcflag($cflag);
    $ti->setoflag($oflag);
    $ti->setlflag($lflag);
    $ti->setiflag($iflag);
    $ti->setattr(fileno(PORT), POSIX::TCSANOW) or die "Can't set attributes\n";
}

sub readthumb
{
    my $blob="\x00"x(60*80*3);

    my $string = unpack "B*", $_[0];

    %ymap = ("00" => 0, "010" => 1, "011" => 2, "100" => 3, "101" => 4,
	    "110" => 5);
    %cmap = ("00" => 0, "01" => 1, "10" => 2);

    my ($yy, $cb, $cr)=(128,0,0);
    for (my $y=0; $y<60; $y+=2)
    {
	for (my $x=0; $x<80; $x+=2)
	{
	    my $len;
	    my $val;

	    my @ytemp;

	    for ($yoff=0; $yoff<2; $yoff++)
	    {
		for ($xoff=0; $xoff<2; $xoff++)
		{
		    $len=unpackylen($string);
		    $val=unpackval($string, $len);
		    $yy += $val;
		    $ytemp[$yoff][$xoff]=$yy;
		}
	    }

	    $len=unpackclen($string);
	    $val=unpackval($string, $len);
	    $cr+=$val;

	    $len=unpackclen($string);
	    $val=unpackval($string, $len);
	    $cb+=$val;

	    for ($yoff=0; $yoff<2; $yoff++)
	    {
		for ($xoff=0; $xoff<2; $xoff++)
		{
		    my $r =$ytemp[$yoff][$xoff] + 1.7753*$cb - 0.0015*$cr;
                    my $g =$ytemp[$yoff][$xoff] - 0.3443*$cb - 0.7137*$cr;
                    my $b =$ytemp[$yoff][$xoff] - 0.0009*$cb + 1.4017*$cr;

		    # It may go up to 256 by itself... that's not ok
		    $r=255 if $r>255;
		    $g=255 if $g>255;
		    $b=255 if $b>255;

                    substr($blob,(($y+$yoff)*80+$x+$xoff)*3+0,1)=chr($r);
                    substr($blob,(($y+$yoff)*80+$x+$xoff)*3+1,1)=chr($g);
                    substr($blob,(($y+$yoff)*80+$x+$xoff)*3+2,1)=chr($b);
		}
	    }
	}
    }

    # Legitimate end-padding is all ones, which cannot represent legitimate
    # data because it's a huffman code that doesn't finish.
    if (length($string)>15 and $string !~ /^1+$/)
    {
	print "Leftover data!\n";
	print $string."\n";
    }

    return $blob;
}

sub thumbmontage
{
    my $sheets = getsheets();

    print "Downloading $sheets thumbnails\n";

    my $rows = int (($sheets-1)/6+1);
    my $height = $rows * 80;
    my $montage = Image::Magick->new(size=>"530x$height");
    $montage->Read("XC:black");

    for (my $i=0; $i<$sheets; $i++)
    {
	my $rawdata=returnthumb($i+1);
	my $blob=readthumb($rawdata);
	my $im=Image::Magick->new(size => '80x60', magick => "RGB", depth => 8);

	my $row=int ($i/6);
	my $col=$i%6;
	$im->BlobToImage($blob);
#	$im->Read("XC:red");
	$montage->Composite(image => $im, x => $col*90, y => $row*80);
	$montage->Annotate(text => $i+1, x => $col*90+35, y => $row*80+72,
	    font => "*-Helvetica-*", pointsize => 12, stroke => "blue",
	    fill => 'white');
    }
    if ($opt{n} eq "-") {
	$montage->Display();
    } else {
	$opt{n} .= ".png" if $opt{n} !~ /\./;
	$montage->Set(magick => "PNG");
	print $montage->Write($opt{n});
    }
}

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

sub unpackylen
{
    my $sub = substr($_[0], 0, 2, '');
    if ($sub eq "00") {
        return 0;
    }
    $sub .= substr($_[0], 0, 1, '');
    if ($sub ne "111") {
        return $ymap{$sub};
    }

    do
    {
        $sub .= substr($_[0], 0, 1, '');
    } while $sub !~ /0$/;

    return length($sub)+2;
}

sub unpackclen
{
    my $sub = substr($_[0], 0, 2, '');
    if ($sub ne "11") {
        return $cmap{$sub};
    }
    do
    {
        $sub .= substr($_[0], 0, 1, '');
    } while $sub !~ /0$/;

    return length($sub);
}
sub unpackval
{
    my $len=$_[1];
    die "Unhandled length $len\n" if ($len > 8);
    return 0 if $len==0;

    my $val=substr($_[0], 0, $len, '');
    if ($val =~ /^1/) {
#       print "p: ";
        return strtonum($val)*$QUALFACTOR;
    } else {
#       print "n: ";
        return (strtonum($val) - (1<<$len) + 1)*$QUALFACTOR;
        # Don't ask me why it's +1 at the end.  I see no real need.
        # Sure, it lets you represent zero, but you can also do that
        # with zero length.
    }
}

sub strtonum
{
    my @let = split '', $_[0];
    my $val=0;
    foreach $l (@let)
    {
        $val*=2;
        $val++ if $l eq '1';
    }

    return $val;
}