upca.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 upca--
% --REQUIRES preamble loadctx unloadctx raiseerror processoptions renlinear ean5 ean2--
% --DESC: UPC-A
% --EXAM: 012345000058
% --EXOP: includetext
% --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
dup /ean2 dup /uk.co.terryburton.bwipp findresource put
dup /ean5 dup /uk.co.terryburton.bwipp findresource put
begin
/upca {

    20 dict begin

    /ctx null def
    /dontdraw false def
    /includetext false def
    /textfont /Helvetica def
    /textsize 12.0 def
    /textxoffset -9.0 def
    /textyoffset -4.0 def
    /height 1.0 def
    /addongap 12.0 def
    /addontextfont (unset) def
    /addontextsize null def     % sentinal realtype
    /addontextxoffset null def  % sentinal realtype
    /addontextyoffset null def  % sentinal realtype

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

    /upca //loadctx exec

    % Split off the addon
    barcode ( ) search {
        /barcode exch def
        pop
        /addon exch def
    } {
        pop
        /addon () def
    } ifelse

    % Expand a given UPC-E
    barcode length 7 eq barcode length 8 eq or {
        % Validate the input
        barcode {
            dup 48 lt exch 57 gt or {
                /bwipp.upcAupcEbadCharacter (UPC-E must contain only digits) //raiseerror exec
            } if
        } forall
        barcode 0 get dup 48 ne exch 49 ne and {
            /bwipp.upcAupcEbadNumberSystem (UPC-E must have number system 0 or 1) //raiseerror exec
        } if
        1 {  % Common exit
            /upcacode barcode length 8 eq {12} {11} ifelse string def
            barcode 6 get 48 sub 2 le {
                upcacode 0 barcode 0 3 getinterval putinterval
                upcacode 3 barcode 6 1 getinterval putinterval
                upcacode 4 (0000) putinterval
                upcacode 8 barcode 3 3 getinterval putinterval
                exit
            } if
            barcode 6 get 48 sub 3 eq {
                upcacode 0 barcode 0 4 getinterval putinterval
                upcacode 4 (00000) putinterval
                upcacode 9 barcode 4 2 getinterval putinterval
                exit
            } if
            barcode 6 get 48 sub 4 eq {
                upcacode 0 barcode 0 5 getinterval putinterval
                upcacode 5 (00000) putinterval
                upcacode 10 barcode 5 1 getinterval putinterval
                exit
            } if
            barcode 6 get 48 sub 5 ge {
                upcacode 0 barcode 0 6 getinterval putinterval
                upcacode 6 (0000) putinterval
                upcacode 10 barcode 6 1 getinterval putinterval
                exit
            } if
        } repeat
        barcode length 8 eq {
            upcacode 11 barcode 7 1 getinterval putinterval
        } if
        /barcode upcacode def
    } if

    % Validate the input
    barcode length 11 ne barcode length 12 ne and {
        /bwipp.upcAbadLength (UPC-A must be 11 or 12 digits) //raiseerror exec
    } if
    barcode {
        dup 48 lt exch 57 gt or {
            /bwipp.upcAbadCharacter (UPC-A must contain only digits) //raiseerror exec
        } if
    } forall
    addon length 0 ne addon length 2 ne and addon length 5 ne and {
        /bwipp.upcAbadAddOnLength (Add-on for UPC-A must be 2 or 5 digits) //raiseerror exec
    } if

    % Add checksum digit to barcode
    /pad 12 string def   % Create pad one bigger than barcode
    /checksum 0 def
    0 1 10 {
        /i exch def
        /barchar barcode i get 48 sub def
        i 2 mod 0 ne {
            /checksum checksum barchar add def
        } {
            /checksum checksum barchar 3 mul add def
        } ifelse
    } for
    /checksum 10 checksum 10 mod sub 10 mod def
    barcode length 12 eq {
        barcode 11 get checksum 48 add ne {
            /bwipp.upcAbadCheckDigit (Incorrect UPC check digit provided) //raiseerror exec
        } if
    } if
    pad 0 barcode putinterval       % Add barcode to the start of the pad
    pad 11 checksum 48 add put      % Put ascii for checksum at end of pad
    /barcode pad def

    % Create an array containing the character mappings
{
    /encs
    [ (3211) (2221) (2122) (1411) (1132)
      (1231) (1114) (1312) (1213) (3112)
      (111) (11111) (111)
    ] def

    % Create a string of the available characters
    /barchars (0123456789) def
} ctxdef

    /sbs 59 string def
    /txt 12 array def

    % Put the start character
    sbs 0 encs 10 get putinterval

    % Left side
    0 1 5 {
        % Lookup the encoding for the each barcode character
        /i exch def
        barcode i 1 getinterval barchars exch search
        pop                                % Discard true leaving pre
        length /indx exch def              % indx is the length of pre
        pop pop                            % Discard seek and post
        /enc encs indx get def             % Get the indxth encoding
        sbs i 4 mul 3 add enc putinterval  % Put encoded digit into sbs
        i 0 eq {      % First digit is before the guard bars
            txt 0 [barcode 0 1 getinterval textxoffset textyoffset textfont textsize 2 sub] put
        } {
            txt i [barcode i 1 getinterval i 7 mul 13 add textxoffset add textyoffset textfont textsize] put
        } ifelse
    } for

    % Put the middle character
    sbs 6 4 mul 3 add encs 11 get putinterval

    % Right side
    6 1 11 {
        % Lookup the encoding for the each barcode character
        /i exch def
        barcode i 1 getinterval barchars exch search
        pop                                % Discard true leaving pre
        length /indx exch def              % indx is the length of pre
        pop pop                            % Discard seek and post
        /enc encs indx get def             % Get the indxth encoding
        sbs i 4 mul 8 add enc putinterval  % Put encoded digit into sbs
        i 11 eq {       % Last digit is after guard bars
            txt 11 [barcode 11 1 getinterval textxoffset 107 add textyoffset textfont textsize 2 sub] put
        } {
            txt i [barcode i 1 getinterval i 7 mul textxoffset add 17 add textyoffset textfont textsize] put
        } ifelse
    } for

    % Put the end character
    sbs 56 encs 12 get putinterval

    /sbs [sbs {48 sub} forall] def
    includetext {
        /bhs [4{height}repeat 10{height .075 sub}repeat height height 10{height .075 sub}repeat 4{height}repeat] def
        /bbs [0 0 0 0 10{.075}repeat 0 0 10{.075}repeat 0 0 0 0] def
    } {
        /bhs [30{height}repeat] def
        /bbs [30{0}repeat] def
        /txt [] def
    } ifelse
    /guardrightypos 0.0 def

    % Append the addon
    addon () ne {
        /addopts <<
            /dontdraw true
            /includetext true
            /height height includetext { 0.15 sub } if
            /textxoffset addontextxoffset null ne {addontextxoffset} {95 addongap add} ifelse
            addontextyoffset null ne {/textyoffset addontextyoffset} if
            /textsize addontextsize null ne {addontextsize} {textsize} ifelse
            /textfont addontextfont (unset) ne {addontextfont} {textfont} ifelse
        >> def
        addon length 2 eq {addon addopts //ean2 exec} if
        addon length 5 eq {addon addopts //ean5 exec} if
        /addcode exch def
        /sbs [sbs aload pop addongap addcode (sbs) get aload pop] def
        /bhs [bhs aload pop addcode (bhs) get aload pop] def
        /bbs [bbs aload pop addcode (bbs) get aload pop] def
        /txt [txt aload pop addcode (txt) get aload pop] def
        /guardrightypos height 72 mul 6 sub def
    } if

    % Return the arguments
    <<
    /ren /renlinear
    /sbs sbs
    /bhs bhs
    /bbs bbs
    /txt txt
    /opt options
    /guardrightpos addon () eq {9.0} {5.0} ifelse
    /guardrightypos guardrightypos
    /borderleft 9.0
    /borderright addon () eq {9.0} {5.0} ifelse
    /bordertop 0.0
    /borderbottom 5.0
    >>

    dontdraw not //renlinear if

    //unloadctx exec

    end

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