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 lioke 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]. 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:} 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 {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 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 into a photo image:} proc c39img {c39 {factor 4}} { set width [expr {round([string length $c39]*$factor*1.35)+10}] set height [expr 20*$factor] 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 ""] { $im put black -to $x 0 [expr {$x+$bar*$factor}] $height set x [expr {$x+($bar+$gap)*$factor}] } 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]