#!/usr/bin/perl
###########################################################################
##  Copyright (C) Wizardry and Steamworks 2012 - License: GNU GPLv3      ##
##  Please see: http://www.gnu.org/licenses/gpl.html for legal details,  ##
##  rights of fair usage, the disclaimer and warranty conditions.        ##
###########################################################################


use strict;

use constant true => 1;
use constant false => 0;

# Packages
use Device::SerialPort qw( :PARAM :STAT 0.07 );
use Term::ReadKey;
use Time::HiRes qw(usleep);
use Getopt::Long;
use Switch 'fallthrough';
use Pod::Usage;

# Autoflush
$| = 1;
# Map EOF
$/ = eof;

# Colors
my %colors = (
  "black" => 0,
  "white" => 255,
  "red" => 224,
  "green" => 28,
  "blue" => 3,
  "yellow" => 252,
  "magenta" => 227,
  "cyan" => 31
);

# Defaults
my $baud = 9600;
my $sleep = 1e9/$baud;

my $opt_help = false;
my $opt_clear = false;
my $opt_fg=$colors{'black'};
my $opt_bg=$colors{'white'};
my $opt_line="";
my $opt_box="";
my $opt_circle="";
my $opt_cursor="";
my $opt_light="";
my $opt_port = "/dev/tty.usbserial-A600d25K";

my $result;

GetOptions(
  "help|?" => \$opt_help,
  "clear" => \$opt_clear,
  "fg=s" => \$opt_fg,
  "bg=s" => \$opt_bg,
  "port=s" => \$opt_port,
  "line=s" => \$opt_line,
  "box=s" => \$opt_box,
  "circle=s" => \$opt_circle,
  "cursor=s" => \$opt_cursor,
  "light=s" => \$opt_light
) or pod2usage(-verbose => 2);

pod2usage(-verbose => 2) if $opt_help;

# Attempt to open port and initialize VAC
my $serialPort = Device::SerialPort->new($opt_port) 
  or die "Cannot open port: $!.\n";
# Initialise VAC
send_serial("\r");
$serialPort->close();
usleep($sleep);

# Reopen as brand new and commit
$serialPort = Device::SerialPort->new($opt_port)
  or die "Cannot open port: $!.\n";
$serialPort->baudrate($baud);
$serialPort->databits(8);
$serialPort->parity("none");
$serialPort->stopbits(1);
$serialPort->handshake("rts");
$serialPort->lookclear;
$serialPort->write_settings;
send_serial("\r");
usleep($sleep);

# Sending subroutine
sub send_serial {
  my $data = shift;
  $result = $serialPort->write($data) 
    or die "Unable to write to port: $!.\n";
  usleep($result * $sleep);
}

#send_serial("\033{127 0 0 127L");
#goto END;

# Validate coordinates
# This may seem like Voodoo but it is not.
## The reasoning is as follows:
### x,y vary 0..130 for a box
### x,y vary 0..127 for a line
sub areValidCoordinates {
  my @param = @_;
  my $type = pop @param;
  switch($type) {
    case "C" {
      if(scalar @param == 3) {
        return true;
      }
    }
    case "B" { }
    case "L" {
      if(scalar @param != 4) {
        return false;
      }
      # Per spec, the coordinates may not be equal.
      if($param[0] == $param[2] && $param[1] == $param[3]) {
        return false;
      }
    }
  }
  for my $idx (0 .. $#param) {
    switch($idx) {
      case 0 { }  # y0
      case 2 {    # y1
        switch($type) {
          case "L" { 
            if($param[$idx] < 0 || $param[$idx] > 127) {
              return false;
            }
            last;
          }
          case "B" { goto CHECK_PIXELS; }
        }
        next;
      }
      case 1 { }  # x0
      case 3 {    # x1
        switch($type) {
          case "L" { 
            if($param[$idx] < 0 || $param[$idx] > 127) {
              return false;
            }
            last;
          }
          case "B" {
CHECK_PIXELS:
            if($param[$idx] < 0 || $param[$idx] > 130) {
              return false;
            }
            last;
          }
        }
        next;
      }
    }
  }
  return true;
}

sub swapxy {
  my @coordinate_pairs = @_;
  
  ## This is not needed but we like to work
  ## by convention (x,y) instead of (y,x) and
  ## with the +y axis pointing upward.
    
  # x0r swap,
  # so that y0 <-> x0:
  $coordinate_pairs[0] ^= $coordinate_pairs[1];
  $coordinate_pairs[1] ^= $coordinate_pairs[0];
  $coordinate_pairs[0] ^= $coordinate_pairs[1];
  
  # and y1 <-> x1, only if we have a complete set.
  if(scalar @coordinate_pairs != 4) {
    goto SWAP_RETURN;
  }
  
  $coordinate_pairs[2] ^= $coordinate_pairs[3];
  $coordinate_pairs[3] ^= $coordinate_pairs[2];
  $coordinate_pairs[2] ^= $coordinate_pairs[3];

  # Note: this function is a binary relation on
  # pairs of coodinates {(x0,y0); (x1,y1)} that
  # will swap x0 with y0 and x1 with y1. The
  # operations are inversible, such that 
  # we have swapxy(S) = swapxy(swapxy(S)).

SWAP_RETURN:
  return @coordinate_pairs;
}

# Clear screen
if($opt_clear) {
	send_serial("\033[3J");
	goto END;
}

# Set colors
# Set foreground
if($opt_fg ne $colors{'black'}) {
  if(exists $colors{$opt_fg}) {
    send_serial("\033[".$colors{$opt_fg}."f");
    goto OUT_OPT_FG;
  }
  if($opt_fg <= 255 && $opt_fg >= 0) {
    send_serial("\033[".$opt_fg."f");
    goto OUT_OPT_FG;
  }
} OUT_OPT_FG:

# Set background
if($opt_bg ne $colors{'white'}) {
  if(exists $colors{$opt_bg}) {
    send_serial("\033[".$colors{$opt_bg}."b");
    goto OUT_OPT_BG;
  }
  if($opt_bg <= 255 && $opt_bg >= 0) {
    send_serial("\033[".$opt_bg."b");
    goto OUT_OPT_BG;
  }  
} OUT_OPT_BG:       

# Toggle Cursor
if($opt_cursor) {
  switch($opt_cursor) {
    case "on" {
      send_serial("\033[?25h");
      last;
    }
    case "off" {
      send_serial("\033[?25I");
    }
  }
  goto END;
}

# Toggle Backlight
if($opt_light) {
  switch($opt_light) {
    case "on" {
      send_serial("\033[?26h");
      last;
    }
    case "off" {
      send_serial("\033[?26I");
    }
  }
  goto END;
}

# Draw line
if($opt_line) {
  my @line_co=split(/,/,$opt_line);
  # we invert the y axis so +y points upward.
  $line_co[1] = abs(127 - $line_co[1]);
  $line_co[3] = abs(127 - $line_co[3]);
  # swap (y0,x0) -> (x0,y0)
  # and (y1,x1) -> (x1,y1)
  @line_co=&swapxy(@line_co);
  if(&areValidCoordinates(@line_co, "L")) {
    send_serial("\033{"
      .$line_co[0]." "
      .$line_co[1]." "
      .$line_co[2]." "
      .$line_co[3]."L");
  }
  goto END;
}

# Draw box
if($opt_box) {
  my @box_co=split(/,/, $opt_box);
  # we invert the y axis so +y points upward.
  $box_co[1] = abs(130 - $box_co[1]);
  $box_co[3] = abs(130 - $box_co[3]);
  # swap (y0,x0) -> (x0,y0)
  # and (y1,x1) -> (x1,y1)
  @box_co=&swapxy(@box_co);
  # By spec, x0 < x1 and y0 < y1, 
  # so we swap x0,x1 and y0,y1
  # in case x0 > x1 and y0 > y1.
  if($box_co[0] > $box_co[2]) {
    ($box_co[0],$box_co[2])=&swapxy($box_co[0], $box_co[2]);
  }
  if($box_co[1] > $box_co[3]) {
    ($box_co[1],$box_co[3])=&swapxy($box_co[1], $box_co[3]);
  }
  if(&areValidCoordinates(@box_co)) {
    send_serial("\033{"
      .$box_co[0]." "
      .$box_co[1]." "
      .$box_co[2]." "
      .$box_co[3]."F");
  }
  goto END;
}

# Draw circle
if($opt_circle) {
  my @circle_co=&swapxy(split(/,/, $opt_circle));
  if(@_=&areValidCoordinates(@circle_co)) {
    send_serial("\033{ "
      .$circle_co[0]." "
      .$circle_co[1]." "
      .$circle_co[2]."C");
  }
  goto END;
}

# Process input
# Grab STDIN
my $input;
while(<>) {
  $input.=$_;
}

# Split lines to re-encode for VAC
my @data=split(/\n/,$input);
my $vacLines;
foreach(@data) {
  $vacLines.=$_."\n\r";
}

# Split each character for VAC
@data=split(//,$vacLines);
foreach(@data) {
  send_serial($_);
}

END:
# Close port.
$serialPort->close();
exit 0;

__END__
=head1 NAME

bv4141ctl - Control a BV4141 display.

=head1 SYNOPSIS

echo "Hello world!" | bv4141ctl [options]

or

bv4141ctl [options]

=head1 OPTIONS

=over 8

=item B<--help>	

=item B<--?>			   

documentation

=item B<--clear>               
clear screen

=item B<--fg=<STRING|0..255>>  

sets foreground color and may be one of B<black>, B<white>, B<red>, B<green>, B<blue>, B<yellow>, B<magenta>, B<cyan> or an integer where B<0> represents black and B<255> white.

=item B<--bg=<STRING|0..255>>  

sets background color and may be one of B<black>, B<white>, B<red>, B<green>, B<blue>, B<yellow>, B<magenta>, B<cyan> or an integer where B<0> represents black and B<255> white.

=item B<--port=<STRING>>    
   
path to FTDI device. Using VDR, this defaults to B</dev/tty.usbserial-A600d25K> and needs to be changed accordingly.

=item B<--line=<x1,y1,x2,y2>>  

draws a line starting at point B<(x1,y1)> and ending with the point B<(x2,y2)> where B<x1,x2>=B<0..130> and B<y1,y2>=B<0..130>.

=item B<--box=<x1,y1,x2,y2>>   

draws a filled box between point B<(x1,y1)> and ending with the point B<(x2,y2)> where B<x1,x2>=B<0..130> and B<y1,y2>=B<0..130>.

=item B<--circle=<x1,y1,d>>    

draw a circle centered in the point B<(x1,y1)> of diameter B<d> if B<x1>>B<130> and B<y1>>B<130> then off-screen rendering occurs.

=item B<--cursor=<on|off>>     

hide (B<on>) or show the cursor (B<off>).

=item B<--light=<on|off>>   
   
toggle the backlight B<on> or B<off>.

=back

=head1 DESCRIPTION

B<bv4141ctl> reads STDIN for input and then pipes it to the display controller, by interpreting user-supplies input and translating them to the escape codes used by the display.

=cut