Adding initial GUI.

lib/Exd/DeviceToBluetooth.pm

@@ -27,8 +27,6 @@ has _guts_device => ( is => 'rw' );
 
 has _tempdir => ( is => 'rw', );
 
-has _obj => (is => 'lazy');
-
 sub _device($self) {
     if ( !defined $self->_guts_device ) {
         $self->_tempdir( Path::Tiny->tempdir );
@@ -61,7 +59,7 @@ sub lf($self) {
     $self->_device->lf;
 }
 
-sub _build__obj($self) {
+sub _obj($self) {
     my $obj = Net::Bluetooth->newsocket('RFCOMM');
     $self->_try_to_connect($obj);
     return $obj;
@@ -71,8 +69,10 @@ sub print($self) {
     $self->_device->print;
     $self->_guts_device(undef);
     my $obj = $self->_obj;
+    local $| = 1;
     my $fh = $obj->perlfh;
     print $fh path( $self->_tempfile )->slurp_raw;
+    $fh->flush;
 }
 
 sub _try_to_connect($self, $obj, $retries = 3) {
@@ -85,4 +85,11 @@ sub _try_to_connect($self, $obj, $retries = 3) {
     sleep 1;
     return $self->_try_to_connect($obj, $retries - 1);
 }
+sub serialize($self) {
+    my $hash = {};
+    $hash->{address} = $self->address;
+    $hash->{port} = $self->port;
+    $hash->{type} = 'bluetooth';
+    return $hash;
+}
 1;

lib/Exd/DeviceToImage.pm

@@ -33,12 +33,18 @@ sub image( $self, $image ) {
     $new_current->copy( $image, 0, $current_image->height, 0, 0,
         $image->width, $image->height );
     $self->current_image($new_current);
-    path($self->output_file)->spew_raw($new_current->png);
 }
 
 sub lf {
 }
 
-sub print {
+sub print($self) {
+    path($self->output_file)->spew_raw($self->current_image->png);
+}
+
+sub serialize($self) {
+    my $hash = {%$self};
+    $hash->{type} = 'image';
+    return $hash;
 }
 1;

lib/Exd/DeviceToRawFile.pm

@@ -38,4 +38,11 @@ sub lf($self) {
 sub print($self) {
     $self->_guts_device->printer->print;
 }
+
+sub serialize($self) {
+    my $hash = {%$self};
+    delete $hash->{_guts_device};
+    $hash->{type} = 'file';
+    return $hash;
+}
 1;

lib/Exd/Gui.pm

@@ -0,0 +1,366 @@
+package Exd::Gui;
+
+use v5.40.0;
+
+use strict;
+use warnings;
+use utf8;
+
+use Data::Dumper;
+
+use Moo;
+
+use Glib;
+use Glib::IO;
+use Glib::Object::Introspection;
+use Path::Tiny;
+use GD::Image;
+
+use IO::Select;
+use Capture::Tiny qw/capture/;
+use Exd::Printer;
+use Exd::DeviceToBluetooth;
+use Exd::DeviceToImage;
+
+use JSON;
+
+Glib::Object::Introspection->setup(
+    basename => 'Gtk',
+    version  => '4.0',
+    package  => 'Gtk4',
+);
+
+Glib::Object::Introspection->setup(
+    basename => 'Gdk',
+    version  => '4.0',
+    package  => 'Gdk',
+);
+
+Glib::Object::Introspection->setup(
+    basename => 'GtkSource',
+    version  => '5',
+    package  => 'Gtk4::Source',
+);
+
+has _app => ( is => 'rw', );
+
+has _win              => ( is => 'rw', );
+has _scroll_log_upper => ( is => 'rw', );
+
+has _execute_log => ( is => 'rw', );
+
+has _editor => ( is => 'rw', );
+
+has _select => ( is => 'lazy', );
+
+has _tempdir_previews_guts => ( is => 'rw' );
+has _preview_widget        => ( is => 'rw' );
+has _read_from_script      => ( is => 'rw' );
+has _read_from_parent      => ( is => 'rw' );
+has _write_to_parent       => ( is => 'rw' );
+has _write_to_script       => ( is => 'rw' );
+
+sub _tempdir_previews($self) {
+    if ( !defined $self->_tempdir_previews_guts ) {
+        $self->_tempdir_previews_guts( Path::Tiny->tempdir );
+    }
+    return $self->_tempdir_previews_guts;
+}
+
+{
+    my $i = 0;
+
+    sub _preview_file( $self, $inc = 0 ) {
+        if ($inc) {
+            $i++;
+        }
+        $self->_tempdir_previews->child("preview-$i.png");
+    }
+}
+
+sub start($self) {
+    $self->_daemon_script_runner;
+    my $app = Gtk4::Application->new( 'me.sergiotarxz.Exd', 'default-flags' );
+    $self->_app($app);
+    $app->signal_connect(
+        activate => sub {
+            $self->_activate;
+        }
+    );
+    $app->run;
+}
+
+sub _generate_preview_file( $self, $verbose = 1 ) {
+    $self->_preview_file(1) if -f $self->_preview_file;
+    my $device =
+      Exd::DeviceToImage->new( output_file => '' . $self->_preview_file );
+    $self->_run_script( $device, $verbose );
+}
+
+sub _run_script( $self, $device = undef, $verbose = 1 ) {
+    my ( $read_from_script, $write_to_parent ) =
+      ( $self->_read_from_script, $self->_write_to_parent );
+
+    my $buffer     = $self->_editor->get_buffer;
+    my $begin_iter = $buffer->get_iter_at_offset(0);
+    my $end_iter   = $buffer->get_end_iter;
+    my $script     = $buffer->get_text( $begin_iter, $end_iter, 0 );
+    if ( !defined $device ) {
+        $device = Exd::DeviceToBluetooth->new(
+            address => '5A:4A:AE:8C:E9:D2',
+            port    => 1
+        );
+    }
+    local $| = 1;
+    my $fh = $self->_write_to_script;
+    print $fh JSON::to_json(
+        {
+            script  => $script,
+            device  => $device->serialize,
+            verbose => $verbose,
+        }
+    ) . "\n";
+    $fh->flush;
+}
+
+sub _daemon_script_runner($self) {
+    my ( $read_from_script, $write_to_parent );
+    my ( $read_from_parent, $write_to_script );
+    pipe $read_from_script, $write_to_parent;
+    pipe $read_from_parent, $write_to_script;
+    $self->_select->add($read_from_script);
+    $self->_read_from_script($read_from_script);
+    $self->_read_from_parent($read_from_parent);
+    $self->_write_to_parent($write_to_parent);
+    $self->_write_to_script($write_to_script);
+    my $pid = fork;
+
+    my $last_pid;
+    if ( !$pid ) {
+        close $read_from_script;
+        close $write_to_script;
+        my $last_device;
+        while (1) {
+            my $fh   = $self->_read_from_parent;
+            my $line = <$fh>;
+            my $data = JSON::from_json($line);
+            my ( $script, $device, $verbose ) =
+              $data->@{ 'script', 'device', 'verbose' };
+            $device = $self->_device_hash_to_object($device);
+            if (   $last_pid
+                && $last_device->isa('Exd::DeviceToImage')
+                && !$verbose )
+            {
+                kill 'KILL', $last_pid;
+            }
+            $last_device = $device;
+            my $new_pid = fork;
+            if ( !$new_pid ) {
+                eval {
+                    $self->_on_run_script( $script, $device, $write_to_parent,
+                        $verbose );
+                };
+                if ($@) {
+                    warn $@;
+                }
+                exit;
+            }
+            $last_pid = $new_pid;
+        }
+        exit;
+    }
+    close $read_from_parent;
+    close $write_to_parent;
+}
+
+sub _device_hash_to_object( $self, $device_hash ) {
+    my $type           = delete $device_hash->{type};
+    my %dispatch_table = (
+        image => sub {
+            return Exd::DeviceToImage->new(%$device_hash);
+        },
+        file => sub {
+            return Exd::DeviceToRawFile->new(%$device_hash);
+        },
+        bluetooth => sub {
+            return Exd::DeviceToBluetooth->new(%$device_hash);
+        }
+    );
+    my $sub = $dispatch_table{$type};
+    if ( !defined $sub ) {
+        die 'Unknown device type.';
+    }
+    return $sub->();
+}
+
+sub _on_run_script( $self, $script, $device, $write_to_parent, $verbose = 1 ) {
+    my $printer = Exd::Printer->new( device => $device );
+    local $| = 1;
+
+    my ( $stdout, $stderr, $exit ) = capture {
+        eval {
+            my $sub =
+              eval
+'use v5.40.0; use strict; use warnings; use utf8; use Cairo; use Pango;'
+              . $script;
+            if ($@) {
+                die $@;
+            }
+            $sub->($printer);
+        };
+        if ($@) {
+            if ($verbose) {
+                print $write_to_parent $@ . "\n";
+            }
+        }
+    };
+
+    if ($verbose) {
+        print $write_to_parent $stdout . "\n";
+        print $write_to_parent $stderr . "\n";
+    }
+    $write_to_parent->flush;
+}
+
+sub _monitor_run($self) {
+    my @fhs = $self->_select->can_read(0);
+    for my $fh (@fhs) {
+        my $execute_log = $self->_execute_log;
+        my $buffer      = $execute_log->get_buffer;
+        my $begin_iter  = $buffer->get_iter_at_offset(0);
+        my $end_iter    = $buffer->get_end_iter;
+        my $text        = <$fh>;
+        return if $text =~ /^\s*$/;
+        $buffer->insert( $end_iter, $text, -1 );
+    }
+}
+
+sub _build__select($self) {
+    return IO::Select->new;
+}
+
+sub _on_preview($self) {
+    my $preview_picture = $self->_preview_widget;
+    if ( -f $self->_preview_file ) {
+        $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 );
+    }
+}
+
+sub _activate($self) {
+    Glib::Timeout->add(
+        1000,
+        sub {
+            $self->_monitor_run;
+            return 1;
+        }
+    );
+    my $app = $self->_app;
+    my $win = Gtk4::ApplicationWindow->new($app);
+    $self->_win($win);
+    my $box_vertical   = Gtk4::Box->new( 'vertical', 0 );
+    my $editor         = Gtk4::Source::View->new;
+    my $execute_log    = Gtk4::TextView->new;
+    my $run_button     = Gtk4::Button->new_with_label('Run');
+    my $preview_button = Gtk4::Button->new_with_label('Preview');
+    Glib::Timeout->add(
+        1000,
+        sub {
+            $self->_on_preview;
+            return 1;
+        }
+    );
+    $preview_button->signal_connect(
+        'clicked',
+        sub {
+            $self->_generate_preview_file;
+        }
+    );
+    $self->_execute_log($execute_log);
+    $self->_editor($editor);
+
+    $run_button->signal_connect(
+        clicked => sub {
+            $self->_run_script( undef, 1 );
+        }
+    );
+
+    $execute_log->set_editable(0);
+    $execute_log->set_cursor_visible(0);
+
+    $win->set_title('Exd (Thermal Printer)');
+    $win->set_default_size( 1200, 900 );
+
+    $editor->set_hexpand(1);
+    $editor->set_vexpand(1);
+    $editor->set_property( 'width-request', 800 );
+    $execute_log->set_hexpand(1);
+    $execute_log->set_vexpand(1);
+
+    my $buffer = $editor->get_buffer();
+    $buffer->set_text( <<'EOF', -1 );
+sub ($printer) {
+    $printer->print_text(
+        [
+            'hola mundo'
+        ],
+        30
+    );
+    $printer->print_n_lf(4);
+
+    $printer->print;
+}
+EOF
+    my $box_editor_preview = Gtk4::Box->new( 'horizontal', 0 );
+    my $preview_picture    = Gtk4::Picture->new;
+    $self->_preview_widget($preview_picture);
+    $self->_generate_preview_file;
+    $box_vertical->set_vexpand(1);
+    $buffer->set_language(
+        Gtk4::Source::LanguageManager::get_default()->get_language('perl') );
+    $buffer->set_highlight_syntax(1);
+    my $editor_scroll_window = Gtk4::ScrolledWindow->new;
+    $editor_scroll_window->set_halign('fill');
+    $editor_scroll_window->set_child($editor);
+    $editor->set_show_line_numbers(1);
+    $buffer->signal_connect(
+        'changed',
+        sub {
+            $self->_generate_preview_file(0);
+        }
+    );
+
+    my $box_buttons = Gtk4::Box->new( 'horizontal', 0 );
+    $box_buttons->append($run_button);
+    $box_buttons->append($preview_button);
+    $box_vertical->append($box_buttons);
+    $box_vertical->append($box_editor_preview);
+    my $preview_scroll_window = Gtk4::ScrolledWindow->new;
+    $preview_scroll_window->set_child($preview_picture);
+    $preview_scroll_window->set_property( 'width-request', 380 );
+    $box_editor_preview->append($editor_scroll_window);
+    $box_editor_preview->append($preview_scroll_window);
+    my $execute_log_window = Gtk4::ScrolledWindow->new;
+    my $scroll             = $execute_log_window->get_vadjustment;
+    $self->_scroll_log_upper( $scroll->get_upper );
+    $scroll->signal_connect(
+        'changed',
+        sub {
+            my $old_upper = $self->_scroll_log_upper;
+            $self->_scroll_log_upper( $scroll->get_upper );
+            return
+              if $scroll->get_value + $scroll->get_page_size * 2 < $old_upper;
+            $scroll->set_value( $scroll->get_upper );
+            return 1;
+        }
+    );
+    $execute_log_window->set_child($execute_log);
+    $box_vertical->append($execute_log_window);
+    $win->set_child($box_vertical);
+    $win->present;
+}
+1

lib/Exd/Printer.pm

@@ -10,6 +10,7 @@ use Exd::Utils;
 use Encode qw/decode/;
 use Path::Tiny;
 use Pango;
+use Cairo;
 
 has device => (
     is => 'ro',
@@ -81,7 +82,7 @@ sub _split_text_lines( $self, $text, $max_width, $font, $font_size ) {
                 $i++;
                 next;
             }
-            $element = decode 'utf-8', $element;
+            $element = $element;
             push @lines, $element;
             $i++;
         }
@@ -274,7 +275,7 @@ sub _get_next_line($self, $lines) {
 
 sub print_text( $self, $text, $font_size ) {
     if ( !( ref $text ) ) {
-        $text = decode 'utf-8', $text;
+        $text = $text;
     }
     my $tempdir = Path::Tiny->tempdir;
     my $file    = $tempdir->child('result.png');
@@ -382,4 +383,10 @@ sub _get_size_text( $self, $cr, $layout, $font, $font_size, $text ) {
     }
     return $x;
 }
+
+sub serialize($self) {
+    my $hash = {%$self};
+    $hash->{device} = $hash->{device}->serialize;
+    return $hash;
+}
 1;

scripts/demo.pl

@@ -11,32 +11,20 @@ use Exd::DeviceToRawFile;
 use Exd::DeviceToBluetooth;
 use Exd::Utils;
 
-{
-#    my $device  = Exd::DeviceToBluetooth->new( address => '5A:4A:AE:8C:E9:D2', port => 1 );
 my $device =
-      Exd::DeviceToImage->new( output_file => 'a.png' );
+  Exd::DeviceToRawFile->new( output_file => '/dev/usb/lp0' );
 my $printer = Exd::Printer->new( device => $device );
-    for my $font (
+my $pid = fork;
-        'Z003 Medium Italic',
+if (!$pid) {
-        'Noto Sans CJK JP',
-        'Shadow Into Light Regular'
-      )
-    {
-        $printer->font($font);
-
-        my $hoz = Exd::Utils::get_gd_image('scripts/hoz.jpg');
-
     $printer->print_text(
         [
-                $hoz, ' The best software ' , $hoz , ' belongs to everybody ',
+            'hola mundo'
-                $hoz
         ],
         30
     );
-        $printer->image('scripts/hoz.jpg');
     $printer->print_n_lf(4);
-
     $printer->print;
+    exit 0;
 }
-}
+waitpid $pid, 0;
 

scripts/main.pl

@@ -0,0 +1,9 @@
+#!/usr/bin/env perl
+
+use v5.40.0;
+use strict;
+use warnings;
+
+use Exd::Gui;
+
+Exd::Gui->new->start;