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. [http://www.barcodeisland.com/code39.phtml]. 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 112211211    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
 }

----
[Arts and crafts of Tcl-Tk programming]