341 lines
11 KiB
Perl
341 lines
11 KiB
Perl
package Exd::DeviceToCatPrinter;
|
|
|
|
use v5.40.0;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use utf8;
|
|
|
|
use Moo;
|
|
|
|
use Data::Dumper;
|
|
use Net::DBus;
|
|
use Net::DBus::Reactor;
|
|
use Net::DBus::Callback;
|
|
|
|
use Time::HiRes qw/usleep/;
|
|
|
|
has tx => ( is => 'ro', required => 1 );
|
|
has rx => ( is => 'ro', required => 1 );
|
|
has current_image => ( is => 'rw', );
|
|
has _device => ( is => 'lazy' );
|
|
has _tx_gatt => ( is => 'lazy' );
|
|
has _rx_gatt => ( is => 'lazy' );
|
|
has _properties => ( is => 'lazy' );
|
|
has _adapter => ( is => 'lazy' );
|
|
has _remaining_height => ( is => 'rw' );
|
|
has _y => ( is => 'rw' );
|
|
has _signal => ( is => 'rw' );
|
|
has _reactor => ( is => 'rw' );
|
|
has _pause => ( is => 'rw', default => sub { 0 } );
|
|
|
|
sub image( $self, $image ) {
|
|
my $current_image = $self->current_image;
|
|
|
|
if ( !defined $current_image ) {
|
|
$self->current_image($image);
|
|
return;
|
|
}
|
|
|
|
my $new_current = GD::Image->new( $current_image->width,
|
|
$current_image->height + $image->height );
|
|
|
|
$new_current->copy( $current_image, 0, 0, 0, 0,
|
|
$current_image->width, $current_image->height );
|
|
$new_current->copy( $image, 0, $current_image->height, 0, 0,
|
|
$image->width, $image->height );
|
|
$self->current_image($new_current);
|
|
}
|
|
|
|
sub serialize($self) {
|
|
my $hash = {};
|
|
$hash->{tx} = $self->tx;
|
|
$hash->{rx} = $self->rx;
|
|
$hash->{type} = 'cat-printer';
|
|
return $hash;
|
|
}
|
|
|
|
sub _build__device($self) {
|
|
my $session = Net::DBus->system;
|
|
my $service = $session->get_service('org.bluez');
|
|
my $device_path = $self->tx =~ s{/service.*$}{}r;
|
|
return $service->get_object( $device_path, 'org.bluez.Device1' );
|
|
}
|
|
|
|
sub _build__adapter($self) {
|
|
my $session = Net::DBus->system;
|
|
my $service = $session->get_service('org.bluez');
|
|
my $device_path = $self->tx =~ s{/dev.*$}{}r;
|
|
return $service->get_object( $device_path, 'org.bluez.Adapter1' );
|
|
}
|
|
|
|
sub _build__rx_gatt($self) {
|
|
my $session = Net::DBus->system;
|
|
my $service = $session->get_service('org.bluez');
|
|
return $service->get_object( $self->rx, 'org.bluez.GattCharacteristic1' );
|
|
}
|
|
|
|
sub _build__tx_gatt($self) {
|
|
my $session = Net::DBus->system;
|
|
my $service = $session->get_service('org.bluez');
|
|
return $service->get_object( $self->tx, 'org.bluez.GattCharacteristic1' );
|
|
}
|
|
|
|
sub _build__properties($self) {
|
|
my $session = Net::DBus->system;
|
|
my $service = $session->get_service('org.bluez');
|
|
return $service->get_object( $self->rx, 'org.freedesktop.DBus.Properties' );
|
|
}
|
|
|
|
sub connect_if_disconnected($self) {
|
|
if ( !$self->_device->Connected ) {
|
|
say 'Disconnected, trying to connect';
|
|
eval {
|
|
$self->_adapter->StartDiscovery;
|
|
$self->_device->Pair;
|
|
eval { $self->_device->Connect; };
|
|
};
|
|
if ($@) {
|
|
warn $@;
|
|
}
|
|
}
|
|
}
|
|
|
|
sub print($self) {
|
|
my $image = $self->current_image;
|
|
$self->_device->get_service->get_bus->timeout(1000);
|
|
sleep 1 if !$self->_device->Connected;
|
|
my $reactor = Net::DBus::Reactor->main;
|
|
$self->_reactor($reactor);
|
|
$self->_rx_gatt->StartNotify;
|
|
say $self->rx;
|
|
$self->_signal(
|
|
$self->_properties->connect_to_signal(
|
|
'PropertiesChanged',
|
|
sub {
|
|
my $hash = $_[1];
|
|
my $value = $hash->{Value};
|
|
say unpack 'H*', $self->_bytestring(@$value);
|
|
if (
|
|
'5178ae0101000000ff' eq unpack 'H*',
|
|
$self->_bytestring(@$value)
|
|
)
|
|
{
|
|
$self->_pause(0);
|
|
}
|
|
if (
|
|
'5178ae0101001070ff' eq unpack 'H*',
|
|
$self->_bytestring(@$value)
|
|
)
|
|
{
|
|
$self->_pause(1);
|
|
}
|
|
if ( '5178a3010300000e280eff' eq unpack 'H*',
|
|
$self->_bytestring(@$value) )
|
|
{
|
|
usleep 100_000;
|
|
}
|
|
}
|
|
)
|
|
);
|
|
my $buffer = '';
|
|
my $y = 0;
|
|
$self->_y($y);
|
|
my $remaining_height = $image->height;
|
|
my $mtu = 200;
|
|
while ( $remaining_height > 0 ) {
|
|
my $height = $remaining_height > 500 ? 500 : $remaining_height;
|
|
$remaining_height -= $height;
|
|
$self->_remaining_height($remaining_height);
|
|
|
|
my $print_image = GD::Image->new( $image->width, $height );
|
|
$print_image->copy( $image, 0, 0, 0, $y, $image->width, $height );
|
|
$y += $height;
|
|
$self->_y($y);
|
|
|
|
my $tempdir = Path::Tiny->tempdir;
|
|
my $in = $tempdir->child('in.png');
|
|
my $out = $tempdir->child('out.bmp');
|
|
$print_image->_file( '' . $in );
|
|
die 'Couldn\'t invert image'
|
|
if system qw/magick/, $in, qw/-flop -rotate 180 -negate -monochrome/,
|
|
$out;
|
|
open my $fh, '<', $out;
|
|
$buffer .=
|
|
$self->_bytestring( 0x51, 0x78, 0xa3, 0x00, 0x01, 0x00, 0x00, 0x00,
|
|
0xff );
|
|
$buffer .= $self->_make_command( 0xa4, $self->_bytestring(50) );
|
|
$buffer .= $self->_make_command( 0xbd, $self->_bytestring(10) );
|
|
$buffer .=
|
|
$self->_make_command( 0xaf, $self->_bytestring( 0x00, 0x99 ) );
|
|
$buffer .= $self->_make_command( 0xbe, $self->_bytestring(0x01) );
|
|
$buffer .= $self->_make_command( 0xa9, $self->_bytestring(0x00) );
|
|
$buffer .= $self->_make_command(
|
|
0xa6,
|
|
$self->_bytestring(
|
|
0xaa, 0x55, 0x17, 0x38, 0x44, 0x5f,
|
|
0x5f, 0x5f, 0x44, 0x38, 0x2c
|
|
)
|
|
);
|
|
|
|
# $buffer .= $self->_make_command( 0xa0, $self->_bytestring( 255, 0x00 ) );
|
|
|
|
seek $fh, 0xa, 0;
|
|
read $fh, my $offset, 4;
|
|
$offset = unpack 'V', $offset;
|
|
seek( $fh, $offset, 0 );
|
|
while ( 0 != read $fh, my $read, int( 384 / 8 ) ) {
|
|
$read =
|
|
$self->_bytestring( map { $self->_reverse_byte( unpack 'C', $_ ) }
|
|
split '', $read );
|
|
$buffer .= $self->_make_command( 0xa2, $read );
|
|
}
|
|
$buffer .= $self->_bytestring(
|
|
0xaa, 0x55, 0x17, 0x00, 0x00, 0x00,
|
|
0x00, 0x00, 0x00, 0x00, 0x17
|
|
);
|
|
}
|
|
$self->_flush( \$buffer, $mtu );
|
|
$self->_reactor->run;
|
|
$self->_rx_gatt->StopNotify;
|
|
|
|
}
|
|
|
|
sub _reverse_byte( $self, $i ) {
|
|
$i = ( ( $i & 0b10101010 ) >> 1 ) | ( ( $i & 0b01010101 ) << 1 );
|
|
$i = ( ( $i & 0b11001100 ) >> 2 ) | ( ( $i & 0b00110011 ) << 2 );
|
|
return ( ( $i & 0b11110000 ) >> 4 ) | ( ( $i & 0b00001111 ) << 4 );
|
|
}
|
|
|
|
sub _bytestring( $self, @array ) {
|
|
return join '', pack 'C*', @array;
|
|
}
|
|
{
|
|
my $crc8_table = [
|
|
0x00, 0x07, 0x0e, 0x09, 0x1c, 0x1b, 0x12, 0x15, 0x38, 0x3f,
|
|
0x36, 0x31, 0x24, 0x23, 0x2a, 0x2d, 0x70, 0x77, 0x7e, 0x79,
|
|
0x6c, 0x6b, 0x62, 0x65, 0x48, 0x4f, 0x46, 0x41, 0x54, 0x53,
|
|
0x5a, 0x5d, 0xe0, 0xe7, 0xee, 0xe9, 0xfc, 0xfb, 0xf2, 0xf5,
|
|
0xd8, 0xdf, 0xd6, 0xd1, 0xc4, 0xc3, 0xca, 0xcd, 0x90, 0x97,
|
|
0x9e, 0x99, 0x8c, 0x8b, 0x82, 0x85, 0xa8, 0xaf, 0xa6, 0xa1,
|
|
0xb4, 0xb3, 0xba, 0xbd, 0xc7, 0xc0, 0xc9, 0xce, 0xdb, 0xdc,
|
|
0xd5, 0xd2, 0xff, 0xf8, 0xf1, 0xf6, 0xe3, 0xe4, 0xed, 0xea,
|
|
0xb7, 0xb0, 0xb9, 0xbe, 0xab, 0xac, 0xa5, 0xa2, 0x8f, 0x88,
|
|
0x81, 0x86, 0x93, 0x94, 0x9d, 0x9a, 0x27, 0x20, 0x29, 0x2e,
|
|
0x3b, 0x3c, 0x35, 0x32, 0x1f, 0x18, 0x11, 0x16, 0x03, 0x04,
|
|
0x0d, 0x0a, 0x57, 0x50, 0x59, 0x5e, 0x4b, 0x4c, 0x45, 0x42,
|
|
0x6f, 0x68, 0x61, 0x66, 0x73, 0x74, 0x7d, 0x7a, 0x89, 0x8e,
|
|
0x87, 0x80, 0x95, 0x92, 0x9b, 0x9c, 0xb1, 0xb6, 0xbf, 0xb8,
|
|
0xad, 0xaa, 0xa3, 0xa4, 0xf9, 0xfe, 0xf7, 0xf0, 0xe5, 0xe2,
|
|
0xeb, 0xec, 0xc1, 0xc6, 0xcf, 0xc8, 0xdd, 0xda, 0xd3, 0xd4,
|
|
0x69, 0x6e, 0x67, 0x60, 0x75, 0x72, 0x7b, 0x7c, 0x51, 0x56,
|
|
0x5f, 0x58, 0x4d, 0x4a, 0x43, 0x44, 0x19, 0x1e, 0x17, 0x10,
|
|
0x05, 0x02, 0x0b, 0x0c, 0x21, 0x26, 0x2f, 0x28, 0x3d, 0x3a,
|
|
0x33, 0x34, 0x4e, 0x49, 0x40, 0x47, 0x52, 0x55, 0x5c, 0x5b,
|
|
0x76, 0x71, 0x78, 0x7f, 0x6a, 0x6d, 0x64, 0x63, 0x3e, 0x39,
|
|
0x30, 0x37, 0x22, 0x25, 0x2c, 0x2b, 0x06, 0x01, 0x08, 0x0f,
|
|
0x1a, 0x1d, 0x14, 0x13, 0xae, 0xa9, 0xa0, 0xa7, 0xb2, 0xb5,
|
|
0xbc, 0xbb, 0x96, 0x91, 0x98, 0x9f, 0x8a, 0x8d, 0x84, 0x83,
|
|
0xde, 0xd9, 0xd0, 0xd7, 0xc2, 0xc5, 0xcc, 0xcb, 0xe6, 0xe1,
|
|
0xe8, 0xef, 0xfa, 0xfd, 0xf4, 0xf3
|
|
];
|
|
|
|
sub _crc8( $self, $data ) {
|
|
my $crc = 0;
|
|
$data = [ split '', $data ];
|
|
$data = [ map { unpack 'C', $_ } @$data ];
|
|
for my $byte (@$data) {
|
|
$crc = $crc8_table->[ ( $crc ^ $byte ) & 0xff ];
|
|
}
|
|
return $crc & 0xff;
|
|
}
|
|
}
|
|
|
|
sub _flush( $self, $buffer, $mtu ) {
|
|
my $inner_timeout = undef;
|
|
my $timeout = \$inner_timeout;
|
|
my $callback;
|
|
my $i = 0;
|
|
$callback = sub {
|
|
$i++;
|
|
say "$i start";
|
|
if ( !( 0 < length $$buffer ) ) {
|
|
say 'No more data to flush';
|
|
$self->_reactor->shutdown;
|
|
return;
|
|
}
|
|
if ( $self->_pause ) {
|
|
return;
|
|
}
|
|
my $take_length = length $$buffer > $mtu ? $mtu : length $$buffer;
|
|
$self->_send_command( substr $$buffer, 0, $take_length );
|
|
$$buffer = substr $$buffer, $take_length;
|
|
say "$i end";
|
|
return 1;
|
|
};
|
|
$self->_reactor->add_timeout(
|
|
100,
|
|
Net::DBus::Callback->new(
|
|
method => sub {
|
|
$callback->();
|
|
}
|
|
),
|
|
1
|
|
);
|
|
}
|
|
|
|
sub _needs_to_pause($self) {
|
|
|
|
# if (
|
|
# $self->_bytestring(
|
|
# $self->_properties->Get( 'org.bluez.GattCharacteristic1', 'Value' )
|
|
# ->@*
|
|
# ) eq pack 'H*',
|
|
# '5178a3010300000e280eff'
|
|
# )
|
|
# {
|
|
# return 1;
|
|
# }
|
|
return 0;
|
|
}
|
|
|
|
sub _send_command( $self, $data ) {
|
|
my $error = 1;
|
|
my $i = 0;
|
|
while ($error) {
|
|
die 'Unable to connect' if $i++ == 50;
|
|
eval {
|
|
$self->connect_if_disconnected;
|
|
my $gatt = $self->_tx_gatt;
|
|
$data = [ map { unpack 'C', $_ } split '', $data ];
|
|
$data = [ map { Net::DBus::dbus_byte($_) } @$data ];
|
|
$gatt->WriteValue(
|
|
Net::DBus::dbus_array($data),
|
|
{ type => Net::DBus::dbus_string('command') },
|
|
);
|
|
$error = 0;
|
|
};
|
|
if ($@) {
|
|
warn $@;
|
|
}
|
|
usleep 100_000 if $error;
|
|
}
|
|
}
|
|
|
|
sub _make_command( $self, $command_bit, $payload, $prefix = '', $suffix = '' ) {
|
|
my $size = length $payload;
|
|
if ( $size > 0xff ) {
|
|
die 'Command too long';
|
|
}
|
|
if ( $command_bit > 0xff ) {
|
|
die 'Command bit out of range';
|
|
}
|
|
return
|
|
$prefix
|
|
. $self->_bytestring( 0x51, 0x78, $command_bit, 0x00, $size, 0x00 )
|
|
. $payload
|
|
. $self->_bytestring( $self->_crc8($payload), 0xff )
|
|
. $suffix;
|
|
}
|
|
1;
|