#!/usr/bin/perl
# Ezkey.pm
# Interface to the Alpha Sign Communications Protocol, EZ KEY II
# See http://www.ams-i.com/Pages/97088061.htm
#
# The purpose of this interface is to objectify and simplify communication
# with LED signs like the BetaBrite: http://betabrite.com/
#
# @author Matt Sparks
package Ezkey;

use strict;
use Data::Dumper;
use IO::Handle;
use Date::Format;
use POSIX qw/floor/;

require Exporter;
our @ISA = qw/Exporter/;
our @EXPORT = qw/%modes %graphics %positions/;

# Display Modes (p89)
our %modes = (
  "rotate"            => "a",
  "hold"              => "b",
  "flash"             => "c",
  "roll_up"           => "e",
  "roll_down"         => "f",
  "roll_left"         => "g",
  "roll_right"        => "h",
  "wipe_up"           => "i",
  "wipe_down"         => "j",
  "wipe_left"         => "k",
  "wipe_right"        => "l",
  "scroll"            => "m",
  "automode"          => "o",
  "roll_in"           => "p",
  "roll_out"          => "q",
  "wipe_in"           => "r",
  "wipe_out"          => "s",
  "compressed_rotate" => "t",  # only available on certain sign models
  "explode"           => "u",  # alpha 3.0 protocol
  "clock"             => "v",  # alpha 3.0 protocol
  # Special Modes
  "twinkle"           => "n0",
  "sparkle"           => "n1",
  "snow"              => "n2",
  "interlock"         => "n3",
  "switch"            => "n4",
  "slide"             => "n5", # only Betabrite 1036 (same as CYCLE_COLORS?)
  "spray"             => "n6",
  "starburst"         => "n7",
  "welcome"           => "n8",
  "slot_machine"      => "n9",
  "news_flash"        => "nA", # only Betabrite 1036
  "trumpet_animation" => "nb", # only betabrite 1036
  "cycle_colors"      => "nC", # only AlphaEclipse 3600
  # Special Graphics (these display before the message)
  "thank_you"         => "nS",
  "no_smoking"        => "nU",
  "dont_drive_drink"  => "nV",
  "running_animal"    => "nW",
  "fish_animation"    => "nW",
  "fireworks"         => "nX",
  "turbo_car"         => "nY",
  "balloon_animation" => "nY",
  "cherry_bomb"       => "nZ",
);

# Display Positions
our %positions = (
  "middle_line"       => "\x20",
  "top_line"          => "\x22",
  "bottom_line"       => "\x26",
  "fill"              => "\x30",
  "left"              => "\x31",
  "right"             => "\x32",
);

# Character Sets
our %charsets = (
  "five_high_std"     => "1",
  "five_stroke"       => "2",
  "seven_high_std"    => "3",
  "seven_stroke"      => "4",
  "seven_high_fancy"  => "5",
  "ten_high_std"      => "6",
  "seven_shadow"      => "7",
  "full_height_fancy" => "8",
  "full_height_std"   => "9",
  "seven_shadow_fancy"=> ":",
  "five_wide"         => ";",
  "seven_wide"        => "<",
  "seven_fancy_wide"  => "=",
  "wide_stroke_five"  => ">",
  # The following four only work on Alpha 2.0 and Alpha 3.0 protocols
  "five_high_cust"    => "W",
  "seven_high_cust"   => "X",
  "ten_high_cust"     => "Y",
  "fifteen_high_cust" => "Z",
);

# Extended characters
our %extchars = (
  "up_arrow"          => "\x64",
  "down_arrow"        => "\x65",
  "left_arrow"        => "\x66",
  "right_arrow"       => "\x67",
  "pacman"            => "\x68",
  "sail_boat"         => "\x69",
  "ball"              => "\x6A",
  "telephone"         => "\x6B",
  "heart"             => "\x6C",
  "car"               => "\x6D",
  "handicap"          => "\x6E",
  "rhino"             => "\x6F",
  "mug"               => "\x70",
  "satellite_dish"    => "\x71",
  "copyright_symbol"  => "\x72",
  "male_symbol"       => "\x73",
  "female_symbol"     => "\x74",
  "bottle"            => "\x75",
  "diskette"          => "\x76",
  "printer"           => "\x77",
  "musical_note"      => "\x78",
  "infinity_symbol"   => "\x79",
);

# Counters
# We have 5 of them.
our %counters = (
  1                   => "z",
  2                   => "{",
  3                   => "|",
  4                   => "}",
  5                   => "-",
);

# Colors
our %colors = (
  "red"               => "1",
  "green"             => "2",
  "amber"             => "3",
  "dim_red"           => "4",
  "dim_green"         => "5",
  "brown"             => "6",
  "orange"            => "7",
  "yellow"            => "8",
  "rainbow_1"         => "9",
  "rainbow_2"         => "A",
  "color_mix"         => "B",
  "autocolor"         => "C",
);

# Command Codes
use constant {
  WRITE_TEXT          => "A", # Write TEXT file (p18)
  READ_TEXT           => "B", # Read TEXT file (p19)
  WRITE_SPECIAL       => "E", # Write SPECIAL FUNCTION commands (p21)
  READ_SPECIAL        => "F", # Read SPECIAL FUNCTION commands (p29)
  WRITE_STRING        => "G", # Write STRING (p37)
  READ_STRING         => "H", # Read STRING (p38)
  WRITE_SMALL_DOTS    => "I", # Write SMALL DOTS PICTURE file (p39)
  READ_SMALL_DOTS     => "J", # Read SMALL DOTS PICTURE file (p41)
  WRITE_RGB_DOTS      => "K", # Write RGB DOTS PICTURE file (p44)
  READ_RGB_DOTS       => "L", # Read RGB DOTS PICTURE file (p46)
  WRITE_LARGE_DOTS    => "M", # Write LARGE DOTS PICTURE file (p42)
  READ_LARGE_DOTS     => "N", # Read LARGE DOTS PICTURE file (p43)
  WRITE_ALPHAVISION   => "O", # Write ALPHAVISION BULLETIN (p48)
  SET_TIMEOUT         => "T", # Set Timeout Message (p118) (Alpha 2.0/3.0)
};

# Constants used in transmission packets
use constant {
  NUL                 => "\x00", # NULL
  SOH                 => "\x01", # Start of Header
  STX                 => "\x02", # Start of TeXt (precedes a command code)
  ETX                 => "\x03", # End of TeXt
  EOT                 => "\x04", # End Of Transmission
#   ENQ                 => "\x05", # Enquiry
#   ACK                 => "\x06", # Acknowledge
  BEL                 => "\x07", # Bell
  BS                  => "\x08", # Backspace
  HT                  => "\x09", # Horizontal tab
  LF                  => "\x0A", # Line Feed
  NL                  => "\x0A", # New Line
  VT                  => "\x0B", # Vertical Tab
#   FF                  => "\x0C", # Form Feed
#   NP                  => "\x0C", # New Page
  CR                  => "\x0D", # Carriage Return
  CAN                 => "\x18", # Cancel
  SUB                 => "\x1A", # Substitute (select charset)
  ESC                 => "\x1B", # Escape character
};

# Constructor
# - device: device of the LED sign
sub new {
  my($class,$device)=@_;

  my $self={
    "device"        => $device,
    "type"          => "Z",           # Type Code, see protocol
    "address"       => "00",          # Sign Address, see protocol
    "mode"          => "rotate",      # Default display mode
    "position"      => "middle_line", # Approrpriate for one-line signs
    "debug"         => 0,             # debugging
  };

  return bless $self,$class;
}

# Connect to the sign (open the serial device)
# If no device is known, the default /dev/ttyS0 is selected
sub connect {
  my($this,$device)=@_;
  $device ||= $this->{device};
  if (!$device) {
    warn "No device specified. Defaulting to /dev/ttyS0.\n";
    $device = "/dev/ttyS0";
  }

  # Open a connection to the sign
  open(OUT,">",$device)
    or die "Could not open $device for output: $!\n";
  OUT->autoflush(1);

  open(IN,"<",$device)
    or die "Could not open $device for input: $!\n";
  IN->autoflush(1);
}

# Disconnect from the sign (close the serial device)
sub disconnect {
  my($this)=@_;
  close OUT;
  close IN;
}

sub _packet {
  my($this,$contents)=@_;
  return ((NUL x 5) . SOH . $this->{type} . $this->{address} . STX
          . $contents . EOT);
}

sub _write {
  my($this,$packet)=@_;
  die "Not connected to device. Use \$sign->connect().\n" if !OUT->opened;
  if ($this->{debug}) {
    # make human-readable packet for display
    my $hr = $packet;
    #for(0..27) {
    #    my $hex = hex $_;
    #    $hr =~ s/\x$hex/[$hex]/g;
    #}
    print "Writing packet: $hr\n";
  }
  print OUT $packet;
}

# Read from the sign
# This does not seem to work correctly yet. All read_* functions therefore
# do not work.
sub _read {
  my($this)=@_;
  my $data;
  sysread IN,$data,1024;
  return $data;
}

sub dec2hex {
  my($dec) = @_;
  return sprintf("%lx ", $dec );
}

sub hex2dec {
  return hex($_[0]);
}

# Set display mode
# for $mode, use one of the Standard Mode constants exported
# if $mode is SPECIAL, set $special_mode to one of the defined special modes
sub set_mode {
  my($this,$mode)=@_;

  if ($modes{$mode}) {
    $this->{mode} = $mode;
  }
  else {
    warn "Warning: '$mode' is an invalid mode\n";
  }
}

# Get display mode
sub get_mode {
  my($this)=@_;
  return $this->{mode};
}

# Set display position
# This is mostly unimportant for one line signs.
sub set_position {
  my($this,$position)=@_;
  if ($positions{$position}) {
    $this->{position} = $position;
  }
  else {
    warn "Warning: '$position' is an invalid position\n";
  }
}

# Get display position
sub get_position {
  my($this)=@_;
  return $this->{position};
}

# Write TEXT to the sign
sub write_text {
  my($this,$msg,$label)=@_;
  $label ||= "A";

  # [WRITE_TEXT][File Label][ESC][Display Position][Mode Code]
  #   [Special Specifier][ASCII Message]
  my $packet = $this->_packet(WRITE_TEXT . $label . ESC
                              . $positions{$this->{position}}
                              . $modes{$this->{mode}} . $msg);
  $this->_write($packet);
}

# Read TEXT from the sign
sub read_text {
  my($this,$label)=@_;
  $label ||= "A";
  $this->_write($this->_packet(READ_TEXT . $label));
  return $this->_read();
}

# Create a STRING
# This is necessary to allocate memory for the STRING on the sign
#
# $string_label: label of the STRING to create
# $string_size:  size of the STRING to create, in bytes. 125 max.
#                Default is 32.
sub create_string {
  my($this,$string_label,$string_size)=@_;
  $string_label ||= 1;
  $string_size = 125 if $string_size > 125;
  $string_size ||= 32;
  my $size_hex = hex($string_size);
  $size_hex = "0"x(4-length($size_hex)).$size_hex if length($size_hex) < 4;
  my $packet = $this->_packet(WRITE_SPECIAL . "\$"
                              . "A"    # call label.. why does this matter?
                              . "A"    # text file type
                              . "U"    # this TEXT file is unlocked
                              . "0100" # text file size in hex
                              . "FF"   # text file's start time (FF = always)
                              . "00"   # text file's stop time
                              . $string_label
                              . "B"    # string file type
                              . "L"    # this string file is locked
                              . $size_hex
                              . "0000" # padding
                             );
  $this->_write($packet);
}

# Write a STRING
sub write_string {
  my($this,$data,$label)=@_;
  $label ||= 1;
  my $packet = $this->_packet(WRITE_STRING . $label . $data);
  $this->_write($packet);
}

sub read_string {
  my($this,$label)=@_;
  $label ||= 1;
  my $packet = $this->_packet(READ_STRING . $label);
  $this->_write($packet);
  return $this->_read();
}

# Call a STRING
# Returns the control code of specified string label. This is for
# inserting a STRING file into a TEXT file
sub call_string {
  my($this,$string_label)=@_;
  $string_label ||= "1";
  return "\x10" . $string_label;
}

# Call Date
# Returns the control code for the date to be inserted in a TEXT
# $format:  integer from 0 to 9
#           0 - MM/DD/YY
#           1 - DD/MM/YY
#           2 - MM-DD-YY
#           3 - DD-MM-YY
#           4 - MM.DD.YY
#           5 - DD.MM.YY
#           6 - MM DD YY
#           7 - DD MM YY
#           8 - MMM.DD, YYYY
#           9 - Day of week
# Format defaults to 0 if invalid or not specified
sub call_date {
  my($this,$format);
  $format ||= 0;
  $format = 0 if ($format < 0 || $format > 9);
  return "\x0B" . $format;
}

# Call Time
# Returns control code for the time.
sub call_time {
  my($this)=@_;
  return "\x13";
}

# Clear sign's memory
sub clear_memory {
  my($this)=@_;
  my $packet = $this->_packet(WRITE_SPECIAL . "\$");
  $this->_write($packet);
}

# Generate a tone/beep
#    $frequency: frequency of tone to generate, in hex ("00" through "FE")
#    $duration:  duration, in hex, of tone in 0.1s increments ("1" through "F")
#    $repeat:    number of times, in hex, to repeat the tone ("0" through "F")
sub beep {
  my($this,$frequency,$duration,$repeat)=@_;
  $frequency ||= "10";
  $duration  ||= "2";
  $repeat    ||= 0;

  my $packet = $this->_packet(WRITE_SPECIAL . "(2" . $frequency . $duration
                              . $repeat);
  $this->_write($packet);
}

# Perform a soft reset on the sign (does not clear memory; non-destructive)
sub soft_reset {
  my($this)=@_;
  my $packet = $this->_packet(WRITE_SPECIAL . ",");
  $this->_write($packet);
}

# Set the day of the week on the sign
# $day must be an integer between 1 and 7.
#    1 = Sunday, 2 = Monday, etc.
# Omitting the $day parameter will cause today's day to be sent
# Returns -1 if an invalid day is specified.
sub set_day {
  my($this,$day)=@_;
  return -1 if ($day && ($day < 1 || $day > 7));
  $day ||= time2str("%w",time)+1;

  my $packet = $this->_packet(WRITE_SPECIAL . "&" . $day);
  $this->_write($packet);
}

# Sets the date in the memory of the sign. This must be done each day to keep
# the clock 'up to date', because the sign will not automatically advance the
# day.
#
# NOTE: each of the parameters must be two characters long.
#
# If no date is specified, today's date will be used.
sub set_date {
  my($this,$year,$month,$day)=@_;
  $year  ||= time2str("%y",time);
  $month ||= time2str("%m",time);
  $day   ||= time2str("%d",time);

  my $packet = $this->_packet(WRITE_SPECIAL . ";" . $month . $day . $year);
  $this->_write($packet);
}

# Sets the hour and minute of the internal clock on the sign
# $h: hour in twenty-four hour format (18 instead of 6 for 6PM)
# $m: minute
# If no time (or an invalid time) is specified, the current system time will
# be used
sub set_time {
  my($this,$h,$m)=@_;
  $h = "" if ($h < 0 or $h > 23);
  $m = "" if ($m < 0 or $m > 59);
  $h ||= time2str("%H",time);
  $m ||= time2str("%M",time);

  my $packet = $this->_packet(WRITE_SPECIAL . "\x20" . $h . $m);
  $this->_write($packet);
}

# Sets the time format on the sign
# $format: 1 - 24-hour (military) time
#          0 - 12-hour (standard am/pm) format
# 12-hour is the default
sub set_time_format {
  my($this,$format)=@_;
  $format ||= 0;
  $format = 0 if ($format > 1 || $format < 0);
  my $byte = ($format == 0) ? "S" : "M";

  my $packet = $this->_packet(WRITE_SPECIAL . "\x27" . $byte);
  $this->_write($packet);
}

# Returns color code for a specified color
# If an invalid color is specified, autocolor will be used
sub color {
  my($this,$color)=@_;
  $color = "autocolor" if !$colors{$color};
  return "\x1C" . $colors{$color};
}

# Returns control code for a specified character set
# Defaults to 'five_high_std', Five High Standard
sub charset {
  my($this,$charset)=@_;
  $charset = "five_high_std" if !$charsets{$charset};
  return "\x1A" . $charsets{$charset};
}

# Returns control code for a specified extended char
# Defaults to 'left_arrow'
sub extchar {
  my($this,$extchar)=@_;
  $extchar = "left_arrow" if !$extchars{$extchar};
  return "\x08" . $extchars{$extchar};
}

# Returns control code to set the character spacing.
# $option: if 0, set proportional characters (default)
#             1, fixed width left justified characters
sub spacing {
  my($this,$option)=@_;
  my $byte = ($option == 0) ? 0 : 1;
  return "\x1E" . $byte;
}

# Set the speed
# $speed: integer 1 (slowest) through 5 (fastest) inclusive.
sub speed {
  my($this,$speed)=@_;
  $speed ||= 1;
  $speed = 1 if ($speed < 1 || $speed > 5);
  my $n = 20+$speed;
  return chr($n);
}

1;