sergiotarxz/Exd
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fixing cat printers for long outputs.

Browse Source
This commit is contained in:
sergiotarxz 2024-11-02 18:54:33 +01:00
parent face50ef58
commit 5c8903909a
9 changed files with 332 additions and 179 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
deps
View File

@ -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

188
generated-sources.json
View File

@ -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",

207
lib/Exd/DeviceToCatPrinter.pm
View File

@ -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 );
use Time::HiRes qw/usleep/;
has tx => ( is => 'ro', required => 1 );
has rx => ( is => 'ro', required => 1 );
has current_image => ( is => 'rw', );
has _gatt => ( is => 'lazy' );
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,58 +58,132 @@ 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');
return $service->get_object( $self->path, 'org.bluez.GattCharacteristic1' );
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 try_to_connect($self) {
my $device_api = $self->_device;
return if $device_api->Connected;
eval {
eval { $device_api->Disconnect; };
$device_api->Pair;
$device_api->Connect;
for ( my $i = 0 ; $i < 3 ; $i++ ) {
sleep 1;
return if $device_api->Connected;
sleep 1;
}
die 'Unable to connect to Cat Printer';
};
if ($@) {
warn $@;
}
}
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 $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);
}
}
)
);
my $y = 0;
$self->_y($y);
my $buffer = '';
while ( $remaining_height > 0 ) {
my $height = $remaining_height > 500 ? 500 : $remaining_height;
$remaining_height -= $height;
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');
$self->current_image->_file( '' . $in );
$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;
$self->_send_command(
$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(
0x51, 0x78, 0xa3, 0x00, 0x01, 0x00, 0x00, 0x00, 0xff
0xaa, 0x55, 0x17, 0x38, 0x44, 0x5f,
0x5f, 0x5f, 0x44, 0x38, 0x2c
)
);
$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 $buffer = '';
$buffer .=
$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;
@ -107,14 +195,16 @@ sub print($self) {
$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 );
}
$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') },
);

2
lib/Exd/DeviceToRawFile.pm
View File

@ -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;
}
}

2
lib/Exd/FileFormat.pm
View File

@ -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 );
}

14
lib/Exd/Gui/Instance.pm
View File

@ -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) );

44
lib/Exd/Gui/PrinterConfigure.pm
View File

@ -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
]
);
}

2
lib/Exd/Printer.pm
View File

@ -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) {

2
me.sergiotarxz.Exd.yml
View File

@ -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