;;; @Package     postnet.scm
;;; @Subtitle    USPS POSTNET Barcode Encoding in Scheme
;;; @HomePage    http://www.neilvandyke.org/postnet-scm/
;;; @Author      Neil W. Van Dyke
;;; @AuthorEmail neil@@neilvandyke.org
;;; @Version     0.2
;;; @Date        2005-07-12

;; $Id: postnet.scm,v 1.10 2005/07/12 16:27:15 neil Exp $

;;; @legal
;;; Copyright @copyright{} 2004 - 2005 Neil W. Van Dyke.  This program is Free
;;; Software; you can redistribute it and/or modify it under the terms of the
;;; GNU Lesser General Public License as published by the Free Software
;;; Foundation; either version 2.1 of the License, or (at your option) any
;;; later version.  This program is distributed in the hope that it will be
;;; useful, but without any warranty; without even the implied warranty of
;;; merchantability or fitness for a particular purpose.  See
;;; @indicateurl{http://www.gnu.org/copyleft/lesser.html} for details.  For
;;; other license options and consulting, contact the author.
;;; @end legal

(define-syntax %postnet:testeez
  (syntax-rules () ((_ X ...)
                    ;; (testeez X ...)
                    (error "Tests disabled.")
                    )))

;;; @section Introduction

;;; This @code{postnet.scm} Scheme library can be used to generate the United
;;; States Postal Service POSTNET barcode binary pattern, as described in
;;; Chapter 4 of @uref{http://pe.usps.gov/text/Pub25/Pub25.htm, USPS
;;; Publication 25@comma{} ``Designing Letter and Reply Mail@comma{}''} dated
;;; 2003-06.  This library supports ZIP, ZIP+4, and DBPC codes.
;;;
;;; The generated binary representation is a Scheme list of boolean values.
;;; Separate code must be written to render this representation to a particular
;;; printing devices.

;;; @section Encoding

;;; There are several procedures for encoding POSTNET from various input
;;; representations.  It is suspected that most applications will encode from a
;;; string representation, using @code{string->postnet}.

;;; @defproc digit-list->postnet digits
;;;
;;; Yields a POSTNET encoding of a list of digit numbers.  For example:
;;;
;;; @lisp
;;; (digit-list->postnet '(1 2 3 4 5))
;;; @result{}
;;; (#t #f #f #f #t #t #f #f #t #f #t #f #f #t #t #f
;;;  #f #t #f #f #t #f #t #f #t #f #f #t #f #t #f #t)
;;; @end lisp

(define digit-list->postnet
  (let ((digit->postnet-bars
         (let ((postnet-digit-bars-vector
                '#((#t #t #f #f #f)
                   (#f #f #f #t #t)
                   (#f #f #t #f #t)
                   (#f #f #t #t #f)
                   (#f #t #f #f #t)
                   (#f #t #f #t #f)
                   (#f #t #t #f #f)
                   (#t #f #f #f #t)
                   (#t #f #f #t #f)
                   (#t #f #t #f #f))))
           (lambda (digit)
             (if (and (integer? digit) (<= 0 digit 9))
                 (vector-ref postnet-digit-bars-vector digit)
                 '())))))
    (lambda (digits)
      (let ((sum 0))
        (cons #t
              (let loop ((digits digits))
                (if (null? digits)
                    (append (digit->postnet-bars (- 10 (modulo sum 10)))
                            (list #t))
                    (let* ((d    (car digits))
                           (bars (digit->postnet-bars d)))
                      (if (null? bars)
                          (loop (cdr digits))
                          (begin (set! sum (+ sum d))
                                 (append bars (loop (cdr digits)))))))))))))

;;; @defproc char-list->postnet chars
;;;
;;; Yields a POSTNET encoding of a list of characters.  For example:
;;;
;;; @lisp
;;; (char-list->postnet '(#\1 #\2 #\3 #\4 #\5))
;;; @result{}
;;; (#t #f #f #f #t #t #f #f #t #f #t #f #f #t #t #f
;;;  #f #t #f #f #t #f #t #f #t #f #f #t #f #t #f #t)
;;; @end lisp

(define (char-list->postnet chars)
  (digit-list->postnet (map (lambda (c)
                              (- (char->integer c) 48))
                            chars)))

;;; @defproc string->postnet str
;;;
;;; Yields a POSTNET encoding of a string.  For example:
;;;
;;; @lisp
;;; (string->postnet "12345-6789 01")
;;; @result{}
;;; (#t #f #f #f #t #t #f #f #t #f #t #f #f #t #t #f
;;;  #f #t #f #f #t #f #t #f #t #f #f #t #t #f #f #t
;;;  #f #f #f #t #t #f #f #t #f #t #f #t #f #f #t #t
;;;  #f #f #f #f #f #f #t #t #f #t #f #f #t #t)
;;; @end lisp

(define (string->postnet str)
  (char-list->postnet (string->list str)))

;;; @section Debugging

;;; Although this package does not render POSTNET for OCR use, for debugging
;;; purposes, the @code{postnet->debug-string} procedure can be used to
;;; approximate the barcode visually, using ASCII characters.

;;; @defproc postnet->debug-string postnet
;;;
;;; Yields a string visual approximation of a POSTNET encoding.  For example:
;;;
;;; @lisp
;;; (postnet->debug-string (string->postnet "12345"))
;;; @result{} "|...||..|.|..||..|..|.|.|..|.|.|"
;;; @end lisp

(define (postnet->debug-string postnet)
  (apply string (map (lambda (bar) (if bar #\| #\.)) postnet)))

;;; @section Tests

;;; The @code{postnet.scm} test suite can be enabled by editing the source code
;;; file and loading @uref{http://www.neilvandyke.org/testeez/, Testeez}.

(define (%postnet:test)
  (%postnet:testeez
   "postnet.scm"

   (test/equal ""
               (digit-list->postnet '(1 2 3 4 5))
               '(#t #f #f #f #t #t #f #f #t #f #t #f #f #t #t #f
                    #f #t #f #f #t #f #t #f #t #f #f #t #f #t #f #t))

   (test/equal ""
               (char-list->postnet '(#\1 #\2 #\3 #\4 #\5))
               '(#t #f #f #f #t #t #f #f #t #f #t #f #f #t #t #f
                    #f #t #f #f #t #f #t #f #t #f #f #t #f #t #f #t))

   (test/equal ""
               (string->postnet "12345-6789 01")
               '(#t #f #f #f #t #t #f #f #t #f #t #f #f #t #t #f
                    #f #t #f #f #t #f #t #f #t #f #f #t #t #f #f #t
                    #f #f #f #t #t #f #f #t #f #t #f #t #f #f #t #t
                    #f #f #f #f #f #f #t #t #f #t #f #f #t #t))

   (test/equal ""
               (postnet->debug-string (string->postnet "12345"))
               "|...||..|.|..||..|..|.|.|..|.|.|")

   ))

;;; @unnumberedsec History

;;; @table @asis
;;;
;;; @item Version 0.2 --- 2005-07-12
;;; Added Testeez tests.  Minor documentation changes.
;;;
;;; @item Version 0.1 --- 2004-04-14
;;; Wrote as a diversion over dinner.
;;;
;;; @end table