auspost.ps.src

% Barcode Writer in Pure PostScript
% https://bwipp.terryburton.co.uk
%
% Copyright (c) 2004-2024 Terry Burton
%
% $Id$
%
% Permission is hereby granted, free of charge, to any
% person obtaining a copy of this software and associated
% documentation files (the "Software"), to deal in the
% Software without restriction, including without
% limitation the rights to use, copy, modify, merge,
% publish, distribute, sublicense, and/or sell copies of
% the Software, and to permit persons to whom the Software
% is furnished to do so, subject to the following
% conditions:
%
% The above copyright notice and this permission notice
% shall be included in all copies or substantial portions
% of the Software.
%
% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY
% KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO
% THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A
% PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
% THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
% DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
% CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
% CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
% IN THE SOFTWARE.

% --BEGIN ENCODER auspost--
% --REQUIRES preamble loadctx unloadctx raiseerror processoptions renlinear--
% --DESC: AusPost 4 State Customer Code
% --EXAM: 5956439111ABA 9
% --EXOP: includetext custinfoenc=character
% --RNDR: renlinear
/setpacking where {pop currentpacking true setpacking} if
10 dict
dup /loadctx dup /uk.co.terryburton.bwipp findresource put
dup /unloadctx dup /uk.co.terryburton.bwipp findresource put
dup /raiseerror dup /uk.co.terryburton.bwipp findresource put
dup /processoptions dup /uk.co.terryburton.bwipp findresource put
dup /renlinear dup /uk.co.terryburton.bwipp findresource put
begin
/auspost {

    20 dict begin

    /ctx null def
    /dontdraw false def
    /includetext false def         % Enable/disable text
    /textfont /Courier def
    /textsize 10.0 def
    /textyoffset -7.0 def
    /height 0.175 def
    /custinfoenc (character) def

    //processoptions exec /options exch def
    /barcode exch def

    custinfoenc (character) ne custinfoenc (numeric) ne and {
        /bwipp.auspostBadCustinfoEncoding (Customer information encoding must be either character or numeric) //raiseerror exec
    } if

    /auspost //loadctx exec

    % Create an array containing the character mappings
{
    /encs
    [ (000) (001) (002) (010) (011) (012) (020) (021)
      (022) (100) (101) (102) (110) (111) (112) (120)
      (121) (122) (200) (201) (202) (210) (211) (212)
      (220) (221) (222) (300) (301) (302) (310) (311)
      (312) (320) (321) (322) (023) (030) (031) (032)
      (033) (103) (113) (123) (130) (131) (132) (133)
      (203) (213) (223) (230) (231) (232) (233) (303)
      (313) (323) (330) (331) (332) (333) (003) (013)
      (00) (01) (02) (10) (11) (12) (20) (21) (22) (30)
      (13) (3)
    ] def

    % Create a string of the available characters
    /barchars (ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyz #) def

    % FCC lengths
    /fcclen << (11) 37  (45) 37  (59) 52  (62) 67 >> def

} ctxdef

    /barlen barcode length def
    barlen 10 lt {
        /bwipp.auspostTooShort (The data length must be at least 10) //raiseerror exec
    } if

    /txt barlen 2 sub array def

    fcclen barlen 2 ge { barcode 0 2 getinterval } { () } ifelse
    2 copy known not {
        pop pop /bwipp.auspostBadFCC (Must begin with an FCC, either 11, 45, 59 or 62) //raiseerror exec
    } if
    get /encstr exch string def

    % Validate that the message has a complete, numeric DPID
    true
    1 {
        barlen 10 lt { pop false exit } if
        barcode 2 8 getinterval { dup 48 lt exch 57 gt or { pop false exit } if } forall
    } repeat
    not {
        /bwipp.auspostIncompleteDPID (The DPID must be 8 digits) //raiseerror exec
    } if

    % Validate that the message will fit
    barlen 10 sub custinfoenc (numeric) eq {2} {3} ifelse mul
    encstr length 22 sub 14 sub gt {
        /bwipp.auspostTooLong (The message is too long) //raiseerror exec
    } if

    % Put start character
    encstr 0 encs 74 get putinterval

    % Encode the FCC
    0 1 1 {
        /i exch def
        encs barcode i 1 getinterval cvi 64 add get
        encstr i 2 mul 2 add 3 2 roll putinterval
    } for

    % Encode the DPID
    2 1 9 {
        /i exch def
        encs barcode i 1 getinterval cvi 64 add get
        encstr i 2 mul 2 add 3 2 roll putinterval
        txt i 2 sub [barcode i 1 getinterval i 2 sub 2 mul 6 add 3.312 mul textyoffset textfont textsize] put
    } for

    % Encode the customer information
    custinfoenc (numeric) eq {
        0 1 barlen 11 sub {
            /i exch def
            encs barcode i 10 add get
            dup dup 48 lt exch 57 gt or {
                /bwipp.auspostInvalidCustinfoDigit (The customer information data contains a non-digit character) //raiseerror exec
            } if
            48 sub 64 add get
            encstr i 2 mul 22 add 3 2 roll putinterval
            txt i 8 add [barcode i 10 add 1 getinterval i 2 mul 22 add 3.312 mul textyoffset textfont textsize] put
        } for
        /ciflen barlen 10 sub 2 mul def
    } {
        0 1 barlen 11 sub {
            /i exch def
            barcode i 10 add 1 getinterval barchars exch search
            not {
                pop /bwipp.auspostInvalidCustinfoCharacter (The customer information contains an invalid character) //raiseerror exec
            } if
            length /indx exch def
            pop pop
            /enc encs indx get def
            encstr i 3 mul 22 add enc putinterval
            txt i 8 add [barcode i 10 add 1 getinterval i 3 mul 22 add 3.312 mul textyoffset textfont textsize] put
        } for
        /ciflen barlen 10 sub 3 mul def
    } ifelse

    % Add any filler characters
    22 ciflen add 1 encstr length 14 sub {
        encstr exch encs 75 get putinterval
    } for

    % Create the 64x64 Reed-Solomon table
{
    /rstable 64 64 mul array def
    rstable 0 [ 64 {0} repeat ] putinterval
    rstable 64 [ 0 1 63 {} for ] putinterval
    /prev 1 def
    64 {
        /next prev 1 bitshift def
        next 64 and 0 ne {
            /next next 67 xor def
        } if
        0 1 63 {
            /j exch def
            /nextcell {rstable 64 next mul j add} def
            nextcell rstable 64 prev mul j add get 1 bitshift put
            nextcell get 64 and 0 ne {
                nextcell nextcell get 67 xor put
            } if
        } for
        /prev next def
    } repeat
} ctxdef

    % Calculate the Reed-Solomon codes for triples
    /rscodes encstr length 16 sub 3 idiv 4 add array def
    rscodes 0 [ 4 {0} repeat ] putinterval
    2 3 encstr length 16 sub {
        /i exch def
        rscodes rscodes length i 2 sub 3 idiv sub 1 sub
        encstr i 1 getinterval cvi 16 mul
        encstr i 1 add 1 getinterval cvi 4 mul add
        encstr i 2 add 1 getinterval cvi add
        put
    } for
    rscodes length 5 sub -1 0 {
       /i exch def
       0 1 4 {
           /j exch def
           rscodes i j add rscodes i j add get
           rstable 64 [48 17 29 30 1] j get mul rscodes i 4 add get add get
           xor put
       } for
    } for
    /checkcode (000000000000) 12 string copy def
    0 1 3 {
        /i exch def
        /enc rscodes 3 i sub get 4 3 string cvrs def
        checkcode i 3 mul 3 enc length sub add enc putinterval
    } for

    % Put checkcode and end characters
    encstr encstr length 14 sub checkcode putinterval
    encstr encstr length 2 sub encs 74 get putinterval

    /bbs encstr length array def
    /bhs encstr length array def
    0 1 encstr length 1 sub {
        /i exch def
        /enc encstr i 1 getinterval def
        enc (0) eq {
            bbs i 0 height mul 8 div put
            bhs i 8 height mul 8 div put
        } if
        enc (1) eq {
            bbs i 3 height mul 8 div put
            bhs i 5 height mul 8 div put
        } if
        enc (2) eq {
            bbs i 0 height mul 8 div put
            bhs i 5 height mul 8 div put
        } if
        enc (3) eq {
            bbs i 3 height mul 8 div put
            bhs i 2 height mul 8 div put
        } if
    } for

    % Return the arguments
    <<
    /ren /renlinear
    /bbs bbs
    /bhs bhs
    /sbs [bhs length 1 sub {1.44 1.872} repeat 1.44]
    includetext {
        /txt txt
    } if
    /opt options
    >>

    dontdraw not //renlinear if

    //unloadctx exec

    end

}
[/barcode] {null def} forall
bind def
/auspost dup load /uk.co.terryburton.bwipp defineresource pop
end
/setpacking where {pop setpacking} if
% --END ENCODER auspost--