This writes a c39 type barcode and is coded for a laser etching on anodized aluminum (reverse video like). You'll also need [Writing DXF].
# Code from http://wiki.tcl.tk/9335
#
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
}
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
}
proc dxf::barcode { x y w h string } {
set y1 [expr $y + $h]
set x0 $x
set x [expr $x + $w * 8]
dxf::solidbox $x0 $y $x $y1
foreach { bar space } [split [c39 $string] ""] {
set x [expr $x + $w * $bar]
if { $space ne {} } {
set x0 $x
set x [expr $x + $w * $space]
dxf::solidbox $x0 $y $x $y1
}
}
dxf::solidbox $x $y [expr $x + $w * 8] $y1
}