#!/usr/bin/perl
use Device::USB ;

my $timeout = 500 ;
my $buffer = "\0" x 512 ;
my $usb = Device::USB -> new() ;
my $dev = $usb -> find_device ( 0x04a9 , 0x2224 ) ;
$dev -> open() ;
print 'libusb:xxx:' , $dev -> filename() , "\n" ;

@data = control_msg ( $dev , '80 06 00 01 00 00 12 00' ) ;
#printhex ( @data ) ;

canon_set ( '02' , '01' ) ;
canon_set ( '02' , '00' ) ;
canon_set ( '01' , '00' ) ;
canon_set ( '01' , '28' ) ;
canon_set ( 'a0' , '04' ) ;
canon_set ( 'a0' , '05' ) ;
canon_set ( '01' , '28' ) ;
canon_set ( '04' , '0c' ) ;
canon_set ( '05' , '00' ) ;
canon_set ( '06' , '00' ) ;
canon_set ( '90' , '27' ) ;
canon_set ( '92' , 'f7' ) ;
canon_set ( '94' , 'f7' ) ;

$reg = shift ( @ARGV ) ;

while ( 1 )
{
  my $data = '01 ' . $reg . ' 01 00' ;
  my $cnt = $dev -> bulk_write ( hex('02') , hex2bin($data) , $timeout ) ;

  if ( $cnt < 0 )
  {
    error ( 'BULK > 0x02 returned error code ' . $cnt ) ;
  }

  my $data = '00 ' x 512 ;
  my $cnt = $dev -> bulk_write ( hex('03') , hex2bin($data) , $timeout ) ;

  if ( $cnt != -2 )
  {
    error ( 'BULK > 0x03 returned error code ' . $cnt ) ;
  }

  my $data = ' ' ;
  my $cnt = $dev -> bulk_read ( hex('83') , $data , 1 , $timeout ) ;

  if ( $cnt < 0 )
  {
    error ( 'BULK < 0x83 returned error code ' . $cnt ) ;
  }

  $data = bin2hex ( $data ) ;
  print $data , "\t" , sprintf('%08b',hex($data)) , "\n" ;
  select ( undef , undef , undef , 0.1 ) ;
}

1 ;

sub canon_set
{
  my ( $reg , $val ) = @_ ;
  my $data = '00 ' . $reg . ' 01 00 ' . $val ;
  my $cnt = $dev -> bulk_write ( hex('02') , hex2bin($data) , $timeout ) ;
  return ( $cnt ) ;
}

sub bin2dez
{
  my ( $data ) = @_ ;
  my @data = unpack ( 'C*' , $data ) ;
  return ( @data )
}

sub dez2bin
{
  my ( @data ) = @_ ;
  my $data = pack ( 'C*' , @data ) ;
  return ( $data )
}

sub hex2dez
{
  my ( $txt ) = @_ ;
  $txt =~ s![\da-f]+:!!ig ;
  $txt =~ s!\A\s+!! ;
  $txt =~ s!\s+\Z!! ;
  my @data = split ( m!\s+! , $txt ) ;

  foreach ( @data )
  {
    $_ = hex ( $_ ) ;
  }

  return ( @data ) ;
}

sub dez2hex
{
  my ( @line ) = @_ ;
  my $anz = @line ;
  my $line = sprintf ( '%02x ' x $anz , @line ) ;
  return ( $line ) ;
}

sub bin2hex
{
  my ( $data ) = @_ ;
  my @data = bin2dez ( $data ) ;
  my $txt = dez2hex ( @data ) ;
  return ( $txt ) ;
}

sub hex2bin
{
  my ( $txt ) = @_ ;
  my @data = hex2dez ( $txt ) ;
  my $data = dez2bin ( @data ) ;
  return ( $data ) ;
}

sub control_msg
{
  my ( $dev , $txt ) = @_ ;
  my ( $typ , $req , $Lv , $Hv , $Li , $Hi , $Ls , $Hs ) = hex2dez ( $txt ) ;
  my $value = $Hv*256 + $Lv ;
  my $index = $Hi*256 + $Li ;
  my $size = $Hs*256 + $Ls ;
  my $buffer = "\0" x $size ;
  my $retval = $dev -> control_msg ( $typ , $req , $value , $index , $buffer , $size , $timeout ) ;
  my @buffer = bin2dez ( $buffer ) ;
  return ( @buffer ) ;
}

sub printhex
{
  my ( @data ) = @_ ;

  while ( @data )
  {
    my @line = splice ( @data , 0 , 16 ) ;
    my $line = dez2hex ( @line ) ;
    print $line , "\n" ;
  }
}

sub display
{
  my ( $dev , $key , $val , $txt ) = @_ ;
  my $pad = ' ' x 22 ;
  $key = substr ( $key . $pad , 0 , 22 ) ;

  if ( $txt == 1 )
  {
    $txt = $dev -> get_string_simple ( $val ) ;
  }

  if ( $txt )
  {
    $txt = ' (' . $txt . ')' ;
  }

  print ( $key , $val , $txt , "\n" ) ;
}

sub error
{
  my ( @msg ) = @_ ;
  $msg[0] .= ' !' ;
  print 'ERROR: ' , join ( "\n" , @msg ) , "\n" ;
  exit ;
}