package Device::Gainer;
use warnings;
use strict;
use IO::Socket::INET ();
use Time::HiRes ();
use base qw( Class::Accessor::Fast );
__PACKAGE__->mk_accessors(qw( on_pressed on_released ));

my $DEBUG   = 1;
my $WAIT    = 0.1;
my $PORT    = '2000';
my $TIMEOUT = 10;
my $PROTO   = 'tcp';
my $MODE    = 1;

sub new {
    my $package = shift;
    my $self = { @_ };
    bless $self, $package;
    my $host = $self->{host} or Carp::croak "host is not defined\n";
    my $port = $self->{port} || $PORT;
    my $tout = exists $self->{timeout} ? $self->{timeout} : $TIMEOUT;
    my $sock = IO::Socket::INET->new(
        PeerAddr    =>  $host,
        PeerPort    =>  $port,
        Proto       =>  $PROTO,
        Timeout     =>  $tout,
    );
#   $sock->autoflush();
    $self->{sock} = $sock;
    $self->initialize();
    $self;
}

sub turn_on_led {
    my $self = shift;
    $self->command('h*');
}

sub turn_off_led {
    my $self = shift;
    $self->command('l*');
}

sub digital_output {
    my $self = shift;
    my $data = shift;
    $data = [ $data, @_ ] if ( ! ref $data && $#_ == 2 );
    $data = sprintf( "%X" x 4, @$data ) if ref $data;
    my $mess = sprintf( 'D%s*', $data );
    $self->command($mess);
}

sub set_high {
    my $self = shift;
    my $ch   = shift;
    my $mess = sprintf( 'H%X*', $ch );
    $self->command($mess);
}

sub set_low {
    my $self = shift;
    my $ch   = shift;
    my $mess = sprintf( 'L%X*', $ch );
    $self->command($mess);
}

sub peek_digital_input {
    my $self  = shift;
    my $ch    = shift;
    $self->send('R*');
    my $ret  = $self->recv();
    my $head = lc(substr( $ret, 0, 1 ));
    Carp::croak "Device::Gainer: $ret (peek_digital_input)\n" if ( $head ne 'r' );
    my $digch = 4;
    my $list = [ reverse ((split( //, $ret))[1..$digch]) ];
    print join "-", @$list, "\n";
    return $list->[$ch] if defined $ch;
    $list;
}

sub analog_output {
    my $self  = shift;
    my $ch    = shift;
    my $value = shift || 0;
    return unless defined $ch;
    $value = 0   if ( $value < 0 );
    $value = 255 if ( $value > 255 );
    my $mess = sprintf( 'a%X%02X*', $ch, $value );
    $self->command( $mess );
}

sub peek_analog_input {
    my $self  = shift;
    my $ch    = shift;
    $self->send('I*');
    my $ret  = $self->recv();
    my $head = lc(substr( $ret, 0, 1 ));
    Carp::croak "Device::Gainer: $ret (peek_analog_input)\n" if ( $head ne 'i' );
    if ( defined $ch ) {
        my $pos = 2*$ch+1;
        my $hex = substr( $ret, $pos, 2 );
        my $value = hex($hex);
        print "ch=$ch pos=$pos hex=$hex val=$value\n";
        return $value;
    }
    my $anach = 4;
    my $list = [];
    for( my $i=0; $i<$anach; $i++ ) {
        my $pos = 2*$i+1;
        my $hex = substr( $ret, $pos, 2 );
        my $value = hex($hex);
        print "ch=$i pos=$pos hex=$hex val=$value\n";
        $list->[$i] = $value;
    }
    $list;
}

sub initialize {
    my $self = shift;
    $self->reboot();
    my $verv = $self->{verbose} || 1;
    $self->set_verbose( $verv );
    my $mode = $self->{mode} || $MODE;
    $self->configuration( $mode );
}

sub configuration {
    my $self = shift;
    my $mode = shift;
    my $mess = sprintf( "KONFIGURATION_%d*", $mode );
    $self->command($mess);
}

sub reboot {
    my $self = shift;
    $self->command('Q*');
}

sub set_verbose {
    my $self = shift;
    my $verv = shift;
    my $mess = sprintf( "V%d*", $verv );
    $self->command($mess);
}

sub command {
    my $self = shift;
    my $mess = shift;
    $self->send($mess);
    $self->wait();
    $self->recv($mess);
}

sub send {
    my $self = shift;
    my $str  = shift;
    my $sock = $self->{sock};
    $DEBUG and print STDERR "SEND: $str\n";
    $sock->print( $str, "\0" );
}

sub wait {
    my $self = shift;
    my $wait = shift || $WAIT;
    Time::HiRes::sleep( $wait ) if $wait;
}

sub recv {
    my $self = shift;
    my $expect = shift;
    my $sock = $self->{sock};
    my $temp = [];
    while ( 1 ) {
        my $chr = $sock->getc();
        last unless ord( $chr );
        push( @$temp, $chr );
    }
    my $ret = join( "", @$temp );
    $DEBUG and print STDERR "RECV: $ret\n";
    if ( $temp->[0] eq 'N' ) {
        my $sub = $self->{on_pressed};
        &$sub( $self ) if ( ref $sub );
        return $self->recv( $expect );
    }
    if ( $temp->[0] eq 'F' ) {
        my $sub = $self->{on_released};
        &$sub( $self ) if ( ref $sub );
        return $self->recv( $expect );
    }
    if ( defined $expect && $ret ne $expect ) {
        Carp::carp "Device::Gainer: $ret ($expect)\n";
    }
    $ret;

}


=head1 NAME

Device::Gainer - The great new Device::Gainer!

=head1 VERSION

Version 0.01

=cut

our $VERSION = '0.01';


=head1 SYNOPSIS

Quick summary of what the module does.

Perhaps a little code snippet.

    use Device::Gainer;

    my $foo = Device::Gainer->new();
    ...

=head1 EXPORT

A list of functions that can be exported.  You can delete this section
if you don't export anything, such as for a purely object-oriented module.

=head1 FUNCTIONS

=head2 function1

=cut

sub function1 {
}

=head2 function2

=cut

sub function2 {
}

=head1 AUTHOR

Yusuke Kawasaki, C<< <u-suke [at] kawa.net> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-io-gainer at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=IO-Gainer>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.




=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Device::Gainer


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=IO-Gainer>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/IO-Gainer>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/IO-Gainer>

=item * Search CPAN

L<http://search.cpan.org/dist/IO-Gainer>

=back


=head1 ACKNOWLEDGEMENTS


=head1 COPYRIGHT & LICENSE

Copyright 2008 Yusuke Kawasaki, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.


=cut

1; # End of Device::Gainer