Version 14 of Code 39 generation

Updated 2005-06-11 23:45:22

if 0 {Richard Suchenwirth 2003-07-10 - Barcodes have ever and again fascinated me - I still can't read them, but I wanted to understand how things work, and that I often like to do with the help of Tcl. So here's my first take at generating Code 39 barcodes, which are a rather easy starter - you have bars and gaps in just two possible widths, and good documentation at e.g. [L1 ]. Here's a result of the code below:

http://mini.net/files/test8252v.gif

I wrapped the crucial symbology in this proc, which builds tables of character values and bar-gap sequences, where 1 resp. 2 indicate the width. This results in two lists, which can be searched or indexed numerically, so I get three-way lookup functionality from two lists:}

 proc c39.tables {} {
    set chars {}; set patterns {}
    foreach {char pattern} {
      0 111221211    1 211211112    2 112211112    3 212211111
      4 111221112    5 211221111    6 112221111    7 111211212
      8 211211211    9 112211211    A 211112112    B 112112112
      C 212112111    D 111122112    E 211122111    F 112122111
      G 111112212    H 211112211    I 112112211    J 111122211
      K 211111122    L 112111122    M 212111121    N 111121122
      O 211121121    P 112121121    Q 111111222    R 211111221
      S 112111221    T 111121221    U 221111112    V 122111112
      W 222111111    X 121121112    Y 221121111    Z 122121111
      - 121111212    . 221111211  " " 122111211    $ 121212111
      / 121211121    + 121112121    % 111212121    * 121121211
    } {lappend chars $char; lappend patterns $pattern}
    list $chars $patterns
 }

if 0 { One sees 9 parts in each symbol (5 bars, 4 gaps), of which three are wide and the rest narrow (hence the name "3 of 9" or 39. This part converts an input string into a bar-gap sequence, with added start and stop characters (both "*") and optionally a checksum character:}

 proc c39 {string {checksum ""}} {
    foreach {chars patterns} [c39.tables] break
    #-- blank out all undefined characters
    regsub -all {[^0-9A-Z.$/+%-]} [string toupper $string] " " string
    if {$checksum != ""} {
        set sum 0
        foreach char [split $string ""] {
            incr sum [lsearch -exact $chars $char]
        }
        append string [lindex $chars [expr {$sum % 43}]]
    }
    set res ""
    foreach char [split *$string* ""] {
        append res [lindex $patterns [lsearch -exact $chars $char]] 1
    }
    set res
 }

if 0 {This renders a bar-gap sequence, as from the above code, into a photo image:}

 proc c39img {c39} {
    set width [expr {round([string length $c39]*5)}]
    set height 60
    set im [image create photo -width $width -height $height]
    $im put white -to 0 0 $width $height
    set x 20
    foreach {bar gap} [split $c39 ""] {
        set bar [expr {$bar == 1? 2: 6}]
        set gap [expr {$gap == 1? 5: 8}]
        $im put black -to $x 0 [expr {$x+$bar}] $height
        set x [expr {$x+$bar+$gap}]
    }
    set im
 }

if 0 {Debugging tool, this re-translates a bar-gap sequence to ASCII characters:}

 proc c39read c39 {
    foreach {chars patterns} [c39.tables] break
    set res ""
    while {[string length $c39]} {
        set pattern [string range $c39 0 8]
        append res [lindex $chars [lsearch -exact $patterns $pattern]]
        set c39 [string range $c39 10 end]
    }
    set res
 }

 # Demo:
  set txt "ABCDE-12345"
  set bc [c39 $txt ]
  set im [c39img $bc ]
  label .l1 -anchor c -text  $txt
  label .l2 -anchor c -image $im
  label .l3 -anchor c -text  $bc
  pack  .l1 .l2 .l3

Eric Amundsen May 16, 2005

Fixed the encoding for 'A'. In the doc that Richard Suchenwirth referenced the encoding for 'A' was the same as '9', this [L2 ] reference has the correct encoding for 'A'. Otherwise this code works great, tested with a real scanner even!


HJG Added some demo-code.


Category Barcode | Arts and crafts of Tcl-Tk programming