evolis-printer.pl

   1 #!/usr/bin/perl
   2
   3 # Simulate EVOLIS Dualys printer
   4
   5 use warnings;
   6 use strict;
   7
   8 use Data::Dump qw(dump);
   9
  10 my $feeder = {qw(
  11 F Feeder
  12 M Manual
  13 B Auto
  14 )};
  15
  16 local $/ = "\r";
  17
  18 my $page = 1;
  19
  20 while(<>) {
  21         die "no escape at beginning" unless s/^\x1B//;
  22         chomp;
  23         my @a = split(/;/,$_);
  24         my $c = shift @a;
  25         if ( $c eq 'Pmi' ) {
  26                 my $f = $a[0] || die 'missing feeder';
  27                 print "feeder $f | $feeder->{$f}\n";
  28                 $a[1] eq 's' or die;
  29         } elsif ( $c eq 'Pc' ) {
  30                 my $color = $a[0];
  31                 $a[1] eq '=' or die;
  32                 my $temperature = $a[2];
  33                 print "temperature $color = $temperature\n";
  34         } elsif ( $c eq 'Pr' ) {
  35                 print "improve $a[0]\n";
  36                 # FIXME windows sends it, cups doesn't
  37         } elsif ( $c eq 'Dbc' ) {
  38                 my ( $color, $line, $len, $data ) = @a;
  39                 while ( $len > length($data) ) {
  40                         warn "# slurp more ",length($data), " < $len\n";
  41                         $data .= <>;
  42                 }
  43                 $len == length $data or die "wrong length $len != ", length $data;
  44
  45                 my $path = "page-$page-$color.pbm";
  46                 open(my $pbm, '>', $path);
  47
  48                 my $w = 1016;
  49                 my $h = 648;
  50
  51                 $h = int( $len * 8 / $w );
  52
  53                 print $pbm "P4\n$w $h\n", $data;
  54                 close($pbm);
  55                 print "printed $path $w * $h size ", -s $path, "\n";
  56         } else {
  57                 warn "UNKNOWN: $c ", dump(@a);
  58         }
  59 }