#!/usr/bin/perl

# program to control an Advanced Micro Systems SAX/DAX stepper motor
# controller (single axis)

# by Chris MacGregor (chris-stepit@cybermato.com)
# Cybermato Consulting
# started June 23, 2003

# See http://www.cybermato.com/projects/steppers for latest version
# and other information.

# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

$version = "1.2 6-15-04";
$versioninfo = "StepIt.pl Version $version";

use Time::Local;

$commdev = "/dev/ttyS0";
$steps_per_revolution = 400;
$revolutions_per_inch = 5;
$steps_per_inch = $steps_per_revolution * $revolutions_per_inch;

$usage = <<ENDUSAGE;
$versioninfo
Control an Advanced Micro Systems SAX/DAX stepper motor controller

Usage:  stepit.pl [options] commandspec(s)

  Options:
    -verbose       Describe what StepIt is doing
    -debug         Used for debugging StepIt
    -commdev       Specify device to use for communications, or "none"
                   (default is $commdev)
    -skipsleep[=N] Say how long we would have slept but really sleep only N
                   seconds (default 5) - useful (only) for testing/debugging
    -nowait        Don't wait for commands to complete - continue immediately
    -noexec        Don't actually execute any "exec" commands
    -notreally     Same as "-commdev none -skipsleep -noexec"; useful for
                   testing your StepIt scripts

  Commandspec(s): any one or more of the following in any order:
    -do <command>
    <file_of_commands>
    -reset        (immediate version of "-do reset")
    -abort        (immediate version of "-do abort")
    -softabort    (immediate version of "-do softabort")

  Command: any of the following:
    reset         Send ^C to hard-reset the controller
    abort         Send ESC to immediately halt any current motion
    softabort     Send @ to decelerate and halt
    set X N       Set parameter X to N
                  ex. "set i 20" or "set k 50,10"
    include FILE  Read and execute commands from FILE and then continue
    sleep TIME [TIME...]
                  Sleep for TIME, where TIME is one or more of:
                      Wd    W days
                      Xh    X hours
                      Ym    Y minutes
                      Zs    Z seconds
                  ex. "sleep 20m" or "sleep 1h 37m 29s" or "sleep 7d"
    sleep until ABSTIME
                  Sleep until the specified absolute time, where ABSTIME is in
                  one of the following forms:
                      DD/MM/YYYY HH:MM:SS
                      DD/MM/YYYY HH:MM:SS am
                      DD/MM/YYYY HH:MM:SS pm
                      HH:MM:SS
                      HH:MM:SS am
                      HH:MM:SS pm
                  ex. "sleep until 14/06/2004 13:02:51"
                  or "sleep until 1:03 pm"
                  *** IMPORTANT NOTES: ***
                   * Dates are in the European format: day first followed by
                     month followed by year, NOT the US format (month first
                     followed by day).
                   * If no date is specified, then either the current or next
                     day is assumed, as follows: If the time specified has
                     already passed for the current day, then it is assumed to
                     refer to the next day; otherwise, the current day is
                     assumed.
                   * You may use a 24-hour clock (00:00 - 23:59) OR am/pm.
                     Specify a time like "14:02 pm" at your own risk.
    go home       Find the home position - may not work in some situations
    go up DIST    See go down DIST, below
    go down DIST  Move down distance DIST from the current position, where
                  DIST is one of:
                      Ncm   N centimeters
                      Nin   N inches
                      Nst   N steps
                  ex. "go up 20cm" or "go down 36in" or "go up 1001st"
    go to POS     Go to an absolute position relative to the origin, where
                  POS has the same syntax as DIST, above
    send STEPCMD  Send literal STEPCMD to the stepper controller directly with
                  no interpretation or modification
                  ex. "send m300"
    sendq QCMD    Same as "send" except expects (and displays) a response
                  ex. "sendq x"
    exec UNIXCMD  Execute literal UNIXCMD by passing it to the system shell
                  ex. "exec dvgrab -frames 100000000000000000000000001"
ENDUSAGE
    ; # this isn't syntactically necessary but it placates emacs' perl-mode

# !##########################################################################
# \fn void getargs (void)
# \brief Process command line arguments, setting various global variables
# (which are documented individually).
# !##########################################################################

sub getargs
{
    while (@ARGV)
    {
        $arg = shift @ARGV;
        if ($arg =~ /^-debug(w?)(\d*)$/)
        {
            # ! \var int $debug \brief is set to 1 or greater by -debug to
            # generate various forms and levels of debugging output.

            $debug += $2 || 1;
        }
        elsif ($arg =~ /^-v(?:erbose)?(\d*)$/)
        {
            # ! \var int $verbose \brief is set to 1 or greater by -verbose to
            # generate various forms and levels of information about what
            # the program is doing.

            $verbose += $1 || 1;
        }
        elsif ($arg =~ /^-comm(dev)?$/)
        {
            $commdev = shift @ARGV;
        }
        elsif ($arg =~ /^-do$/)
        {
            push (@cmds, shift @ARGV);
        }
        elsif ($arg =~ /^-(reset|abort|softabort)$/)
        {
            opencomm ();
            execute_command ($1);
            $didsomething = 1;
        }
        elsif ($arg =~ /^-skipsleep(?:=([\d\.]+))?$/)
        {
            $skipsleep = 1;  # only useful for debugging
            $sleepytime = $1 || 1;
        }
        elsif ($arg eq "-nowait")
        {
            $nowait = 1;
        }
        elsif ($arg eq "-noexec")
        {
            $noexec = 1;
        }
        elsif ($arg eq "-notreally" || $arg eq "-n")
        {
            $notreally = 1;
            $noexec = 1;
            $commdev = "none";
            $skipsleep = 1;
            $sleepytime = 5;
        }
        elsif ($arg !~ /^-/)
        {
            push (@cmds, "include $arg");
        }
        elsif ($arg =~ /^[-\/](\?|h(elp)?|usage)$/)
        {
            print $usage;
            exit 1;
        }
        else
        {
            print "$usage\nUnrecognized option \"$arg\"\n";
            exit 1;
        }
    }

    $verbose = 1
	if $debug && !$verbose;

    $| = 1
        if $verbose || 1;
}

#############################################################################
#############################################################################
#######################  General Utility Functions  #########################
#############################################################################
#############################################################################

# !##########################################################################
# \fn string getdate (void)
# \brief Return the current date and time, formatted like "Wed Feb 19 2003
# 12:40:09".
# !##########################################################################

sub getdate
{
    my ($when) = @_;
    $when = time
        if !defined ($when);
    my ($sec, $min, $hour, $mday, $mon, $year, $wday) = localtime ($when);
    my ($date) =
	sprintf ("%s %s %2d %d %02d:%02d:%02d",
		 ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat") [$wday],
		 ("Jan", "Feb", "Mar", "Apr", "May", "Jun",
		  "Jul", "Aug", "Sep", "Oct", "Nov", "Dec") [$mon],
		 $mday, $year + 1900, $hour, $min, $sec);
    return $date;
}

# !##########################################################################
# \fn string getshortdate (void)
# \brief Return the current date and time, formatted like " 5-Jul-2003 12:40:09".
# !##########################################################################

sub getshortdate
{
    my ($when) = @_;
    $when = time
        if !defined ($when);
    my ($sec, $min, $hour, $mday, $mon, $year, $wday) = localtime ($when);
    my ($date) =
	sprintf ("%2d-%s-%d %02d:%02d:%02d",
                 $mday, 
		 ("Jan", "Feb", "Mar", "Apr", "May", "Jun",
		  "Jul", "Aug", "Sep", "Oct", "Nov", "Dec") [$mon],
		 $year + 1900, $hour, $min, $sec);
    return $date;
}

sub opencomm
{
    if ($commopen eq $commdev)
    {
	print "Comm on $commdev already open\n"
	    if $verbose;
	return;
    }

    if ($commdev eq "none")
    {
	print "DEBUG MODE: sending no data\n"; 
	return;
    }

    print "Opening $commdev...\n"
	if $verbose;

    my $sttycmd = "stty -F $commdev 9600 -parenb cs8 cread clocal -crtscts " .
        "ignpar -parmrk -inpck -istrip -inlcr -igncr -icrnl -ixon -ixoff " .
        "-opost -ocrnl -onlcr -onocr -onlret -isig -icanon -iexten -echo " .
	"-echoe -echok -echoctl -echoke ignbrk -hupcl time 5";
    print "Running \"$sttycmd\"...\n"
	if $debug >= 2;
    system ($sttycmd);
    die "\"$sttycmd\" returned $?" if $?;

    open (COMM, "+< $commdev") || die "Can't open $commdev: $!";

    $commopen = $commdev;
}

# just send something

sub sendrawcmd
{
    my ($cmd) = @_;

    print "Sending \"$cmd\" raw (no \\r)...\n"
        if $verbose;

    syswrite (COMM, "$cmd");
}

sub sendcmdnowait
{
    my ($cmd) = @_;

    print "Sending \"$cmd\"...\n"
        if $verbose;

    #############################################################
    #############################################################
    # HERE: What happens if we use "$cmd\n" or "$cmd\n\r"???
    #############################################################
    #############################################################

    syswrite (COMM, "$cmd\r");
}

# send a command and wait for a CR

sub sendcmd
{
    my ($cmd, $showresponse) = @_;

    sendcmdnowait ($cmd);

    return if $commdev eq "none";

    print "Waiting for CR...\n"
        if $debug || $verbose >= 2;

    my $response;
    my $echoed_cmd;
    my $newline_seen = 0;
    my $char;

    while ($char ne "\r")
    {
        my $sysret = sysread (COMM, $char, 1);
        die "sysread returned \"$sysret\""
            if ($sysret < 1);
	if ($newline_seen)
	{
	    $response .= $char;
	}
	elsif ($char eq "\n")
	{
	    $newline_seen = 1;
	}
	else
	{
	    $echoed_cmd .= $char;
	}

	if ($debug >= 2)
	{
	    my $dchar = $char;
	    if ($dchar eq "\r")
	    {
		$dchar = "<\\r>";
	    }
	    elsif ($dchar eq "\n")
	    {
		$dchar = "<\\n>";
	    }
	    elsif (ord ($dchar) < 32)
	    {
		$dchar = sprintf ("<0x%02x>", ord ($dchar));
	    }

	    print "received \"$dchar\"\n";
	}
    }

    $response =~ s/\r$//;
    print "Echoed: \"$echoed_cmd\"\n"
        if $debug;
    print "Received: \"$response\"\n"
        if $showresponse || $verbose;
}

my %stepconv = ( "in" => $steps_per_inch,
                 "cm" => $steps_per_inch / 2.54,
                 "s" => 1, # deprecated - use "st"
                 "st" => 1 );

sub convsteps
{
    my ($amount, $what) = @_;

    if ($amount =~ /^([+-]?)([\d\.]+)(in|cm|s)$/)
    {
	my ($plusminus, $quantity, $units) = ($1, $2, $3);
        $amount = $quantity * $stepconv {$units};
	$amount = -$amount
	    if $plusminus eq "-";
    }
    elsif ($amount eq "0")
    {
	return 0;
    }
    else
    {
        die "Syntax error in $what: \"$amount\": must be "
            . "one of Xin, Xcm, Xst, where X is a number\n";
    }

    # the origin is the bottom and everything (up) is negative from that, so
    # multiply by -1.
    return -int ($amount);
}

my %timeconv = ( "d" => 60 * 60 * 24,
                 "h" => 60 * 60,
                 "m" => 60,
                 "s" => 1 );

sub fmttime
{
    my ($hour, $min, $sec) = @_;

    return sprintf ("%02d:%02d:%02d", $hour, $min, $sec);
}

sub convtime
{
    my (@parts) = @_;

    my $time = 0;

    if ($parts [0] eq "until")
    {
        my ($day, $month, $year, $hour, $minute, $second);
        shift @parts;
        foreach $part (@parts)
        {
            if ($part =~ /^(\d+)\/(\d+)\/(\d+)$/)
            {
                die "Syntax error in sleep until: \"$part\": date was already"
                    . " specified as $day/$month/$year\n"
                    if "$day$month$year" ne "";
                ($day, $month, $year) = ($1, $2, $3);
                if (length ($year) != 4)
                {
                    die "Syntax error in sleep until: \"$part\": year ($year)"
                        . " must be 4 digits\n";
                }
                if ($month > 12)
                {
                    die "Syntax error in sleep until: \"$part\": month ($month)"
                        . " must be 1-12 (maybe you meant to write "
                        . "\"$month/$day/$year\"?)\n";
                }
            }
            elsif ($part =~ /^(\d+):(\d\d)(?::(\d\d))?(am|pm)?$/i)
            {
                my ($newhour, $newminute, $newsecond, $ampm) = ($1, $2, $3, $4);
                die "Syntax error in sleep until: \"$part\": time was already"
                    . " specified as " . fmttime ($hour, $minute, $second) . "\n"
                    if "$hour$minute$second" ne "";
                $newsecond = "00"
                    if $newsecond eq "";
                ($hour, $minute, $second) = ($newhour, $newminute, $newsecond);
                push (@parts, $ampm)
                    if $ampm ne "";
            }
            elsif ($part =~ /^(am|pm)$/i)
            {
                if (lc $part eq "pm")
                {
                    if ($hour > 12)
                    {
                        warn "What do you mean by $hour:$minute:$second pm??\n";
                    }
                    elsif ($hour < 12)
                    {
                        $hour += 12;
                    }
                }
                else # am
                {
                    if ($hour > 12)
                    {
                        warn "What do you mean by $hour:$minute:$second am??\n";
                    }
                    elsif ($hour == 12)
                    {
                        $hour = 0;
                    }
                }
            }
            else
            {
                die "Syntax error in sleep until: \"$part\": not recognized "
                    . "as a date or time\n";
            }
        }
        die "Error in sleep until @parts: time not specified\n"
            if "$hour$minute$second" eq "";
        my ($nowsec, $nowmin, $nowhour, $nowmday, $nowmon, $nowyear)
            = localtime (time);
        my $boost = 0;
        if ($day eq "")
        {
            $boost = 24 * 60 * 60
                if (fmttime ($nowhour, $nowmin, $nowsec) >
                    fmttime ($hour, $minute, $second));
            ($day, $month, $year) = ($nowmday, $nowmon + 1, $nowyear + 1900);
        }
        my $abstime = timelocal ($second, $minute, $hour,
                                 $day, $month - 1, $year - 1900);

        my ($chksec, $chkmin, $chkhour, $chkmday, $chkmon, $chkyear)
            = localtime ($abstime);
        die "oops: ($chksec,$chkmin,$chkhour, $chkmday,$chkMon,$chkyear) " .
            "returned for ($second,$minute,$hour, $day,"
            . ($month-1) . "," . ($year - 1900) . ")\n"
            if ($chksec != $second || $chkhour != $hour ||
                $chkmin != $minute || $chkmon + 1 != $month ||
                $chkmday != $day || $chkyear + 1900 != $year);

        $abstime += $boost;
        $time = $abstime - time;
        if ($time < 0)
        {
            warn "*** You asked to sleep until "
                . getshortdate ($abstime) . ", but that time has already "
                . "passed;\n    it is currently " . getshortdate (time)
                . "!  Ignoring and continuing...\n";
            $time = 0;
        }
    }
    else
    {
        foreach $part (@parts)
        {
            if ($part =~ /^([\d\.]+)([dhms])$/)
            {
                $time += $1 * $timeconv {$2};
            }
            else
            {
                die "Syntax error in sleep: \"$part\": must be "
                    . "one or more of Xd, Xh, Xm, Xs where X is a number\n";
            }
        }

        if ($time <= 0)
        {
            warn "*** Did you really want to sleep for $time seconds?  "
                . "(I'm ignoring this!)\n";
            $time = 0;
        }
    }

    return $time;
}

sub execute_command
{
    my ($cmd) = @_;

    my $cmd2 = $cmd;
    $cmd2 =~ s/\#.*$//;    # drop comments
    $cmd2 =~ s,\/\/.*$,,;  # drop comments
    $cmd2 =~ s/^\s+//;
    $cmd2 =~ s/\s+$//;
    next if $cmd2 eq "";

    my @parts = split (" ", $cmd2);

    print getshortdate(), "  Command: ", join (" ", @parts), "\n";
    my $keyword = shift @parts;
    if ($keyword eq "set")
    {
        $cmd2 =~ s/^$keyword\s*//;
        $cmd2 =~ s/=//;
        sendcmd ($cmd2);
    }
    elsif ($keyword =~ /^send(q?)$/)
    {
	my $query = $1;
        $cmd2 =~ s/^$keyword\s*//;
        sendcmd ($cmd2, $query ne "");
    }
    elsif ($keyword eq "reset")
    {
        sendrawcmd ("\003");   # ^C
        sleep (.5);
	# HERE: if this doesn't work, maybe try "\r "??
        sendcmd (" ");
    }
    elsif ($keyword eq "abort")
    {
	#############################################################
	# HERE: should the following be sendrawcmd???
	#############################################################

        sendcmdnowait ("\033");   # ESC
        sleep (.5);
        sendcmd (" ");
    }
    elsif ($keyword eq "softabort")
    {
        sendcmd ("@");
    }
    elsif ($keyword eq "include")
    {
        $filename = shift @parts;
        $linenum = 0;
        # HERE: syntax checking
        open (IN, "< $filename") || die "Can't open $filename: $!";
        my @morecmds = <IN>;
        close (IN);
        print "Reading commands from $filename...\n";
        unshift (@cmds, @morecmds, "endinclude");
    }
    elsif ($keyword eq "endinclude")
    {
        print "End of commands from $filename.\n";
        $filename = "";
        $linenum = 0;
        # HERE: syntax checking
    }
    elsif ($keyword eq "sleep")
    {
        my $time = convtime (@parts);
        my $howlong = "$time second";
        $howlong .= "s"
            if $time != 1;
        $howlong .= " (";
        if ($time > 60)
        {
            my $timeleft = $time;
            if ($timeleft > 60 * 60)
            {
                if ($timeleft > 60 * 60 * 24)
                {
                    my $days = int ($timeleft / (60 * 60 * 24));
                    $timeleft -= $days * 60 * 60 * 24;
                    $howlong .= "$days/";
                }
                my $hours = int ($timeleft / (60 * 60));
                $timeleft -= $hours * 60 * 60;
                $howlong .= "0"
                    if $hours < 10 && $howlong !~ /\($/;
                $howlong .= "$hours:";
            }
            my $minutes = int ($timeleft / 60);
            $timeleft -= $minutes * 60;
            $howlong .= "0"
                if $minutes < 10 && $howlong !~ /\($/;
            $howlong .= sprintf ("%d:%02d = ", $minutes, $timeleft);
        }
        $howlong .= "until " . getshortdate (time + $time) . ")";

        if ($skipsleep)
        {
            print "Would sleep for $howlong...";
            sleep ($sleepytime);
            print "and then continue.\n";
        }
        else
        {
            print "Sleeping for $howlong...\n";
            sleep ($time);
        }
    }
    elsif ($keyword eq "go")
    {
        $keyword = shift @parts;
        if ($keyword eq "home")
        {
            sendcmd ("f1,1"); # HERE: figure this out
            sendcmd ("w0")
		if !$nowait;
        }
        elsif ($keyword =~ /^(up|down)$/)
        {
            my $updown = $1;
            my $amount = convsteps (shift @parts, "$updown distance");
            $amount *= -1
                if $updown eq "down";
            sendcmd (sprintf ("%+d", $amount));
            sendcmd ("w0")
		if !$nowait;
        }
        elsif ($keyword eq "to")
        {
            my $amount = convsteps (shift @parts, "position");
            sendcmd ("r $amount");
            sendcmd ("w0")
		if !$nowait;
        }
        else
        {
            die "go subcommand \"$keyword\" not recognized\n";
        }
            
        # HERE: syntax checking
    }
    elsif ($keyword eq "exec")
    {
        $cmd2 =~ s/^$keyword\s*//;
        if ($noexec)
        {
            print "Would execute \"$cmd2\"\n";
        }
        else
        {
            system ($cmd2);
            my $ret = $?;
            $ret /= 256
                if ($ret >= 0 && ($ret % 256) == 0);
            print "**** Command returned $ret!\n"
                if $ret;
        }
    }
    else
    {
        die "Command \"$keyword\" not recognized\n";
    }
}

# main program starts here

getargs ();

if (@cmds == 0)
{
    exit 0 if $didsomething;
    die "$usage\nNeed something to do!\n";
}

print $versioninfo, "\n";

print "Running in -notreally (script testing) mode...\n"
    if $notreally;

opencomm ();

print "Initializing communications on $commdev...\n"
    if $verbose;
sendcmd (" ");

$linenum = 0;
$filename = "";
while (@cmds)
{
    $cmd = shift @cmds;
    $linenum++;
    execute_command ($cmd);
}

close (COMM);