Prncapt Pl
# Replacement Printcapture program for Mobil CardXpress machines
# Configuration file location:
#
my $cfgfile = "C:\\PRNCAP\\PRNCAPT.INI";

# Configuration variables that matter:
# Port = x  // Com port Number
# Printer = xxxx // Printer Name
# IP = 1.2.3.4 // IP Address of Printer (Preferred)
# Name = xxx xx xxx // Site Name
# TaxLine = 'TOTAL INCLUDES GST' // Defaults to that if not supplied
# TCNTerm = ... 
# TCN = ...  // displays $TCNTERM : $TCN under $TAXLINE

use Win32::Printer;
use Win32::SerialPort qw( :STAT 0.19 );
use IO::Socket;
use Win32::GUI();
use Win32::Console;

# Maximum lines in the Textbox
my $maxlines = 200;
# Used if checking ticks in T_Timer
my $count = 0;
# Previous Printjob
my $prevprint="No Previous Print job";

# Startup text in Window.
my @screen=('Print Capture Monitor v1.0', '2008-05-09 - xrobau@gmail.com');

### Win32 Startup
# Create Window
my $w = Win32::GUI::Window->new(-name => 'W', -width => 210, -height => 325, -text => 'Receipt Monitor');

# Add the textbox
my $t = $w->AddTextfield( -name => 'T', -multiline => 1, -vscroll => 1, -autovscroll => 1, -readonly => 1, -pos => [10,10], -size => [180,260] );

# Status bar down the bottom...
my $sb = $w->AddStatusBar();
$sb->Text("Waiting for data.");

# 'Test Print' button
$tp = $w->AddButton( -name => 'TP', -text => 'Test Print', -pos => [10, 255], -onClick => \&doTestPrint);
# 'Reprint' button
$rp = $w->AddButton( -name => 'RP', -text => 'Reprint Invoice', -pos => [80, 255], -onClick => \&doRePrint);
# This setups a trigger to check for serial input. Basically, it runs the 
# sub P_Timer every 500msec (twice a second)
my $t1 = $w->AddTimer('P', 500);

# The tooltip icon specified..
my $gicon = new Win32::GUI::Icon('green.ico');
my $ni = $w->AddNotifyIcon( -name => "ST", -icon => $gicon, -tip => "Print Capture Running");

my $input = "";
my $line = "";

# Show the window, yay.
$w->Show();

# Load Config file
open (CFG, $cfgfile) || die "Can't open config file $cfgfile: $^E\n";
@cfg = <CFG>;
close CFG;

my $sitename = "SITE NAME NOT SET";
my $siteaddr1 = "SITE ADDR NOT SET";
my $siteaddr2 = "SITE ADDR NOT SET";
my $siteaddr3 = "SITE ADDR NOT SET";
my $tcn = "TCN NOT SET";
my $tcnterm = "TCNTERM NOT SET";
my $taxline = "TOTAL INCLUDES GST";
my $prnname = undef;
my $comport = undef;
my $prnip = undef;

&Out("Loading Config file");
foreach (@cfg) {
    s/
//g;
    chomp;
    if (/^Port.?=(.+)/i) { $comport = $1; $comport =~ s/^\s+//g; }
    if (/^Printer.?=(.+)/i) { $prnname = $1; $prnname =~ s/^\s+//g; }
    if (/^IP.?=(.+)/i) { $prnip = $1; $prnip =~ s/^\s+//g; }
    if (/^Name.?=(.+)/i) { $sitename = $1; $sitename =~ s/^\s+//g; }
    if (/^Addr1.?=(.+)/i) { $siteaddr1 = $1; $siteaddr1 =~ s/^\s+//g; }
    if (/^Addr2.?=(.+)/i) { $siteaddr2 = $1; $siteaddr2 =~ s/^\s+//g; }
    if (/^Addr3.?=(.+)/i) { $siteaddr3 = $1; $siteaddr3 =~ s/^\s+//g; }
    if (/^TCN.?=(.+)/i) { $tcn = $1; $tcn =~ s/^\s+//g; }
    if (/^TCNTerm.?=(.+)/i) { $tcnterm = $1; $tcnterm =~ s/^\s+//g; }
    if (/^TaxLine.?=(.+)/i) { $taxline = $1; $taxline =~ s/^\s+//g; }
}

chomp($comport, $prnname, $prnip, $sitename, $tcn, $tcnterm, $taxline);

my $header = "$sitename\n$siteaddr1\n$siteaddr2\n$siteaddr3\n\n${tcnterm}: $tcn\n\n$taxline\n";
&Out("Configuration:");
&Out("Site Name: $sitename");
&Out("COM Port: $comport");
if ($prnname) {
    &Out("Printer: $prnname");
} else {
    &Out("Printer: -Undefined-");
}
if ($prnip) {
    &Out("Printer IP: $prnip");
} else {
    &Out("Printer IP: -Undefined-");
}
&Out("Note:  PREFERRING IP") if ($prnname && $prnip);
&Out("TCN: $tcn");
&Out("TCN Term: $tcnterm");
&Out("Tax Line: $taxline");

# Set up Serial Port
my $port = new Win32::SerialPort("COM$comport") ||
    die "Can't open port COM$comport: $^E\n";
$port->baudrate(9600) || die "Baudrate $^E\n";
$port->parity("none") || die "Parity $^E\n";
$port->databits(8) || die "Data Bits $^E\n";
$port->stopbits(1) || die "Stopbits $^E\n";
$port->handshake('none') || die "Handshake $^E\n";
$port->write_settings || die "Unable to write port settings $^E\n";

# Get rid of the PERL window now, that we're ready to go.
Win32::Console::Free();

# This is an endless loop. This only exits when the 'X' button is clicked on
# the window.
Win32::GUI::Dialog();
exit;

sub P_Timer { # This gets run every 500msec.
    # Uncomment the next line to have a ping appear on every serial port
    # poll.
    # &Out("Timer Ping ($count)"); $count++;
    $line = $port->input;
    if ($line ne "") {
        #print "Received $line\n";
        $input .= $line;
    }
    if (length($line) > 3) {
        $sb->Text("Receiving Printjob");
    } else {
        $sb->Text("Waiting for data.");
    }
    if ($line =~ /i!8/) {
        &processInput();
    }

}

sub processInput() {
    # OK, so we have $input with a pile of crap in it. Split it into lines.
    my @lines = split ( /
/, $input);

    $sb->Text("Processing Receipt...");
    $sb->Update;
    # First thing is to see if the first line has an <esc>!1 in it.. 
    # If so, delete it.
    if ($lines[0] =~ /!1/) { shift @lines; }

    # Now loop through the lines, cleaning up and looking for the end of
    # the page (which is <esc>i<esc>!8)

    my $printjob = $header;
    foreach (@lines) {
        $temp = $_;
        if ($temp !~ /i!8/) {
            # Don't spool the line if it's got an escape in it
            if ($temp !~ //)  {
                                $printjob .= "$temp";
            }
        } else { # <esc>i<esc>!8 is the magic marker for End of page. 
            # However, there may be more pages, so reset printjob
            # and let the loop continue
            &doPrint($printjob);
            $printjob = $header;
        }
    }
    if ($printjob != $header) {
        # ..WTF, we've received stuff without an end-of-page marker.
        # Print it out anyway. Probably debugging stuff.
                &Out ("Failsafe print!");
        &doPrint($printjob);
    }
    $input="";
}

sub doPrint($) {
    my ($printjob) = @_;
    $prevprint = $printjob;
    &Out ("Received Printjob:");
    my @lines = split(/\n/, $printjob);
    my $lastlineblank = "true";
        my $fixed = "";
    foreach (@lines) {
        $tmp = $_;
        chomp($tmp);
        $tmp =~ s/
//g;
        $tmp =~ s/^\s//;
        $tmp =~ s/\s+$//g;
        $tmp =~ s/\*-//;
        $tmp =~ s/-\*//;
        next if ($tmp =~ /^Card/);
        $tmp =~ s/======================/====================/;

        if (($tmp eq "") && ($lastlineblank eq "false")) {
                   &Out ($tmp);
                        $fixed .= $tmp."\n";
                   $lastlineblank = "true";
        } elsif ($tmp ne "") {
            &Out ($tmp);
                        $fixed .= $tmp."\n";
            $lastlineblank = "false";
        }
    }
    # If we're printing to an IP Address...
    if (defined($prnip) && ($prnip ne "")) {
        &doPrintIP($fixed);
        return;
    } 
    # If we're printing to a Windows printer...
    if (defined($prnname) && ($prnname ne "")) {
        &doPrintName($fixed);
        return;
    }
    # Some tard hasn't set the printer variables properly.
    &Out ("Unable to print Printjob. No printers set up. Here it is:\n$printjob");
    return;
}

sub doPrintIP($) {
    my ($printjob) = @_;
    $sb->Text("Printing Receipt (Direct)");
    $sb->Update;
    my $prn = IO::Socket::INET->new (Proto => 'tcp', 
            PeerAddr => $prnip, 
            PeerPort => 9100) || &Out ("Warning! Can't connect to printer: $^E");
    if (open (HEADER, "<logo.prn")) {
        binmode (HEADER);
        my @head = <HEADER>;
        print $prn "@";
        print $prn @head; 
        print $prn "@! \n";
    } else {
        &Out("WARNING: Can't open logo.prn");
        print $prn "\nMOBIL\n";
        print $prn "@! \n";
    }
    my @lines = split(/\n/, $printjob);
    foreach (@lines) {
        $tmp = $_;
#        next if ($tmp eq "");
                print $prn "$tmp\n";
    }
    # Reset. Blank lines. Double Width. Cut.
    print $prn "@\n\n\n\n! \nV1";
    close $prn;
}

sub doPrintName($) {
    my ($printjob) = @_;
    $sb->Text("Printing Receipt (Spooler)");
    $sb->Update;
    my $dc = new Win32::Printer(
        description     => 'CardXpress Receipt',
        unit            => 'mm',
        printer        => $prnname
    );
    my $mobfon = $dc->Font('Mobil-Pi', 74);
    my $stdfon = $dc->Font('Courier New Bold', 15);
    my $smalfon = $dc->Font('Courier New Bold', 12);
    $dc->Font($mobfon);
    $dc->Write("zx", 4, 0);
    $dc->Font($stdfon);
    my @lines = split(/\n/, $printjob);
    my $ypos = 30;
    my $ystep = 5;
    foreach (@lines) {
        $tmp = $_;
#        next if ($tmp eq "");
        if (length($tmp) > 22) {
            $dc->Font($smalfon);
            $dc->Write($_, 4, $ypos);
            $dc->Font($stdfon);
        } else {
            $dc->Write($_, 4, $ypos);
        }
        $ypos = $ypos + $ystep;
    }
    $dc->Close();
}

sub doTestPrint() {
    &doPrint("
$header
TESTPRINTTESTPRINTTES
012345678901234567890
---------------------
^   20 Characters   ^
v   20 Characters   v
---------------------
TEST 
    TEST
        TEST
            TEST
               TEST
PRINT
    PRINT
        PRINT
            PRINT
                PRINT
---------------------

This line should be small
or should wrap around on 
direct IP printing, with
the new Epson printers..".'

LONG LINE LONG LINE LONG
SHORT LINE SHORT LINE

ABN: 46 054 320 991
*-LOCAL CARD RECEIPT-* 
 9MAY08 11:54:35   00
Card 7046000028600003
Pump 01
159.9c/L   x   101.00L
Diesel        $161.50
ODOMETER       210147

    TRANS CONFIRMED
   ON POWER FAILURE
  RECEIPT IS CORRECT
 RECORD OF TRANSACTION

');
}

sub doRePrint() {
    &doPrint($prevprint);
}

# Various stuff to keep Windows happy here.
sub W_Resize { 
    # Keep the textbox the same size relative to the window
    $t->Resize($w->ScaleWidth - 20, $w->Height - 85);
    # Keep the status bar in the right position..
    $sb->Move( 0, ($w->ScaleHeight() - $sb->Height()) );
    $sb->Resize( $w->ScaleWidth(), $sb->Height() );
    # Buttons..
    $tp->Move( 10, ($w->ScaleHeight() - 44));
    $rp->Move( 80, ($w->ScaleHeight() - 44));
}
sub W_Terminate { 
     $ni->DESTROY();
     -1; }

sub W_Minimize {  # This doesn't work for some reason. It should hide the
          # taskbar option.
    $w->Disable();
    $w->Hide();
    return 1;
}

sub ST_Click {
    $w->Enable();
    $w->Show();
    return 1;
}

sub Out($) {
    my $line = shift;
    my $contents = "";
    if ($#screen > $maxlines) {
        shift @screen 
    };
    push @screen, $line;
    foreach (@screen) { 
        $contents .= "$_\r\n";
    }
    $t->SelectAll;
    $t->ReplaceSel($contents);
}
Unless otherwise stated, the content of this page is licensed under Creative Commons Attribution-Noncommercial-Share Alike 2.5 License.