# Write raw commands to the supply
sub WriteSupplyRaw
    {
    my $eos = shift;
    my $command = $_[0];
    my $settle = $_[1] || SETTLEDELAYMS;

    logprintf(Translate("%-15s %-14s", "<cmd>", $command));
    PortWrite($SupplyPortObj, "$command\r");
    Win32::Sleep($settle);
    GetPortInput($SupplyPortObj);
    logprint(Translate(" <Response>:"), '"', $PortInput, '"');
    logprint($eos);
    }

# Write the given voltage to the supply.
# Called with the voltage
sub WriteSupply
    {
    my $eos = shift;
    my $voltage = $_[0];
    $voltage = &{$voltage} if ref($voltage) eq 'CODE';
    my $settle = $_[1] || SETTLEDELAYMS;
    my $setvolts = sprintf "sv %.2f", $voltage;

    logprintf(Translate("%-15s %-14s", sprintf("<set> %5.2fV", $voltage), qq("$setvolts")));
    PortWrite($SupplyPortObj, "$setvolts\r");
    Win32::Sleep($settle);
    GetPortInput($SupplyPortObj);
    $PortInput =~ s/$setvolts \\ //;
    logprint(Translate(" <Response>:"), '"', $PortInput, '"');
    logprint($eos);
    }

# Write to the evil port and show the response.
# Called with printf arguments that generate the command for the
# evil port, excluding the trailing \r
sub WriteEvil
    {
    my $eos = shift;
    my $format = shift;
    my $evilcommand = sprintf($format, @_);
    logprint(Translate("%-15s %-14s", "<Evil command>:", qq("$evilcommand")));
    PortWrite($EvilPortObj, "$evilcommand\r");
    logprint(Translate(" <Response>:"), '"', GetPortInput($EvilPortObj), '"');
    logprint($eos);
    }

# Open a port.
# Called with a hash of zero or more of the following parameters:
#
# PORT => default=COM1
# OPENFAIL => default="<Error trying to open the port>" (translated)
# OPENFAIL => {SUB => \&sub, PARMS => [parms]}  calls sub($error, @parms) and returns undef
# HANDSHAKE => default='none' 'xoff' 'dtr' 'rts'
# BAUDRATE => default=9600 115200 1200 38400 4800 2400 600 57600 19200 300
# DATATYPE => default='raw'
# PARITY => default=none mark even odd space
# DATABITS => default=8 7
# STOPBITS => default=1 2
# TIMEOUT => default=200(ms)
# CRTERMINATE => default=0 1
# TRANSLATECR => default=1 0
sub PortOpenParms
    {
    # Set up the default values for all parameters
    my %Default =
        (
        PORT => 'COM1',
        OPENFAIL => Translate("<Error trying to open the port>"),
        HANDSHAKE => 'none',
        BAUDRATE => 9600,
        DATATYPE => 'raw',
        PARITY => 'none',
        DATABITS => 8,
        STOPBITS => 1,
        TIMEOUT => 200,
        CRTERMINATE => 0,
        TRANSLATECR => 1,
        );

    # Fill in defaults for anything that wasn't specified
    my %Parm = @_;
    foreach (keys %Default) { $Parm{$_} = $Default{$_} if not exists $Parm{$_}; }

    $Parm{BAREPORT} = $Parm{PORT};
    $Parm{BAREPORT} =~ s/^\\\\\.\\//;

    return %Parm;
    }

sub PortOpen
    {
    my %Parm = PortOpenParms(@_);

    # Open the port
    my $PortObj = new Win32::SerialPort($Parm{PORT}, 1);
    if (!$PortObj)
        {
        if (ref($Parm{OPENFAIL}) eq 'HASH')
            {
            my %openfail = %{$Parm{OPENFAIL}};
            &{$openfail{SUB}}($^E, @{$openfail{PARMS}});
            return undef;
            }
        else
            {
            Death "$Parm{OPENFAIL} $Parm{PORT}: $^E\n";
            }
        }
    my ($BlockingFlags, $InBytes, $OutBytes, $LatchErrorFlags) = $PortObj->status || warn "could not get port status\n";

    # Set up the line settings
    $PortObj->handshake($Parm{HANDSHAKE});
    $PortObj->baudrate($Parm{BAUDRATE});
    $PortObj->datatype($Parm{DATATYPE});
    $PortObj->parity($Parm{PARITY});
    $PortObj->databits($Parm{DATABITS});
    $PortObj->stopbits($Parm{STOPBITS});
    $PortObj->read_interval(0xffffffff);
    $PortObj{TIMEOUT} = $Parm{TIMEOUT};
    $PortObj{CRTERMINATE} = $Parm{CRTERMINATE};
    $PortObj{TRANSLATECR} = $Parm{TRANSLATECR};

    $PortObj->write_settings || Death Translate("<Can't change the settings for port> $Parm{PORT}: $^E\n");

    return $PortObj;
    }

sub EvilPortOpen
    {
    $EvilPortObj = PortOpen(@_);
    }

sub SupplyPortOpen
    {
    $SupplyPortObj = PortOpen(@_);
    }

# $ErrorMessage is string or {SUB => \&sub, PARMS => [parms]}  calls sub($error, @parms) and returns undef
sub PortClose
    {
    my ($PortObj, $ErrorMessage) = @_;
    undef $_[0];

    if (!$PortObj->close)
        {
        if (ref($ErrorMessage) eq 'HASH')
            {
            my %openfail = %{$ErrorMessage};
            &{$openfail{SUB}}($^E, @{$openfail{PARMS}});
            }
        else
            {
            warn $ErrorMessage;
            }
        return undef;
        }
    return 1;
    }

sub PortRead
    {
    my ($PortObj, $Count) = @_;

    return $PortObj->read($Count);
    }

sub PortWrite
    {
    my ($PortObj, $String) = @_;

    return $PortObj->write($String);
    }

# Get all input from a port until the inter-character timeout happens
sub GetPortInput
    {
    $PortInput = '';

    use constant ONEMS      => 1;   # One millisecond for Sleep

    my $PortObj = $_[0];
    my $msTimeOut = 0;

    # Keep reading until the inter-character timeout is exhausted
    while ($msTimeOut < $PortObj{TIMEOUT})
        {

        # Test the port to see if anything was received
        my ($Count, $String) = PortRead($PortObj, 1);

        # If something was received, save it
        if ($Count)
            {
            $PortInput .= $String;
            $msTimeOut = 0;

            if ($PortObj{CRTERMINATE} && $PortInput =~ /[\r\n]{2,}/oim)
                {
                $PortInput =~ s/[\r\n]{2,}/ \\ /goim;
                $PortInput =~ s/\s+\\\s+$//;
                return $PortInput;
                }
            }
        else
            {
            # Nothing was received. Sleep and bump the timeout elapsed.
            Win32::Sleep(ONEMS);
            ++$msTimeOut;
            }
        }

    $PortInput =~ s/[\r\n]+/ \\ /goim if $PortObj{TRANSLATECR};
    $PortInput =~ s/\s+\\\s+$//;
    return $PortInput;
    }

# Success
1;
