From 5c8903909a24f65378b12252091828d7ecf2c3e2 Mon Sep 17 00:00:00 2001 From: sergiotarxz Date: Sat, 2 Nov 2024 18:54:33 +0100 Subject: [PATCH] Fixing cat printers for long outputs. --- deps | 2 +- generated-sources.json | 188 ++++++++++++----------- lib/Exd/DeviceToCatPrinter.pm | 255 ++++++++++++++++++++++++-------- lib/Exd/DeviceToRawFile.pm | 2 +- lib/Exd/FileFormat.pm | 2 - lib/Exd/Gui/Instance.pm | 14 +- lib/Exd/Gui/PrinterConfigure.pm | 44 +++--- lib/Exd/Printer.pm | 2 +- me.sergiotarxz.Exd.yml | 2 +- 9 files changed, 332 insertions(+), 179 deletions(-) diff --git a/deps b/deps index 484b2b9..234f44a 100644 --- a/deps +++ b/deps @@ -1 +1 @@ -Moo IO::File Glib Glib::IO Glib::Object::Introspection JSON DBI DBD::SQLite Path::Tiny Net::Bluetooth Inline Inline::C Mojolicious Pango Device::SerialPort Archive::Zip GD::Image Net::DBus UUID::URandom Capture::Tiny Class::Load aliased Carp::Always IO::Socket::SSL +Moo IO::File Glib Glib::IO Glib::Object::Introspection JSON DBI DBD::SQLite Path::Tiny Net::Bluetooth Inline Inline::C Mojolicious Pango Device::SerialPort Archive::Zip GD::Image Net::DBus UUID::URandom Capture::Tiny Class::Load aliased Carp::Always IO::Socket::SSL Scalar::Util::Numeric GD::Barcode::QRcode diff --git a/generated-sources.json b/generated-sources.json index eea0c78..1571372 100644 --- a/generated-sources.json +++ b/generated-sources.json @@ -1,10 +1,4 @@ [ - { - "dest": "perl-libs/Sub-Quote", - "sha256": "94bebd500af55762e83ea2f2bc594d87af828072370c7110c60c238a800d15b2", - "type": "archive", - "url": "https://cpan.metacpan.org/authors/id/H/HA/HAARG/Sub-Quote-2.006008.tar.gz" - }, { "dest": "perl-libs/Role-Tiny", "sha256": "d7bdee9e138a4f83aa52d0a981625644bda87ff16642dfa845dcb44d9a242b45", @@ -17,6 +11,12 @@ "type": "archive", "url": "https://cpan.metacpan.org/authors/id/E/ET/ETHER/Class-Method-Modifiers-2.15.tar.gz" }, + { + "dest": "perl-libs/Sub-Quote", + "sha256": "94bebd500af55762e83ea2f2bc594d87af828072370c7110c60c238a800d15b2", + "type": "archive", + "url": "https://cpan.metacpan.org/authors/id/H/HA/HAARG/Sub-Quote-2.006008.tar.gz" + }, { "dest": "perl-libs/Moo", "sha256": "fb5a2952649faed07373f220b78004a9c6aba387739133740c1770e9b1f4b108", @@ -168,34 +168,16 @@ "url": "https://cpan.metacpan.org/authors/id/R/RU/RURBAN/GD-2.83.tar.gz" }, { - "dest": "perl-libs/LWP-MediaTypes", - "sha256": "8f1bca12dab16a1c2a7c03a49c5e58cce41a6fec9519f0aadfba8dad997919d9", + "dest": "perl-libs/Test-Pod", + "sha256": "60a8dbcc60168bf1daa5cc2350236df9343e9878f4ab9830970a5dde6fe8e5fc", "type": "archive", - "url": "https://cpan.metacpan.org/authors/id/O/OA/OALDERS/LWP-MediaTypes-6.04.tar.gz" + "url": "https://cpan.metacpan.org/authors/id/E/ET/ETHER/Test-Pod-1.52.tar.gz" }, { - "dest": "perl-libs/TimeDate", - "sha256": "c0b69c4b039de6f501b0d9f13ec58c86b040c1f7e9b27ef249651c143d605eb2", + "dest": "perl-libs/Try-Tiny", + "sha256": "ef2d6cab0bad18e3ab1c4e6125cc5f695c7e459899f512451c8fa3ef83fa7fc0", "type": "archive", - "url": "https://cpan.metacpan.org/authors/id/A/AT/ATOOMIC/TimeDate-2.33.tar.gz" - }, - { - "dest": "perl-libs/HTTP-Date", - "sha256": "7b685191c6acc3e773d1fc02c95ee1f9fae94f77783175f5e78c181cc92d2b52", - "type": "archive", - "url": "https://cpan.metacpan.org/authors/id/O/OA/OALDERS/HTTP-Date-6.06.tar.gz" - }, - { - "dest": "perl-libs/File-Listing", - "sha256": "189b3a13fc0a1ba412b9d9ec5901e9e5e444cc746b9f0156d4399370d33655c6", - "type": "archive", - "url": "https://cpan.metacpan.org/authors/id/P/PL/PLICEASE/File-Listing-6.16.tar.gz" - }, - { - "dest": "perl-libs/Clone", - "sha256": "4c2c0cb9a483efbf970cb1a75b2ca75b0e18cb84bcb5c09624f86e26b09c211d", - "type": "archive", - "url": "https://cpan.metacpan.org/authors/id/A/AT/ATOOMIC/Clone-0.47.tar.gz" + "url": "https://cpan.metacpan.org/authors/id/E/ET/ETHER/Try-Tiny-0.32.tar.gz" }, { "dest": "perl-libs/Encode-Locale", @@ -203,6 +185,12 @@ "type": "archive", "url": "https://cpan.metacpan.org/authors/id/G/GA/GAAS/Encode-Locale-1.05.tar.gz" }, + { + "dest": "perl-libs/Clone", + "sha256": "4c2c0cb9a483efbf970cb1a75b2ca75b0e18cb84bcb5c09624f86e26b09c211d", + "type": "archive", + "url": "https://cpan.metacpan.org/authors/id/A/AT/ATOOMIC/Clone-0.47.tar.gz" + }, { "dest": "perl-libs/MIME-Base32", "sha256": "ab21fa99130e33a0aff6cdb596f647e5e565d207d634ba2ef06bdbef50424e99", @@ -215,6 +203,24 @@ "type": "archive", "url": "https://cpan.metacpan.org/authors/id/O/OA/OALDERS/URI-5.29.tar.gz" }, + { + "dest": "perl-libs/TimeDate", + "sha256": "c0b69c4b039de6f501b0d9f13ec58c86b040c1f7e9b27ef249651c143d605eb2", + "type": "archive", + "url": "https://cpan.metacpan.org/authors/id/A/AT/ATOOMIC/TimeDate-2.33.tar.gz" + }, + { + "dest": "perl-libs/HTTP-Date", + "sha256": "7b685191c6acc3e773d1fc02c95ee1f9fae94f77783175f5e78c181cc92d2b52", + "type": "archive", + "url": "https://cpan.metacpan.org/authors/id/O/OA/OALDERS/HTTP-Date-6.06.tar.gz" + }, + { + "dest": "perl-libs/LWP-MediaTypes", + "sha256": "8f1bca12dab16a1c2a7c03a49c5e58cce41a6fec9519f0aadfba8dad997919d9", + "type": "archive", + "url": "https://cpan.metacpan.org/authors/id/O/OA/OALDERS/LWP-MediaTypes-6.04.tar.gz" + }, { "dest": "perl-libs/IO-HTML", "sha256": "c87b2df59463bbf2c39596773dfb5c03bde0f7e1051af339f963f58c1cbd8bf5", @@ -227,12 +233,6 @@ "type": "archive", "url": "https://cpan.metacpan.org/authors/id/O/OA/OALDERS/HTTP-Message-7.00.tar.gz" }, - { - "dest": "perl-libs/HTTP-Negotiate", - "sha256": "1c729c1ea63100e878405cda7d66f9adfd3ed4f1d6cacaca0ee9152df728e016", - "type": "archive", - "url": "https://cpan.metacpan.org/authors/id/G/GA/GAAS/HTTP-Negotiate-6.01.tar.gz" - }, { "dest": "perl-libs/HTML-Tagset", "sha256": "eb89e145a608ed1f8f141a57472ee5f69e67592a432dcd2e8b1dbb445f2b230b", @@ -246,10 +246,16 @@ "url": "https://cpan.metacpan.org/authors/id/O/OA/OALDERS/HTML-Parser-3.83.tar.gz" }, { - "dest": "perl-libs/WWW-RobotRules", - "sha256": "46b502e7a288d559429891eeb5d979461dd3ecc6a5c491ead85d165b6e03a51e", + "dest": "perl-libs/File-Listing", + "sha256": "189b3a13fc0a1ba412b9d9ec5901e9e5e444cc746b9f0156d4399370d33655c6", "type": "archive", - "url": "https://cpan.metacpan.org/authors/id/G/GA/GAAS/WWW-RobotRules-6.02.tar.gz" + "url": "https://cpan.metacpan.org/authors/id/P/PL/PLICEASE/File-Listing-6.16.tar.gz" + }, + { + "dest": "perl-libs/HTTP-Negotiate", + "sha256": "1c729c1ea63100e878405cda7d66f9adfd3ed4f1d6cacaca0ee9152df728e016", + "type": "archive", + "url": "https://cpan.metacpan.org/authors/id/G/GA/GAAS/HTTP-Negotiate-6.01.tar.gz" }, { "dest": "perl-libs/Net-HTTP", @@ -257,18 +263,18 @@ "type": "archive", "url": "https://cpan.metacpan.org/authors/id/O/OA/OALDERS/Net-HTTP-6.23.tar.gz" }, - { - "dest": "perl-libs/Try-Tiny", - "sha256": "ef2d6cab0bad18e3ab1c4e6125cc5f695c7e459899f512451c8fa3ef83fa7fc0", - "type": "archive", - "url": "https://cpan.metacpan.org/authors/id/E/ET/ETHER/Try-Tiny-0.32.tar.gz" - }, { "dest": "perl-libs/HTTP-Cookies", "sha256": "8c9a541a4a39f6c0c7e3d0b700b05dfdb830bd490a1b1942a7dedd1b50d9a8c8", "type": "archive", "url": "https://cpan.metacpan.org/authors/id/O/OA/OALDERS/HTTP-Cookies-6.11.tar.gz" }, + { + "dest": "perl-libs/WWW-RobotRules", + "sha256": "46b502e7a288d559429891eeb5d979461dd3ecc6a5c491ead85d165b6e03a51e", + "type": "archive", + "url": "https://cpan.metacpan.org/authors/id/G/GA/GAAS/WWW-RobotRules-6.02.tar.gz" + }, { "dest": "perl-libs/libwww-perl", "sha256": "94a907d6b3ea8d966ef43deffd4fa31f5500142b4c00489bfd403860a5f060e4", @@ -288,10 +294,16 @@ "url": "https://cpan.metacpan.org/authors/id/M/MI/MIROD/XML-Twig-3.52.tar.gz" }, { - "dest": "perl-libs/Test-Pod", - "sha256": "60a8dbcc60168bf1daa5cc2350236df9343e9878f4ab9830970a5dde6fe8e5fc", + "dest": "perl-libs/Module-Build", + "sha256": "66aeac6127418be5e471ead3744648c766bd01482825c5b66652675f2bc86a8f", "type": "archive", - "url": "https://cpan.metacpan.org/authors/id/E/ET/ETHER/Test-Pod-1.52.tar.gz" + "url": "https://cpan.metacpan.org/authors/id/L/LE/LEONT/Module-Build-0.4234.tar.gz" + }, + { + "dest": "perl-libs/Module-Runtime", + "sha256": "68302ec646833547d410be28e09676db75006f4aa58a11f3bdb44ffe99f0f024", + "type": "archive", + "url": "https://cpan.metacpan.org/authors/id/Z/ZE/ZEFRAM/Module-Runtime-0.016.tar.gz" }, { "dest": "perl-libs/Exporter-Tiny", @@ -305,18 +317,6 @@ "type": "archive", "url": "https://cpan.metacpan.org/authors/id/T/TO/TOBYINK/Type-Tiny-2.006000.tar.gz" }, - { - "dest": "perl-libs/Module-Build", - "sha256": "66aeac6127418be5e471ead3744648c766bd01482825c5b66652675f2bc86a8f", - "type": "archive", - "url": "https://cpan.metacpan.org/authors/id/L/LE/LEONT/Module-Build-0.4234.tar.gz" - }, - { - "dest": "perl-libs/Module-Runtime", - "sha256": "68302ec646833547d410be28e09676db75006f4aa58a11f3bdb44ffe99f0f024", - "type": "archive", - "url": "https://cpan.metacpan.org/authors/id/Z/ZE/ZEFRAM/Module-Runtime-0.016.tar.gz" - }, { "dest": "perl-libs/CPAN-Changes", "sha256": "c0c9728743e5da7571ef358f6d7e6e54515115c8d6422f436a8d9306964cdd44", @@ -371,18 +371,18 @@ "type": "archive", "url": "https://cpan.metacpan.org/authors/id/D/DA/DAGOLDEN/Capture-Tiny-0.48.tar.gz" }, - { - "dest": "perl-libs/Module-Implementation", - "sha256": "c15f1a12f0c2130c9efff3c2e1afe5887b08ccd033bd132186d1e7d5087fd66d", - "type": "archive", - "url": "https://cpan.metacpan.org/authors/id/D/DR/DROLSKY/Module-Implementation-0.09.tar.gz" - }, { "dest": "perl-libs/Dist-CheckConflicts", "sha256": "ea844b9686c94d666d9d444321d764490b2cde2f985c4165b4c2c77665caedc4", "type": "archive", "url": "https://cpan.metacpan.org/authors/id/D/DO/DOY/Dist-CheckConflicts-0.11.tar.gz" }, + { + "dest": "perl-libs/Module-Implementation", + "sha256": "c15f1a12f0c2130c9efff3c2e1afe5887b08ccd033bd132186d1e7d5087fd66d", + "type": "archive", + "url": "https://cpan.metacpan.org/authors/id/D/DR/DROLSKY/Module-Implementation-0.09.tar.gz" + }, { "dest": "perl-libs/Package-Stash-XS", "sha256": "26bad65c1959c57379b3e139dc776fbec5f702906617ef27cdc293ddf1239231", @@ -419,12 +419,6 @@ "type": "archive", "url": "https://cpan.metacpan.org/authors/id/E/ET/ETHER/Class-Load-0.25.tar.gz" }, - { - "dest": "perl-libs/ExtUtils-Helpers", - "sha256": "c8574875cce073e7dc5345a7b06d502e52044d68894f9160203fcaab379514fe", - "type": "archive", - "url": "https://cpan.metacpan.org/authors/id/L/LE/LEONT/ExtUtils-Helpers-0.028.tar.gz" - }, { "dest": "perl-libs/ExtUtils-Config", "sha256": "82e7e4e90cbe380e152f5de6e3e403746982d502dd30197a123652e46610c66d", @@ -437,6 +431,12 @@ "type": "archive", "url": "https://cpan.metacpan.org/authors/id/L/LE/LEONT/ExtUtils-InstallPaths-0.014.tar.gz" }, + { + "dest": "perl-libs/ExtUtils-Helpers", + "sha256": "c8574875cce073e7dc5345a7b06d502e52044d68894f9160203fcaab379514fe", + "type": "archive", + "url": "https://cpan.metacpan.org/authors/id/L/LE/LEONT/ExtUtils-Helpers-0.028.tar.gz" + }, { "dest": "perl-libs/Module-Build-Tiny", "sha256": "74fdce35e8cd4d787bc2d4fc1d43a291b7bbced4e94dc5fc592bd81ca93a98e9", @@ -467,6 +467,18 @@ "type": "archive", "url": "https://cpan.metacpan.org/authors/id/S/SU/SULLR/IO-Socket-SSL-2.089.tar.gz" }, + { + "dest": "perl-libs/Scalar-Util-Numeric", + "sha256": "d7501b6d410703db5b1c1942fbfc41af8964a35525d7f766058acf5ca2cc4440", + "type": "archive", + "url": "https://cpan.metacpan.org/authors/id/C/CH/CHOCOLATE/Scalar-Util-Numeric-0.40.tar.gz" + }, + { + "dest": "perl-libs/GD-Barcode", + "sha256": "7cabb9a7eef7891145cc333ca70462972418377c23d3ab2a34c6f1aa229796ef", + "type": "archive", + "url": "https://cpan.metacpan.org/authors/id/M/MI/MICHIELB/GD-Barcode-2.00.tar.gz" + }, { "commands": [ "set -e", @@ -482,9 +494,9 @@ " exit 1", " fi", "}", - "(make_install perl-libs/Sub-Quote)", "(make_install perl-libs/Role-Tiny)", "(make_install perl-libs/Class-Method-Modifiers)", + "(make_install perl-libs/Sub-Quote)", "(make_install perl-libs/Moo)", "(make_install perl-libs/ExtUtils-Depends)", "(make_install perl-libs/ExtUtils-PkgConfig)", @@ -510,31 +522,31 @@ "(make_install perl-libs/Archive-Zip)", "(make_install perl-libs/File-Which)", "(make_install perl-libs/GD)", - "(make_install perl-libs/LWP-MediaTypes)", - "(make_install perl-libs/TimeDate)", - "(make_install perl-libs/HTTP-Date)", - "(make_install perl-libs/File-Listing)", - "(make_install perl-libs/Clone)", + "(make_install perl-libs/Test-Pod)", + "(make_install perl-libs/Try-Tiny)", "(make_install perl-libs/Encode-Locale)", + "(make_install perl-libs/Clone)", "(make_install perl-libs/MIME-Base32)", "(make_install perl-libs/URI)", + "(make_install perl-libs/TimeDate)", + "(make_install perl-libs/HTTP-Date)", + "(make_install perl-libs/LWP-MediaTypes)", "(make_install perl-libs/IO-HTML)", "(make_install perl-libs/HTTP-Message)", - "(make_install perl-libs/HTTP-Negotiate)", "(make_install perl-libs/HTML-Tagset)", "(make_install perl-libs/HTML-Parser)", - "(make_install perl-libs/WWW-RobotRules)", + "(make_install perl-libs/File-Listing)", + "(make_install perl-libs/HTTP-Negotiate)", "(make_install perl-libs/Net-HTTP)", - "(make_install perl-libs/Try-Tiny)", "(make_install perl-libs/HTTP-Cookies)", + "(make_install perl-libs/WWW-RobotRules)", "(make_install perl-libs/libwww-perl)", "(make_install perl-libs/XML-Parser)", "(make_install perl-libs/XML-Twig)", - "(make_install perl-libs/Test-Pod)", - "(make_install perl-libs/Exporter-Tiny)", - "(make_install perl-libs/Type-Tiny)", "(make_install perl-libs/Module-Build)", "(make_install perl-libs/Module-Runtime)", + "(make_install perl-libs/Exporter-Tiny)", + "(make_install perl-libs/Type-Tiny)", "(make_install perl-libs/CPAN-Changes)", "(make_install perl-libs/Pod-Parser)", "(make_install perl-libs/Devel-Symdump)", @@ -544,22 +556,24 @@ "(make_install perl-libs/Crypt-URandom)", "(make_install perl-libs/UUID-URandom)", "(make_install perl-libs/Capture-Tiny)", - "(make_install perl-libs/Module-Implementation)", "(make_install perl-libs/Dist-CheckConflicts)", + "(make_install perl-libs/Module-Implementation)", "(make_install perl-libs/Package-Stash-XS)", "(make_install perl-libs/Package-Stash)", "(make_install perl-libs/Params-Util)", "(make_install perl-libs/Sub-Install)", "(make_install perl-libs/Data-OptList)", "(make_install perl-libs/Class-Load)", - "(make_install perl-libs/ExtUtils-Helpers)", "(make_install perl-libs/ExtUtils-Config)", "(make_install perl-libs/ExtUtils-InstallPaths)", + "(make_install perl-libs/ExtUtils-Helpers)", "(make_install perl-libs/Module-Build-Tiny)", "(make_install perl-libs/aliased)", "(make_install perl-libs/Carp-Always)", "(make_install perl-libs/Net-SSLeay)", - "(make_install perl-libs/IO-Socket-SSL)" + "(make_install perl-libs/IO-Socket-SSL)", + "(make_install perl-libs/Scalar-Util-Numeric)", + "(make_install perl-libs/GD-Barcode)" ], "dest": "perl-libs", "dest-filename": "install.sh", diff --git a/lib/Exd/DeviceToCatPrinter.pm b/lib/Exd/DeviceToCatPrinter.pm index b588cbe..6eb8087 100644 --- a/lib/Exd/DeviceToCatPrinter.pm +++ b/lib/Exd/DeviceToCatPrinter.pm @@ -10,11 +10,24 @@ use Moo; use Data::Dumper; use Net::DBus; +use Net::DBus::Reactor; +use Net::DBus::Callback; -has path => ( is => 'ro', required => 1 ); -has current_image => ( is => 'rw', ); -has _gatt => ( is => 'lazy' ); -has _device => ( is => 'lazy' ); +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; @@ -36,7 +49,8 @@ sub image( $self, $image ) { sub serialize($self) { my $hash = {}; - $hash->{path} = $self->path; + $hash->{tx} = $self->tx; + $hash->{rx} = $self->rx; $hash->{type} = 'cat-printer'; return $hash; } @@ -44,77 +58,153 @@ sub serialize($self) { sub _build__device($self) { my $session = Net::DBus->system; my $service = $session->get_service('org.bluez'); - my $device_path = $self->path =~ s{/service.*$}{}r; + my $device_path = $self->tx =~ s{/service.*$}{}r; return $service->get_object( $device_path, 'org.bluez.Device1' ); } -sub _build__gatt($self) { +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->path, 'org.bluez.GattCharacteristic1' ); + 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 try_to_connect($self) { - my $device_api = $self->_device; - return if $device_api->Connected; - $device_api->Connect; - - for (my $i = 0; $i < 3; $i++) { - sleep 1; - return if $device_api->Connected; + my $device_api = $self->_device; + eval { + eval { $device_api->Disconnect; }; + $device_api->Pair; + $device_api->Connect; + for ( my $i = 0 ; $i < 3 ; $i++ ) { + return if $device_api->Connected; + sleep 1; + } + }; + if ($@) { + warn $@; } - die 'Unable to connect to Cat Printer'; +} + +sub connect_if_disconnected($self) { + eval { + $self->_adapter->StartDiscovery; + $self->_adapter->SetDiscoveryFilter( + { Transport => Net::DBus::dbus_string('le') } ); + $self->_device->Disconnect; + $self->_device->Pair; + } if !$self->_device->Connected; } sub print($self) { - my $gatt_characteristic_1 = $self->_gatt; - $self->try_to_connect; - my $tempdir = Path::Tiny->tempdir; - my $in = $tempdir->child('in.png'); - my $out = $tempdir->child('out.bmp'); - $self->current_image->_file( '' . $in ); - die 'Couldn\'t invert image' - if system qw/magick/, $in, qw/-flop -rotate 180 -negate -monochrome/, - $out; - open my $fh, '<', $out; - $self->_send_command( - $self->_bytestring( - 0x51, 0x78, 0xa3, 0x00, 0x01, 0x00, 0x00, 0x00, 0xff + my $image = $self->current_image; + my $remaining_height = $image->height; + $self->_remaining_height( $image->height ); + $self->_device->get_service->get_bus->timeout(1000); + $self->connect_if_disconnected; + sleep 1 if !$self->_device->Connected; + my $reactor = Net::DBus::Reactor->main; + $self->_reactor($reactor); + $self->_rx_gatt->StartNotify; + usleep 100_000; + 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); + } + } ) ); - $self->_send_command( - $self->_make_command( 0xa4, $self->_bytestring(50) ) ); - $self->_send_command( $self->_make_command( 0xbd, $self->_bytestring(5) ) ); - $self->_send_command( - $self->_make_command( 0xaf, $self->_bytestring( 0x00, 0x40 ) ) ); - $self->_send_command( - $self->_make_command( 0xbe, $self->_bytestring(0x01) ) ); - $self->_send_command( - $self->_make_command( 0xa9, $self->_bytestring(0x00) ) ); - my $mtu = 200; + my $y = 0; + $self->_y($y); my $buffer = ''; - $buffer .= - $self->_bytestring( 0xaa, 0x55, 0x17, 0x38, 0x44, 0x5f, 0x5f, 0x5f, 0x44, - 0x38, 0x2c ); -# $buffer .= $self->_make_command( 0xa0, $self->_bytestring( 255, 0x00 ) ); + while ( $remaining_height > 0 ) { + my $height = $remaining_height > 500 ? 500 : $remaining_height; + $remaining_height -= $height; - 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 ); - if ( length $buffer > $mtu * 16 ) { - $self->_flush( \$buffer, $mtu ); + my $print_image = GD::Image->new( $image->width, $height ); + $print_image->copy( $image, 0, 0, 0, $y, $image->width, $height ); + $y += $height; + 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, 0x40 ) ); + $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 + ); } - $buffer .= - $self->_bytestring( 0xaa, 0x55, 0x17, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x17 ); + my $mtu = 200; $self->_flush( \$buffer, $mtu ); + $self->_reactor->run; + $self->_rx_gatt->StopNotify; } sub _reverse_byte( $self, $i ) { @@ -168,18 +258,59 @@ sub _bytestring( $self, @array ) { } sub _flush( $self, $buffer, $mtu ) { - while ( 0 < length $$buffer ) { - my $take_length = length $$buffer > 200 ? 200 : length $$buffer; + 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( + 10, + 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 $gatt = $self->_gatt; + $self->connect_if_disconnected; + my $gatt = $self->_tx_gatt; $data = [ map { unpack 'C', $_ } split '', $data ]; $data = [ map { Net::DBus::dbus_byte($_) } @$data ]; - return $gatt->WriteValue( + $gatt->WriteValue( Net::DBus::dbus_array($data), { type => Net::DBus::dbus_string('command') }, ); diff --git a/lib/Exd/DeviceToRawFile.pm b/lib/Exd/DeviceToRawFile.pm index 7d39b5d..2d7af31 100644 --- a/lib/Exd/DeviceToRawFile.pm +++ b/lib/Exd/DeviceToRawFile.pm @@ -41,7 +41,7 @@ sub image( $self, $image ) { if ($@) { die 'Unable to write to file does ' . $self->output_file . " exist?, error: $@."; } - $y += $height + 1; + $y += $height; } } diff --git a/lib/Exd/FileFormat.pm b/lib/Exd/FileFormat.pm index e4d6e1e..cc0f991 100644 --- a/lib/Exd/FileFormat.pm +++ b/lib/Exd/FileFormat.pm @@ -135,10 +135,8 @@ sub to_zip($self) { sub from_zip_file( $class, $zip_file ) { my $tempdir = Path::Tiny->tempdir(); - say 'hola'; my $zip = Archive::Zip->new($zip_file); $zip->extractTree( '', $tempdir ); - say 'adios'; return $class->new( dir => $tempdir ); } diff --git a/lib/Exd/Gui/Instance.pm b/lib/Exd/Gui/Instance.pm index 0b1af95..b60554d 100644 --- a/lib/Exd/Gui/Instance.pm +++ b/lib/Exd/Gui/Instance.pm @@ -24,6 +24,7 @@ has _paywall => ( is => 'rw' ); has device => ( is => 'rw' ); has _pay_url => ( is => 'lazy' ); has _activated => ( is => 'rw' ); +has _last_valid_preview_file => ( is => 'rw' ); has file_format => ( is => 'rw', default => sub { @@ -437,8 +438,8 @@ sub _update_editor_buffer($self) { sub _populate_preview( $self, $box_editor_preview ) { my $preview_picture = Gtk4::Picture->new; - $self->_preview_widget($preview_picture); my $preview_scroll_window = Gtk4::ScrolledWindow->new; + $self->_preview_widget($preview_scroll_window); $preview_scroll_window->set_child($preview_picture); $preview_scroll_window->set_property( 'width-request', 384 ); $box_editor_preview->append($preview_scroll_window); @@ -530,14 +531,20 @@ sub _add_to_log( $self, $text ) { } sub _on_preview($self) { - my $preview_picture = $self->_preview_widget; - if ( -f $self->_preview_file ) { + my $scroll = $self->_preview_widget; + if ( -f $self->_preview_file + && (!defined $self->_last_valid_preview_file + || $self->_last_valid_preview_file ne $self->_preview_file) + ) { + $self->_last_valid_preview_file($self->_preview_file); + my $preview_picture = Gtk4::Picture->new; $preview_picture->set_filename( '' . $self->_preview_file ); my $image = GD::Image->new( '' . $self->_preview_file ); $preview_picture->set_property( 'width-request', $image->width ); $preview_picture->set_halign('end'); $preview_picture->set_valign('start'); $preview_picture->set_property( 'height-request', $image->height ); + $scroll->set_child($preview_picture); } } @@ -756,7 +763,6 @@ sub _open_action($self) { sub _open_file( $self, $file ) { $self->_save_path($file); my $window = $self->window; - say $self->_save_path; $window->set_title( "Hiperthermia (Thermal Printer) " . ($self->_exd->debug ? 'DEBUG' : '') . path( $self->_save_path )->basename ); $self->file_format( Exd::FileFormat->from_zip_file($file) ); diff --git a/lib/Exd/Gui/PrinterConfigure.pm b/lib/Exd/Gui/PrinterConfigure.pm index 6cbcac7..a3d721d 100644 --- a/lib/Exd/Gui/PrinterConfigure.pm +++ b/lib/Exd/Gui/PrinterConfigure.pm @@ -38,6 +38,7 @@ sub _read_bluetooth_printers($self) { my @fhs = $self->_select->can_read(0); for my $fh (@fhs) { $fh->blocking(0); + say 'hola'; while ( defined( my $line = <$fh> ) ) { my @return = map { $self->app->device_hash_to_object($_) } @{ JSON::from_json($line) }; @@ -45,6 +46,7 @@ sub _read_bluetooth_printers($self) { Exd::DeviceToBluetooth->cache_printers( $self->_bluetooth_printers ); } + say 'adios'; } } @@ -63,7 +65,7 @@ sub _usb_printer_print_to_box( $self, $device, $box ) { sub _cat_printer_print_to_box( $self, $device, $box ) { my $window = $self->_window; - my $button = Gtk4::Button->new_with_label( $device->path ); + my $button = Gtk4::Button->new_with_label( $device->tx ); $button->signal_connect( 'clicked', sub { @@ -103,7 +105,10 @@ sub _device_api( $self, $path ) { has _pid_read_special_cat_printer => ( is => 'rw' ); sub _try_to_connect_difficult_cat_printer_devices( $self, $key, $device ) { - if ( defined $device && $device->{Name} eq 'SC05-6F4C' ) { + if ( defined $device + && defined $device->{name} + && $device->{Name} eq 'SC05-6F4C' ) + { my $device_api = $self->_device_api($key); if ( $device_api->Connected ) { return; @@ -118,13 +123,6 @@ sub _try_to_connect_difficult_cat_printer_devices( $self, $key, $device ) { $self->_pid_read_special_cat_printer(fork); if ( !$self->_pid_read_special_cat_printer ) { my $device_api = $self->_device_api($key); - eval { - $device_api->CancelPairing; - sleep 1; - }; - if ($@) { - warn $@; - } eval { $device_api->Pair; sleep 1; @@ -132,13 +130,6 @@ sub _try_to_connect_difficult_cat_printer_devices( $self, $key, $device ) { if ($@) { warn $@; } - eval { - $device_api->Connect; - sleep 1; - }; - if ($@) { - warn $@; - } $device_api->get_service->get_bus->get_connection->disconnect; exit; } @@ -152,10 +143,14 @@ sub _read_cat_printers($self) { my $object_manager_interface = 'org.freedesktop.DBus.ObjectManager'; my $object = $service->get_object( $path, $object_manager_interface ); use Data::Dumper; + my $device_path = '/org/bluez/hci0'; + $service->get_object( $device_path, 'org.bluez.Adapter1' )->StartDiscovery; + $service->get_object( $device_path, 'org.bluez.Adapter1' )->SetDiscoveryFilter( + { Transport => Net::DBus::dbus_string('le') } ); my $items = $object->GetManagedObjects; $object->get_service->get_bus->get_connection->disconnect; - my @paths_tx; + my %devices; for my $key ( keys %$items ) { my $device = $items->{$key}{'org.bluez.Device1'}; my $item = $items->{$key}{'org.bluez.GattCharacteristic1'}; @@ -169,13 +164,22 @@ sub _read_cat_printers($self) { next; } if ( $item->{UUID} eq '0000ae01-0000-1000-8000-00805f9b34fb' ) { - push @paths_tx, $key; + my ($device) = $key =~ /dev_(.*?)\//; + $devices{$device}{tx} = $key; + } + if ( $item->{UUID} eq '0000ae02-0000-1000-8000-00805f9b34fb' ) { + my ($device) = $key =~ /dev_(.*?)\//; + $devices{$device}{rx} = $key; } } $self->_cat_printers( [ - map { Exd::DeviceToCatPrinter->new( path => $_ ) } - sort { $a cmp $b } @paths_tx + map { + Exd::DeviceToCatPrinter->new( tx => $_->{tx}, rx => $_->{rx} ) + } + sort { $a->{tx} cmp $b->{tx} } + grep { defined $_->{rx} && defined $_->{tx} } + map { $devices{$_} } keys %devices ] ); } diff --git a/lib/Exd/Printer.pm b/lib/Exd/Printer.pm index 78b856b..d0f1556 100644 --- a/lib/Exd/Printer.pm +++ b/lib/Exd/Printer.pm @@ -130,7 +130,7 @@ sub print($self) { } sub print_n_lf( $self, $n ) { - $self->print_text( "\n" x $n, 30 ); + $self->print_text( [('') x $n], 30 ); } sub serialize($self) { diff --git a/me.sergiotarxz.Exd.yml b/me.sergiotarxz.Exd.yml index 40be648..c0af152 100644 --- a/me.sergiotarxz.Exd.yml +++ b/me.sergiotarxz.Exd.yml @@ -4,7 +4,7 @@ runtime-version: "47" sdk: "org.gnome.Sdk" finish-args: - --share=ipc - - --device=dri + - --device=all - --socket=fallback-x11 - --socket=wayland - --share=network