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. [L1 ]. 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
}