#!/usr/bin/perl -w
#
# ledsign.pl - next step after writepic.pl
#
# this controls the LED sign.  contains some functions to 
# do various display things.
#
# Please make me better....many functions can be combined/simplified....
# Reusing code is good foo!
# There's likely a HUGE need for code reuse here...
#
# Porting to linux 
#
#

use strict;
use IO::Handle;
use Data::Dumper;
use Getopt::Long;
use Time::HiRes qw( gettimeofday );
use POSIX qw(strftime);
use Socket;

# Command defines
my $CMD_READ = 200;
my $CMD_SHIFTL = 201;
my $CMD_SHIFTR = 202;
my $CMD_SHIFTINL = 203;
my $CMD_SHIFTINR = 204;
my $CMD_INVERT = 205;

# Local defines
#my $COMPORT = 'COM1';
#my $COMPORT = '/dev/ttyS1';
my $COMPORT = '/dev/ttyS0';
my $BAUD = 115200;
#my $PORTCONFIG = 'serial.cfg';		# used when running in winderz
my $DEFAULT_FONT = 'ledsign.flf';
my $COLCT = 143;		# number of cols on display

my $CURL = "/usr/local/bin/curl";
my $PIPENAME = "/home/jason/prog/ledsign/ledfifo";

# The userid to set to when running as daemon
# can be used in boot scripts
# (not yet implemented)
#my $SETUSER = "jason";


# Globals 
my @fonts;
my @lastscn;
	
# A MUCH better approach would be to load the actual sign bytes....
foreach (0..$COLCT-1) { push @lastscn, 0; }	# Consider changing this... (?)

system("stty 115200 -echo -echoe -echok -echoctl -echoke -parodd -ignpar -inpck -istrip raw -parmrk -parenb cs8 -cstopb < $COMPORT");
open FH, "+<" . $COMPORT or die "ERROR opening serial port.";

# Load all relevant fonts
push @fonts, loadFont($DEFAULT_FONT);


sub showHelp {
	print " Commands:\n\n";
	print " clear                   - clear the sign\n";
	print " clwipe [<speed>]        - wipe screen clear from left at <speed>\n";
	print " ctr <num>               - count up to <num> as fast as possible\n";
	print " criu <str>              - column roll <str> in up\n";
	print " crwipe [<speed>]        - wipe screen clear from right at <speed>\n";
	print " dump                    - dump sign screen mem\n";
	print " fill <value>            - fill sign with value\n";
	print " help                    - shows this\n";
	print " invert                  - invert display\n";
	print " kriu <str>[, <speed>]   - char roll <str> in up\n";
	print " krid <str>[, <speed>]   - char roll <str> in down\n";
	print " load                    - load sequential data\n";
	print " lwipe <msg>             - left-to-right wiping overlay <msg>\n";
	print " msg <msg>               - put left aligned <msg>\n";
	print " mc <msg>                - put centered <msg>\n";
	print " msl <msg>[,<sp>,<sb>]   - scroll <msg> across left, speed <sp>, shiftby <sb>\n";
	print " msr <msg>               - scroll <msg> across right\n";
	print " mslc <msg>              - scroll <msg> by chars across left\n";
	print " mwc <msg>[, <speed>]    - display <msg> word-wise in center\n";
	print " mwoi                    - middle wipe off inward\n";
	print " mwoo                    - middle wipe off outward\n";
	print " rwipe <msg>             - right-to-right wiping overlay <msg>\n";
	print " quit                    - quits\n";
	print " randi <str>[, <speed>]  - random fade in <str>\n";
	print " rando [speed]           - random dissolve out\n";
	print " read <addr>             - read location <addr>\n";
	print " rid <str>               - roll <str> in down\n";
	print " riu <str>               - roll <str> in up\n";
	print " rod <str>               - roll off down\n";
	print " rou <str>               - roll off up\n";
	print " sil <data>              - shift <data> in from left\n";
	print " sir <data>              - shift <data> in from right\n";
	print " sl <num>                - shift sign left <num>\n";
	print " sr <num>                - shift sign right <num>\n";
	print " time [loops] [fmt#]     - display date/time\n";
	print " write <addr> <data>     - write <data> to <addr>\n";
	print " <enter>                 - repeat last command\n";
	print " ...some commands can be abbreviated.\n\n";
	print " --daemon (or -d)        - daemon mode (read from stdin)\n";
	print " --pipe   (or -p)        - daemon reads from named pipe\n";
	print " --socket <n> (or -s)    - daemon reads from socket port <n>\n";
}

# Loads a font file into memory, returns a reference
# to the memory structure.
sub loadFont {
	my %ret;
	my $fname = shift;
	!$fname and $fname = $DEFAULT_FONT;

	open FFH, "<" . $fname or return undef;

	$ret{"name"} = $fname;

	my $ascval = 0x20;		# Begin with space
	my $row = 0;
	my $char;
	while(my $line = <FFH>){
		
		chomp $line;
		$line =~ s/\s+$//;
		next if $line =~ /^COMMENT/;

		$char = \%{$ret{$ascval}};

		if($line =~ /\@$/){			# char line
			
			my $data = $line;
			$data =~ s/\$\@+$//;
			$char->{"rows"}[$row++] = $data;
			
			if($line =~ /\@\@$/){		# last row
				$char->{"rowct"} = $row;
				$ascval++;
				$row = 0;
			}
		}
		elsif( $line =~ /^\d+ C\d\d\d/){
			$line =~ s/^(\d+).*/$1/;
			$ascval = $line;
		}
	}
	close FFH;

	return \%ret;
}

# returns a string composed of the font text
sub makeMsg {
	my %f = %{ shift() };
	my $msg = shift;
	my $restxt = '';
	my @retrows;

	my @chars = split //, $msg;
	foreach my $char (@chars){
		my $ch = $f{ ord($char) };
		my @chrows = @{$ch->{"rows"}};
		foreach my $i (0..$#chrows){
			$retrows[$i] .= $chrows[$i];
		}
		#print Dumper($ch);
	}
	foreach(@retrows){
		$restxt .= $_ . "\n";
	}
	return $restxt;
}

# Similar to makeBinaryScreen, but only creates one character.
sub makeBinaryChar { 
	my %f = % {shift() };
	my $char = shift;

	my $msg = makeMsg(\%f, $char);

	my @lines = split /\n/, $msg;
	my $linect = $#lines+1;
	my $width = 0;
	foreach(@lines){
		$width = length($_) if length($_) > $width;
	}
	my @ret;
	for(my $i=0; $i < $width; $i++){
		my $byte = 0;
		for(my $j=0; $j < $linect; $j++){
			my $c = substr($lines[$j] , $i, 1);
			($c ne ' ') and ($byte += (1 << $j));
		}
		$ret[$i] = $byte;
	}
	return \@ret;
}

# converts a text string to binary equivalent
# result returned as a ref to array of numbers, left to right,
# with width of $COLCT
# If the $center param is given, the message will be 
# centered, otherwise it's left aligned.
# problems?  this assumes all chars same height...
sub makeBinaryScreen { 
	my %f = % {shift() };
	my $msg = shift;
	my $center = shift;
	my @ret;
	my $i;

	$msg = makeMsg(\%f, $msg);
	#print $msg . "\n";
	my @lines = split /\n/, $msg;
	my $linect = $#lines+1;
	my $width = 0;
	foreach(@lines){
		$width = length($_) if length($_) > $width;
	}
#	print "DEBUG: linect = $linect\n";
#	print "DEBUG: width = $width\n";
	for($i=0; $i < $width; $i++){
		my $byte = 0;
		for(my $j=0; $j < $linect; $j++){
			my $c = substr($lines[$j] , $i, 1);
			($c ne ' ') and ($byte += (1 << $j));
		}
		$ret[$i] = $byte;
		#print "DEBUG: $i -> $byte\n";
	}

#	($width > $COLCT) and $width = $COLCT;

	my ($pre, $post);
	if($center){
		# find actual length
		$pre = 0;
		#while( $ret[$pre] == 0){
		while( !$ret[$pre] ){
			$pre++;
		}
		$post = $#ret;
		#while($ret[$post] == 0){
		while($ret[$post]){
			$post--;
		}
#		my $width = ($post - $pre) + 1;
		my $offset = ($COLCT - $width)/2;
#		print "DEBUG: $width $offset\n";
		my @tmpret = @ret;
		undef @ret;
		foreach (0..$offset-1){
			push @ret, 0;
		}
		foreach ($pre..$post){
			push @ret, $tmpret[$_];
		}
	}

	# push on zeros to fill screen
	while($i <= $COLCT){
		push @ret, 0;
		$i++;
	}
	
	return \@ret;
}

# This takes two "screens" and only changes the columns that 
# are different.  Hopefully this can be used to reduce some
# screen display times by removing redundancy.
sub showDiffScreen {
	my @scn1 = @{ shift() };
	my @scn2 = @{ shift() };
	my $mybytes;
	my $bytect = 0;

	foreach my $i (0..$COLCT-1){
		if( $scn1[$i] != $scn2[$i]){
			$mybytes .= pack("C", $i+1);
			$mybytes .= pack("C", $scn2[$i]);
			#print "DEBUG: col $i -> " . $scn1[$i] . " vs " . $scn2[$i] . "\n";
			$bytect += 2;
		}
	}

	if($bytect){
		my $ct = syswrite(FH, $mybytes, $bytect);
	}
	@lastscn = @scn2;
#	printf("Diff just changed %d columns....\n", $bytect/2);
	
}

sub doMsg {
	my @tmpdec;
	my $msg = shift;
	my $center = shift;
	my ($pre, $post);
	my $mybytes;

	my @dec = @{ makeBinaryScreen( $fonts[0], $msg, $center) };
	while($#dec >= $COLCT){
		pop @dec;
	}

	my $i = 1;
	foreach(@dec) { 
		last if $i > $COLCT;
		$mybytes .= pack("C", $i++);
		$mybytes .= pack("C", $_);
	}	
	while($i <= $COLCT){
		$mybytes .= pack("C", $i++);
		$mybytes .= pack("C", 0);
	}
	my $ct = syswrite(FH, $mybytes, $COLCT*2);
	if($ct ne $COLCT*2){
		print "ct = $ct " . ($COLCT*2) . "\n";
		print "Possible write error on message...sux.\n";
	}
	@lastscn = @dec;
}


sub doWrite {
	my $str = shift;
	my $silent = shift;
	my $mybytes;
	@_ = split /\s+/, $str;
	if($#_ < 2){
		printf(" Usage: write <addr> <data>\n");
		return;
	}
	my ($b1, $b2) = ($_[1], $_[2]);
	if(($b1 > 0) && ($b1 <= $COLCT)){

		my $ct = syswrite(FH, pack("C", $b1), 1);
		$ct += syswrite(FH, pack("C", $b2), 1);

		$mybytes = pack("C", $b1);
		$mybytes .= pack("C", $b2);
#		my $ct = syswrite(FH, $mybytes, 2);
		if($ct == 2){
			not $silent and 
			print "Sent two bytes: $b1 $b2\n";
		}
		else{
			print "Possible send error...doh.\n";
		}
	}
	else{
		print " Addr out of range (must be 1..$COLCT)\n";
	}
}

sub doRead{ 
	my $str = shift;
	@_ = split /\s+/, $str;
	if($#_ < 1){
		printf(" Usage: read <addr>\n");
		return;
	}
	my ($b1, $b2, $b3) = ($CMD_READ, $_[1]);
	my $mybytes = pack("C", $b1);
	$mybytes .= pack("C", $b2);
	my $ct = syswrite(FH, $mybytes, 2);
	if($ct != 2){ print "Possible send error (ct = $ct)...doh!\n"; }
	print "Requested data at location $b2...waiting for reply.\n";
	$ct = sysread(FH, $b3, 1);
	if($ct == 1){
		printf("Got reply: $b2 -> 0x%X (%d dec, '$b3' ascii)\n", ord($b3), ord($b3));
##			printf("Got reply: $b2 -> '$b3'\n");
	}
	else{
		print "Possible read error...damn.\n";
	}
}

sub doDump {
	my $b1 = $CMD_READ;
	my @data;
	my $b3;
	print "Dumping data from PIC:\n";

	### * TODO: look into speeding up a dump by sending all request
	###         bytes to the port at once...hell, it's async right?
	###         Speeding this up could make dumping more reasonable
	###         and could possibly let us [better] persist screens
	###         across "sessions"
	
	foreach my $b2 (1..$COLCT){
		my $mybytes = pack("C", $b1);
		$mybytes .= pack("C", $b2);
		my $ct = syswrite(FH, $mybytes, 2);
		if($ct != 2){ print "Possible send error (ct = $ct)...doh!\n"; }
#		print "Requested data at location $b2...waiting for reply.\n";
		sysread(FH, $b3, 1);
		$data[$b2] = $b3;
	}
	for (my $i=1; $i <= $COLCT; $i+=8){
		printf(" 0x%0.2X | ", $i);
		for(my $j=0; $j<8; $j++){
			printf("%0.2X ", ($i+$j) > $COLCT ? 0 : ord($data[$i+$j]));
		}
		print "\n";
	}
}

sub doFill {
	my $mybytes;
	my $str = shift;

	@_ = split /\s+/, $str;

	if($#_ < 1){
		print "Usage: fill <value>\n";
		return;
	}
	my $b2 = $_[1];
	print "Doing fill...\n";
	undef $mybytes;
	foreach my $i (1..$COLCT){
		my $b1 = $i;
		$mybytes .= pack("C", $b1);
		$mybytes .= pack("C", $b2);
	}
	my $ct = syswrite(FH, $mybytes, $COLCT*2);
	if($ct == $COLCT*2){
	}
	else{
		print "Possible send error...doh.\n";
	}
	#doDump();
}

sub doShiftLeft {
	my $val = shift;
	my $quiet = shift;

	(not $val) and $val = 1;

	my ($b1, $b2) = ($CMD_SHIFTL, $val);
	my $mybytes = pack("C", $b1);
	$mybytes .= pack("C", $b2);
	my $ct = syswrite(FH, $mybytes, 2);
	if($ct == 2){
		not $quiet and print "Shifted sign left by $val bytes\n";
	}
	else{
		print "Possible write error.\n";
	}

	if(@lastscn){
		foreach(1..$val){
			shift @lastscn;
			push @lastscn, 0;	
		}
	}
	
}

sub doShiftRight {
	my $val = shift;
	my $quiet = shift;
	(not $val) and $val = 1;
	my ($b1, $b2) = ($CMD_SHIFTR, $val);
	my $mybytes = pack("C", $b1);
	$mybytes .= pack("C", $b2);
	my $ct = syswrite(FH, $mybytes, 2);
	if($ct == 2){
		not $quiet and print "Shifted sign right by $val bytes\n";
	}
	else{
		print "Possible write error.\n";
	}
	if(@lastscn){
		foreach(1..$val){
			pop @lastscn;
			unshift @lastscn, 0;
		}
	}
}

sub doInvert {
	my ($b1, $b2) = ($CMD_INVERT, 0);
	my $mybytes = pack("C", $b1);
	$mybytes .= pack("C", $b2);
	my $ct = syswrite(FH, $mybytes, 2);
	if($ct == 2){
#		print "Sign inverted.\n";
	}
	else{
		print "Possible write error.\n";
	}
	if(@lastscn){
		foreach(1..$COLCT){
			$lastscn[$_] = $lastscn[$_] ^ 0xFF;
		}
	}
}

sub doShiftInLeft {
	my $val = shift;
	my ($b1, $b2) = ($CMD_SHIFTINL, $val);
	my $mybytes = pack("C", $b1);
	$mybytes .= pack("C", $b2);
	my $ct = syswrite(FH, $mybytes, 2);
	if($ct == 2){
		print "Shifted in $b2 from left...\n";
	}
	else{
		print "Possible write error.\n";
	}
}

sub doShiftInRight {
	my $val = shift;
	my $quiet = shift;
	my ($b1, $b2) = ($CMD_SHIFTINR, $val);
	my $mybytes = pack("C", $b1);
	$mybytes .= pack("C", $b2);
	my $ct = syswrite(FH, $mybytes, 2);
	if($ct == 2){
		not $quiet and print "Shifted in $b2 from right...\n";
	}
	else{
		print "Possible write error.\n";
	}
}

sub doMsgScrollLeft {
	my $msg = shift;
	my $srate = shift;
	my $shiftby = shift;

	not $srate and $srate = 0.045;
	not $shiftby and $shiftby = 1;

	my @dec = @{ makeBinaryScreen( $fonts[0], $msg) };

	# find out actual message width...
	my $width = $#dec;
	while($width){
		last if $dec[$width] != 0;
		$width--;
	}
	$width++;

	($width > $COLCT) and $width = $COLCT;

#	while ($#dec > 0){
#
#		my $mybytes;
#
#		doShiftLeft($shiftby,1);
#
#		my $i;
#		for($i=0; $i < $shiftby; $i++){
#
#			my $val = shift @dec;
#			$_ = sprintf("write %d %d", $COLCT - $shiftby + $i, $val);
##			print "$_\n";
#
#			#doWrite($_, 1);
#			
#			$mybytes = pack("C", $COLCT - $shiftby + $i + 1);
#			$mybytes .= pack("C", $val);
#
#			my $ct = syswrite(FH, $mybytes, 2);
#
#			#syswrite(FH, pack("C", $COLCT - $shiftby + $i), 1);
#			#syswrite(FH, pack("C", $val), 1);
#			select undef, undef, undef, 0.01;
#
##			my $val = shift @dec;
##			not $val and $val = 0;
##			doShiftInRight($val,1);
##			select undef, undef, undef, 0.0001;
#
##			my ($b1, $b2) = ($CMD_SHIFTINR, $val);
##			$mybytes = pack("C", $b1);
##			$mybytes .= pack("C", $b2);
##			my $ct = syswrite(FH, $mybytes, 2);
#		}
#
#		# Goddammit, why the FUCK does this freeze the sign?
#		#my $ct = syswrite(FH, $mybytes, 2*$shiftby);
#		select undef, undef, undef, $srate;
#	}
#	while($width > 0){
#		doShiftLeft($shiftby, 1);
#		select undef, undef, undef, $srate;
#		$width -= $shiftby;
#	}

	while ($#dec){
		my $val = shift @dec;
		doShiftInRight($val, 1);
		select undef, undef, undef, $srate;
	}
	while($width--){
		doShiftInRight(0, 1);
		select undef, undef, undef, $srate;
	}
}

sub doMsgScrollCharsLeft {
	my $msg = shift;
	my @dec = @{ makeBinaryScreen( $fonts[0], $msg) };
	my $width = 2;
	my $srate = 0.08;
	my $bytes;
	foreach (1..145){
		push @dec, 0;
	}
	while(1){
		doShiftLeft($width, 1);
		foreach(1..$width){
			$bytes = pack("C", $COLCT - $width + $_ - 1);
			$bytes .= pack("C", shift @dec);
			my $ct = syswrite(FH, $bytes, 2);
		}
#		$ct = syswrite(FH, $bytes, $width*2);
		select undef, undef, undef, $srate;
		undef $bytes;

		last if scalar @dec < 1;

	}
}

sub doWipeClear {
	my $dir = shift;
	my $speed = shift;
	not $speed and $speed = 0.01;
	foreach(1..$COLCT){
		my $bytes;
		if($dir =~ "right"){
			$bytes = pack("C", $COLCT - $_ + 1);
		}
		else{
			$bytes = pack("C", $_);
		}
		$bytes .= pack("C", 0);
		syswrite(FH, $bytes, 2);

		select undef, undef, undef, $speed;
	}
	foreach(0..$#lastscn){ $lastscn[$_] = 0; };
}

sub doOverlayMessage {
	my $dir = shift;
	my $msg = shift;
	my $center = shift;
	my $speed = shift;
	not $speed and $speed = 0.01;

	my ($i, $ct, $mybytes, $pre, $post);

	my @dec = @{ makeBinaryScreen( $fonts[0], $msg) };

	if($center){
		# find actual length
		$pre = 0;
		while( $dec[$pre] == 0){
			$pre++;
		}
		$post = $#dec;
		while($dec[$post] == 0){
			$post--;
		}
		my $width = ($post - $pre) + 1;
		my $offset = ($COLCT - $width)/2;
		my @tmpdec = @dec;
		undef @dec;
		foreach (0..$offset-1){
			push @dec, 0;
		}
		foreach ($pre..$post){
			push @dec, $tmpdec[$_];
		}
	}
	while($#dec < $COLCT){ push @dec, 0; }
	
	@lastscn = @dec;
	
	$i = 1;
	undef $mybytes;
	if($dir eq "left"){
		foreach(@dec) { 
			last if $i > $COLCT;
			$mybytes = pack("C", $i++);
			$mybytes .= pack("C", $_);
			$ct = syswrite(FH, $mybytes, 2);
			select undef, undef, undef, $speed;
		}	
		while($i <= $COLCT){
			$mybytes = pack("C", $i++);
			$mybytes .= pack("C", 0);
			$ct = syswrite(FH, $mybytes, 2);
			select undef, undef, undef, $speed;
		}
	}
	else{
		for($i=$#dec; $i > 0; $i--){
			last if $i > $COLCT;
			$mybytes = pack("C", $i);
			$mybytes .= pack("C", $dec[$i-1]);
			$ct = syswrite(FH, $mybytes, 2);
			select undef, undef, undef, $speed;
		}	
	}

#	$ct = syswrite(FH, $mybytes, 2);
#	if($ct == $COLCT*2){
#		print "ct = $ct " . ($COLCT*2) . "\n";
#		print "Possible write error on message...sux.\n";
#	}
}

# Shows the current time on screen.  
# param1 == number of times to display (0 loops forever)
# param2 == format (0 == localtime string, 1 ==  mm/dd/yy hh:mm:ss pm
#			2 == mm/dd/yy HH:mm:ss
# If param1 == 0, then loops forever
sub doTime {
	my @scn1;
	my ($loopct, $tform) = (shift, shift);
	not $loopct and $loopct = -1;
	not $tform and $tform = 0;

	while(1){
		#my $t0 = [gettimeofday];
		my ($seconds, $microseconds) = gettimeofday;
		my $str;

		if($tform == 0){
			$str = localtime($seconds);
		}
		elsif($tform == 1){
			$str = strftime "%D %l:%M:%S %P", localtime($seconds);
		}
		elsif($tform == 2){
			$str = strftime "%D %H:%M:%S", localtime($seconds);
		}
		
		$str =~ s/\s+/ /g;
		$microseconds = $microseconds/100000;	# to millis
		$microseconds =~ s/\..*//;
		#$str =~ s/ (\d\d\d\d)$/\.$microseconds $1/;

		@scn1 = @{ makeBinaryScreen( $fonts[0], $str, 1) };

		showDiffScreen(\@lastscn, \@scn1);
		#@scn2 = @scn1;

		if($loopct != -1){
			$loopct--;
			if($loopct <= 0){
				last;
			}
		}

		#select undef, undef, undef, 0.09;
		select undef, undef, undef, 1.00;
	} 
}

# Pulls the weather.  Kinda custom.  Returns an associative array.
sub fetchWeather {
	#my $weather_url = "http://www.wunderground.com/weatherstation/WXDailyHistory.asp?ID=KORHILLS2&format=1";
	my $weather_url = "http://www.wunderground.com/weatherstation/WXDailyHistory.asp?ID=KORPORTL6&format=1";

	# The above returns a comma separated list, but it's got some html crap <br>'s in there, so we massage
	my $restxt = `$CURL -s "$weather_url"`;
	$restxt =~ s/<br>//g;
	my @lines = split /\n+/, $restxt;
	pop @lines;

#	printf("Debug: lines is %d\n", $#lines + 1);

	# We have bad data....so bail.
	if($#lines == 0){
#		print "DEBUG: returning undef in fetchWeather\n";
		return undef;
	}
	my $nameline = $lines[0];
	my $lastline = pop @lines;

	my @names = split /,/, $nameline;
	my @vals = split /,/, $lastline;

	my %ret;
	foreach my $i (0..$#names){
		$ret{$names[$i]} = $vals[$i];
		#print $names[$i] . " -> " . $vals[$i] . "\n";
	}

	return \%ret if $#names > 0;
	return undef;
}

sub doCountFast {
	my $max = shift;
	not $max and $max = 1000;

	my (@scn1, @scn2);
	foreach (0..$COLCT-1) { push @scn2, $_; }

	foreach(1..$max){
		#doMsg( $_, 1);

		@scn1 = @{ makeBinaryScreen( $fonts[0], $_, 1) };

		showDiffScreen(\@scn2, \@scn1);
		@scn2 = @scn1;
	}

}


# Rolls the current message down off the screen.
sub rollInDown {
	my $str = shift;
	my (@scn1, @scn2);

	my @scn3 = @{ makeBinaryScreen( $fonts[0], $str, 1) };
	while($#scn3 > $COLCT) { pop @scn3; }
	foreach (0..$COLCT) { push @scn1, 0; }

	if(@lastscn){
		@scn2 = @lastscn;
	}
	else{
		foreach (0..$COLCT) { push @scn2, 0; }
		doShiftLeft($COLCT, 1);	# clear screen first
	}

	foreach my $j (64,32,16,8,4,2,1){
		foreach my $i (0..$COLCT-1){
			$scn2[$i] = ($scn2[$i] << 1) & 0x7f;
			if( ($scn3[$i] & $j) == $j){
				$scn2[$i] |= 1;
			}
		}
		showDiffScreen(\@scn1, \@scn2);
		select undef, undef, undef, 0.2;
		@scn1 = @scn2;
	}
	@lastscn = @scn2;
}

sub rollOffDown {
	if(not @lastscn){
		doShiftLeft($COLCT, 1);
		foreach (0..$COLCT-1) { push @lastscn, 0; };
		return;
	}
	my @scn = @lastscn;
	foreach my $row (1..7){
		foreach my $col (0..$COLCT-1){
			$lastscn[$col] = ($lastscn[$col] << 1) & 0x7f;
		}
		showDiffScreen(\@scn, \@lastscn);
		@scn = @lastscn;
		select undef, undef, undef, 0.2;
	}
}

sub rollOffUp {
	if(not @lastscn){
		doShiftLeft($COLCT, 1);
		foreach (0..$COLCT-1) { push @lastscn, 0; };
		return;
	}
	my @scn = @lastscn;
	foreach my $row (1..7){
		foreach my $col (0..$COLCT-1){
			$lastscn[$col] = ($lastscn[$col] >> 1) & 0x7f;
		}
		showDiffScreen(\@scn, \@lastscn);
		@scn = @lastscn;
		select undef, undef, undef, 0.2;
	}
}

# Rolls a message up to center
sub rollInUp {
	my $str = shift;
	my (@scn1, @scn2, @scn3);
		
	@scn3 = @{ makeBinaryScreen( $fonts[0], $str, 1) };
	while($#scn3 > $COLCT) { pop @scn3; }

	if(@lastscn){
		@scn2 = @lastscn;
	}
	else{
		foreach (0..$COLCT) { push @scn2, 0; }
	}

	@scn1 = @scn2;
	
	foreach my $j (1,2,4,8,16,32,64){
		foreach my $i (0..$COLCT-1){
			$scn2[$i] = ($scn2[$i] >> 1) & 0x7f;
			if( ($scn3[$i] & $j) == $j){
				$scn2[$i] |= 64;#$map{$j};
			}
		}
		showDiffScreen(\@scn1, \@scn2);
		select undef, undef, undef, 0.2;
		@scn1 = @scn2;
	}
	@lastscn = @scn2;
}
		
	
# Rolls a message in from bottom column by column	
sub colRollInUp {
	my $str = shift;
	my @scn1 = @{ makeBinaryScreen( $fonts[0], $str, 1) };

	# We always clear first for this mode...right now anyway.
	doShiftLeft($COLCT, 1);
	foreach my $col (0..$COLCT-1){
		if($scn1[$col]){
			foreach my $step (6,5,4,3,2,1,0){
				my $mybytes = pack("C", $col+1);
				$mybytes .= pack("C", (($scn1[$col] << $step) & 0x7F)  );
				syswrite(FH, $mybytes, 2);
				select undef, undef, undef, 0.01;
			}
		}
	}
	@lastscn = @scn1;
}

# Rolls a message in character by character downward.
sub charRollInDown {
	my $str = shift;

	# We always clear first for this mode...right now anyway.
	doShiftLeft($COLCT, 1);

	@_ = @{ makeBinaryScreen( $fonts[0], $str, 1) };
	my $i = 0;
	while(!$_[$i++]){
	}
	my $offset = $i;
	#print "DEBUG: message starts on col: $i\n";
	
	my @chars = split //, $str;

	foreach my $char (@chars){

		my @c = @{ makeBinaryChar($fonts[0], $char) };
		my $mybytes;

		my $cw = $#c+1;

		foreach my $step (1..7){			# For each row
			undef $mybytes;
			my $k;

			foreach $k (0..$cw-1){		# Each col in current width

				last if ($offset+$k) > $COLCT;

				$mybytes .= pack("C", $offset+$k);
				$mybytes .= pack("C", (($c[$k] >> (7-$step)) & 0x7F)  );

				$lastscn[$offset+$k-1] = (($c[$k] >> (7-$step)) & 0x7F);
			}
			if($mybytes){
				syswrite(FH, $mybytes, 2*$cw);
			}
			last if ($offset >= $COLCT);
			select undef, undef, undef, 0.03;
		}

		$offset += $cw;
	}
	
}

sub charRollInUp {
	my $str = shift;
	my $speed = $str;
	chomp $speed;
	if($speed =~ /,\s*\d+$/){
		$speed =~ s/.*,\s*(\d+)$/$1/;
		$str =~ s/(.*),\s*\d+$/$1/;

#		($speed > 1000) and $speed = 1000;
#		$speed = (1001 - $speed) / 1000;
		$speed = $speed / 1000;
	}
	else {
		$speed = 0.03;
	}

	# We always clear first for this mode...right now anyway.
	doShiftLeft($COLCT, 1);

	@_ = @{ makeBinaryScreen( $fonts[0], $str, 1) };
	my $i = 0;
	while(!$_[$i++]){
	}
	my $offset = $i;
	#print "DEBUG: message starts on col: $i\n";
	
	my @chars = split //, $str;

	foreach my $char (@chars){

		my @c = @{ makeBinaryChar($fonts[0], $char) };
		my $mybytes;

		my $cw = $#c+1;

		foreach my $step (1..7){			# For each row
			undef $mybytes;
			my $k;

			foreach $k (0..$cw-1){		# Each col in current width

				last if ($offset+$k) > $COLCT;

				$mybytes .= pack("C", $offset+$k);
				$mybytes .= pack("C", (($c[$k] << (7-$step)) & 0x7F)  );

				$lastscn[$offset+$k-1] = (($c[$k] << (7-$step)) & 0x7F);

			}
			if($mybytes){
				syswrite(FH, $mybytes, 2*$cw);
			}
			last if ($offset >= $COLCT);
			select undef, undef, undef, $speed;
		}

		$offset += $cw;
	}
}


# Puts pixels on sign randomly until message is fully displayed.
# Parameter 1 is the string to display, param2 is speed 
sub doRandIn{

	my $str = shift;
	my $speed = shift;
	not $speed and $speed = 0.02;
	
	my @msg = @{ makeBinaryScreen( $fonts[0], $str, 1) };
	while($#msg > $COLCT){ pop @msg; };
	my @currmsg;

	if(@lastscn){
		@currmsg = @lastscn;
	}
	else{
		while($#currmsg < $COLCT) { push @currmsg, 0; }
		doShiftLeft($COLCT, 1);	# clear screen first
	}

	my @p;
	my $col;
	
	foreach my $i (0..$COLCT-1){

		if($msg[$i] != $currmsg[$i]){

			$col = \%{$p[$#p+1]};

			$col->{"byte"} = $msg[$i];
			$col->{"colnum"} = $i+1;
			foreach(1..7){
				my $bm = (1 << ($_-1));

				if( ($msg[$i] & $bm) != ($currmsg[$i] & $bm)){
					push @{$col->{"bits"}}, $_;

				}
			}
		}
	}

	while($#p >= 0){
	
		my $mybytes;
		my $ind = rand $#p + 1;
		my $c = $p[$ind];
		
		my $bitind = rand scalar @{ $c->{"bits"} } ;
		my $colnum = $c->{"colnum"};

		my $bm = $c->{"bits"}->[$bitind];
		$bm = (1 << ($bm-1));

		if(($msg[$colnum-1] & $bm) == $bm){
			$currmsg[$colnum-1] |= $bm;
		}
		else{
			$currmsg[$colnum-1] &= (~$bm);
		}

		$mybytes = pack("C", $colnum);
		$mybytes .= pack("C", $currmsg[$colnum-1]);

		syswrite(FH, $mybytes, 2);

		select undef, undef, undef, $speed;

		splice @{ $c->{"bits"}}, $bitind, 1;		# remove this bitindex element


		if(scalar @{ $c->{"bits"}}  == 0){
			#printf("No more bits for index %d\n", $ind);
			splice @p, $ind, 1;
		}
	}

	@lastscn = @msg;
}

# Randomly removes current pixels to black.
# ASSUMES that @lastscn is filled
sub doRandOut{

	my @p;
	my $col;
	my $speed = shift;
	not $speed and $speed = 0.01;
	
	#foreach my $i (0..$COLCT-1){
	foreach my $i (0..$COLCT){

		if($lastscn[$i]){

			$col = \%{$p[$#p+1]};

			$col->{"byte"} = $lastscn[$i];
			$col->{"colnum"} = $i+1;
			foreach(1..7){

				my $bm = (1 << ($_-1));

				if( $lastscn[$i] & $bm ){
					push @{$col->{"bits"}}, $_;

				}
			}
		}
	}

	while($#p >= 0){
	
		my $mybytes;
		my $ind = rand $#p + 1;
		my $c = $p[$ind];
		
		my $bitind = rand scalar @{ $c->{"bits"} } ;
		my $colnum = $c->{"colnum"};

		my $bm = $c->{"bits"}->[$bitind];
		$bm = (1 << ($bm-1));

		$lastscn[$colnum-1] &= (~$bm);

		$mybytes = pack("C", $colnum);
		$mybytes .= pack("C", $lastscn[$colnum-1]);

		syswrite(FH, $mybytes, 2);

		select undef, undef, undef, $speed;

		splice @{ $c->{"bits"}}, $bitind, 1;		# remove this bitindex element


		if(scalar @{ $c->{"bits"}}  == 0){
			#printf("No more bits for index %d\n", $ind);
			splice @p, $ind, 1;
		}
	}
}

# Displays a string word-wise centered...
sub doWordWiseCenter {
	my $str = shift;
	my $speed = shift;
	(not $speed) and $speed = 0.5;
	my @words = split /\s+/, $str;
	foreach my $word (@words){
		doMsg($word, 1);			# Display centered
		select undef, undef, undef, $speed;
	}
}

# Wipes the current message off either from the middle
# out or from the outside in to the middle.
sub doMiddleWipeOff {
	my $mode = shift;
	my $speed = shift;
	(not $speed) and $speed = 0.02;
	
	my $mid = int($COLCT/2);
	my $mybytes;

	if($mode eq "out"){
		foreach my $offset (0..$COLCT/2){
			$mybytes = pack("C", $mid-$offset+1);
			$mybytes .= pack("C", 0);
			$mybytes .= pack("C", $mid+$offset+1);
			$mybytes .= pack("C", 0);
			syswrite(FH, $mybytes, 4);

			select undef, undef, undef, $speed;
		}
	}
	else{
		#foreach my $offset (0..$COLCT/2){
		foreach my $offset (0..$COLCT/2){
			$mybytes = pack("C", $offset+1);
			$mybytes .= pack("C", 0);
			$mybytes .= pack("C", $COLCT-$offset+1);
			$mybytes .= pack("C", 0);
			syswrite(FH, $mybytes, 4);

			select undef, undef, undef, $speed;
		}

	}
	
	# Now clear lastscn
	undef @lastscn;
	foreach(0..$COLCT-1){
		push @lastscn, 0;	
	}
}

		
# Gets the system uptime and returns a hashref
sub getUptime {
	my %ret;
	my $txt = `uptime`;
	$txt =~ s/\s+/ /g;
	$txt =~ s/load average: //;
	$txt =~ s/.*up (.*)/$1/;
	$txt =~ s/, /,/g;
	$txt =~ s/\s+/ /g;

	@_ = split /,/, $txt;
	$ret{"uptime"} = $_[0];
	$ret{"users"} = $_[2];
	$ret{"load1"} = $_[3];
	$ret{"load5"} = $_[4];
	$ret{"load15"} = $_[5];
	return \%ret;

}

# automation - handles all automation for the sign and is the core
# of the parent process.
sub automation {
	my %times;
	$times{"last"} = time;
	$times{"uptime"} = time;
	my %weather;
	$_ = fetchWeather();
	$_ and (%weather = %{$_});
#	print Dumper(\%weather);
	$times{"weather"} = time;
	
	while(1){
		doCmd("time 1 1\n");

		sleep 1;

		if(time - $times{"last"} > 60){ 				# Time to show weather

			doCmd("lwipe Weather Update");

			# need to get weather again...
			if((not %weather) or (time - $times{"weather"} > 20*60)){		
#				print "DEBUG - FETCHING WEATHER AGAIN\n";
				$_ =  fetchWeather();
				$_ and %weather = %{$_};
				$times{"weather"} = time;
			}

			if (not %weather) {
				$times{"last"} = time;
				next;
			}

			sleep 2;

			doCmd("rando 0.005");
			#doCmd("criu Current temp: " . $weather{"TemperatureF"} . "");
			#print ("DEBUG:\n");
			#print("mc Current temp: " . $weather{"TemperatureF"} . "\n");
			doCmd("mc Current temp: " . $weather{"TemperatureF"} . pack("C", 176)) ;
			sleep 5;
			doCmd("rwipe Winds @ " . $weather{"WindSpeedMPH"} . " MPH " . $weather{"WindDirection"});
			sleep 5;
			# Show gusts only if "high"

			if($weather{"WindSpeedGustMPH"} > 15){
				doCmd("lwipe Wind gusts @ " . $weather{"WindSpeedGustMPH"} . " MPH");
				sleep 4;
			}
			
			doCmd("rando 0.005");

			$times{"last"} = time;

		}

		if(time - $times{"uptime"} > 60*3){		# Show uptime
			doCmd("riu noisybox server uptime");
			sleep 3;
			my %uptime = %{ getUptime() };

			doCmd("riu uptime: " . $uptime{"uptime"});
			sleep 3;
			doCmd("riu Load average: " . $uptime{"load1"});
			sleep 3;
			doCmd("riu " . $uptime{"users"} . " logged in");
			sleep 3;
			doCmd("rou");
			
			$times{"uptime"} = time;
		}
	}
}


# Gets its commands from a named pipe
sub pipereader {

	print "Entered pipe reader mode.\n";
	while(1){
		# Try opening
		open FIFO, "< $PIPENAME" or die "Could not open pipe for reading.";
		while(1){
			my $cmd = <FIFO>;
			last if not $cmd;
#			print $cmd;
			doCmd($cmd);
		}
		close FIFO;
	}
}

sub doSocketMode {
	my $port = shift;

	my $proto = getprotobyname("tcp");
	socket(SOCK, PF_INET, SOCK_STREAM, $proto)        || die "socket: $!";
	setsockopt(SOCK, SOL_SOCKET, SO_REUSEADDR,
	pack("l", 1))   || die "setsockopt: $!";
	bind(SOCK, sockaddr_in($port, INADDR_ANY))        || die "bind: $!";
	print "server started on port $port";
	CL->autoflush(1);
	
	while(1){
		doCmd("mc Waiting on port $port");
	
		listen(SOCK, 1)                            || die "listen: $!";

		my $paddr;

		$SIG{CHLD} = \&REAPER;

		$paddr = accept(CL, SOCK);
		my($cport,$iaddr) = sockaddr_in($paddr);
		my $name = gethostbyaddr($iaddr,AF_INET);

		doCmd("mc New host: $name:$cport");

		my $line;
		while($line = <CL>){
			$line =~ s/\s+$//;
			doCmd($line);
			print CL "ok\n";
		}	
		
		close CL;
	}
	close SOCK;
}



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

if($#ARGV >= 0){
	# If running with command line params, we clear first....
	# This should really be reconsidered...reading from sign is probably better.
	doShiftLeft($COLCT, 1);
}

my $daemonmode = 0;

my %mode;


GetOptions( "pipe" => \$mode{"pipe"},
			"daemon" => \$mode{"daemon"},
			"socket=s" => \$mode{"socket"},
			"help" => \$mode{"help"}) 
			|| die;

if($mode{"help"}){
	showHelp and exit;
}

if($mode{"pipe"}){
	print "Going into pipe reader mode.\n";
	pipereader();
	exit;
}


if($mode{"socket"}){
	print "Starting up socket server on port " . $mode{"socket"} . ".\n";
	doSocketMode($mode{"socket"});
	exit;
}


if($mode{"daemon"}){

	$daemonmode = 1;
	#TODO: actually become daemon
		
	# Need to clear out ARGV
	undef @ARGV;

	# Become daemon and create child with pipe to stdin
#	if(open CP, "|-"){
#		# Parent context
#
#		CP->autoflush(1);		# Need to autoflush the file handle

		automation();			# Should loop indefinitely
		exit;
#	}
#	else{
#		# Child context
#	}
}
		

my ($b1, $b2, $lastcmd);


while(1){
	my $str;
	
	if($#ARGV < 0){
		!$daemonmode and print "==> ";
		$str = <STDIN>;
		!$str and exit;		# bail out if read from standard in fails
		chomp $str;
	}
	else{
		$str = join ' ', @ARGV;
	}

	last if $str =~ /^q/;

	if((length($str) == 0) and $lastcmd){
		$str = $lastcmd;
	}
	$lastcmd = $str;

	doCmd($str);

	last if ($#ARGV >= 0);
}

# Handles a string command to send to the sign...
# Just a big case statement with a tiny bit of parsing...
sub doCmd {
	my $str = shift;
	chomp $str;
	if( $str =~ /^w / or $str =~ /^write/){
		doWrite($str);
	}
	elsif( $str =~ /^rid /){
		$str =~ s/^rid\s+//;
		rollInDown($str);
	}
	elsif( $str =~ /^rod/){
		rollOffDown;
	}
	elsif( $str =~ /^riu/){
		$str =~ s/^riu\s+//;
		rollInUp($str);
	}
	elsif( $str =~ /^criu/){
		$str =~ s/^criu\s+//;
		print "criu IS FUCKING DISABLED (I think it crashes sign)\n";
		#colRollInUp($str);
	}
	elsif( $str =~ /^kriu /){
		$str =~ s/^kriu\s+//;
		charRollInUp($str);
	}
	elsif( $str =~ /^krid /){
		$str =~ s/^krid\s+//;
		charRollInDown($str);
	}
	elsif( $str =~ /^rou/){
		rollOffUp;
	}
	elsif( $str =~ /^d/){
		doDump();
	}
	elsif( $str =~ /^f/){
		doFill($str);
	}
	elsif( $str =~ /^mc/){
		$str =~ s/^\w+ //;
		doMsg($str, 1);
	}
	elsif( $str =~ /^mwc/){
		$str =~ s/^\w+ //;
		$_ = 0;
		if($str =~ /,\s+(\d+)?(\.\d+)?$/){
			$_ = $str;
			$_ =~ s/^.*,\s+(\.?\d+.*)/$1/;
			$str =~ s/,.*//;
		}
		doWordWiseCenter($str, $_);
	}
	elsif( $str =~ /^mwoi/){
		if($str =~ /^\w+ (\d+)?(\.\d+)?$/){
			$str =~ s/^\w+\s+(\.?\d+.*)/$1/;
		}
		else{
			undef $str;
		}
		doMiddleWipeOff("in", $str);
	}
	elsif( $str =~ /^mwoo/){
		if($str =~ /^\w+ (\d+)?(\.\d+)?$/){
			$str =~ s/^\w+\s+(\.?\d+.*)/$1/;
		}
		else{
			undef $str;
		}
		doMiddleWipeOff("out", $str);
	}
	elsif( $str =~ /^lwipe /){
		$str =~ s/^\w+ //;
		doOverlayMessage("left", $str, 1);
	}
	elsif( $str =~ /^rwipe /){
		$str =~ s/^\w+ //;
		doOverlayMessage("right", $str, 1);
	}
	elsif( $str =~ /^crwipe/){
		$str =~ s/^\w+(\s+)?//;
		doWipeClear("right", $str); 
	}
	elsif( $str =~ /^clwipe/){
		$str =~ s/^\w+(\s+)?//;
		doWipeClear("left", $str); 
	}
	elsif( $str =~ /^mslc/){
		$str =~ s/^\w+ //;
		doMsgScrollCharsLeft($str);
	}
	elsif( $str =~ /^msl/){
		$str =~ s/^\w+ //;
		my ($speed, $shiftby);
		if($str =~ /,\s*(\d+)?(\.\d+)?$/){
			$shiftby = $str;
			$shiftby =~ s/^.*,\s*(\.?\d+.*)/$1/;
			$str =~ s/^(.*),\s*\.?\d+.*/$1/;
		}
		if($str =~ /,\s*(\d+)?(\.\d+)?$/){
			$speed = $str;
			$speed =~ s/^.*,\s*(\.?\d+.*)/$1/;

			$str =~ s/^(.*),\s*\.?\d+.*/$1/;
		}
		else{
			$speed = $shiftby;
			$shiftby = undef;
		}
		doMsgScrollLeft($str, $speed, $shiftby);
	}
	elsif( $str =~ /^m/){
		$str =~ s/^\w+ //;
		doMsg($str);
	}
	elsif( $str =~ /^randi/){
		$str =~ s/^\w+ //;
		$_ = 0;
		if($str =~ /,\s+(\d+)?(\.\d+)?$/){
			$_ = $str;
			$_ =~ s/^.*,\s+(\.?\d+.*)/$1/;
			$str =~ s/,.*//;
		}
		doRandIn($str, $_);
	}
	elsif( $str =~ /^rando/){
		@_ = split /\s+/, $str;
		doRandOut($_[1]);
	}
	elsif( $str =~ /^sl/){
		@_ = split /\s+/, $str;
		doShiftLeft($_[1], 1);
	}
	elsif( $str =~ /^sr/){
		@_ = split /\s+/, $str;
		doShiftRight($_[1], 1);
	}
	elsif( $str =~ /^sil/){
		@_ = split /\s+/, $str;
		doShiftInLeft($_[1]);
	}
	elsif( $str =~ /^sir/){
		@_ = split /\s+/, $str;
		doShiftInRight($_[1]);
	}
	elsif( $str =~ /^i/){
		doInvert();
	}
	elsif( $str =~ /^ctr/){
		$str =~ s/^\w+\s+//;
		doCountFast($str);
	}
	elsif( $str =~ /^c/){
		doShiftLeft($COLCT, 1);
	}
	elsif( $str =~ /^t/){
		@_ = split /\s+/, $str;
		doTime($_[1], $_[2]);
	}
	elsif( $str =~ /^weather/){
		fetchWeather();
	}
	elsif( $str =~ /^r/){
		doRead($str);
	}
	elsif( $str =~ /^l/){
		print "Enter sequential data, or 'q' to end:\n";
		foreach my $i (1..$COLCT){
			my ($input, $oldinp);
			print "$i [$input]";
			$oldinp = $input;
			$input = <>;
			chomp $input;
			($input = $oldinp) if not length($input);
			last if $input eq 'q';
			$str = sprintf("w %d %d", $i, $input);
			doWrite($str);
		}
	}
	elsif( ( $str =~ /^h/) or ( $str =~ /\?/)){
		showHelp;
	}
	else{
		print "Unknown command...try help?\n";
	}
}