if 0 {[Richard Suchenwirth] 2004-05-31 - Here is code for compactly
storing a 2-dimensional matrix of bits, and getting and setting individual bits. A
maximum of 32 bits is packed into an integer. Together with some admin
data, the whole thing is a [transparent] value in [TOOT] format, though
the code below does not require TOOT. In any case, we get some type safety,
and helpful error messages on misuse, from this tagged representation. As usual with
[transparent] values, you'll have to reassign them to a variable if you
want changes to persist:
 set arr [bitarray'set $arr $x $y $bit]

SYNOPSIS:
 bitarray $width $height       - returns a bitarray of given size, all 0s
 bitarray $width $height $ones - same, plus sets all bits specified in $ones
 bitarray'set $ba $x $y        - returns the bit at row y, column x
 bitarray'set $ba $x $y $b     - returns a copy of $ba with the bit at row
                                 y, column x set to !!$b
 bitarray'ones $ba             - returns a 'x y x y ...' list of set bits

The "copy constructor" ''bitarray $w $h $ones'' allows reassigning a
bitarray to another of different size, provided the set bits in $ones,
as might have been returned from the alternative serializer
''bitarray'ones'',
don't exceed the new dimensions. If the bitarray is sparsely populated,
the $ones representation may be more efficient, and convenient for
iteration over set bits.
}
 proc bitarray {width height {ones ""}} {
    set n [expr {($width+31)/32 * $height}]
    set 0 [expr 1-1] ;# hope to share the "0" Tcl_Obj
    set ints {}
    for {set i 0} {$i<$n} {incr i} {
        lappend ints $0
    }
    set ba [list bitarray | [list $width $height $ints]]
    foreach {x y} $ones {
        set ba [bitarray'set $ba $x $y 1]
    }
    set ba
 }
 proc bitarray'set {ba x y {bit ""}} {
    if {[lrange $ba 0 1] ne "bitarray |"} {error "expected bitarray but got $ba"}
    foreach {w h ints} [lindex $ba 2] break
    if {$x<0 || $x>=$w || $y<0 || $y>=$h} {
        error "indices $x $y out of bound for $w $h bitarray"
    }
    set index [expr {($w+31)/32 * $y + $x/32}]
    set int [lindex $ints $index]
    if {$bit eq ""} {
        return [expr {!!($int & (1 << $x%32))}]
    } else {
        if {$bit != 0} {
            lset ints $index [expr {$int | (1 << $x%32)}]
        } else {
            lset ints $index [expr {$int & ~(1 << $x%32)}]
        }
        list bitarray | [list $w $h $ints]
    }
 }
if 0 {The following implementation of bitarray'ones was straightforward
but very slow - 2.7 sec for a 100x100 bitarray on my 200MHz box.}
 proc #bitarray'ones ba {
    if {[lrange $ba 0 1] ne "bitarray |"} {error "expected bitarray but got $ba"}
    foreach {w h ints} [lindex $ba 2] break
    set res {}
    for {set i 0} {$i<$h} {incr i} {
        for {set j 0} {$j<$w} {incr j} {
            if [bitarray'set $ba $j $i] {lappend res $j $i}
        }
    }
    set res
 }
if 0 {So I whipped up this alternative which is 2 LOC longer, but does
its job in 115 msec - a 20x speedup is well worth a redesign :^}
 proc bitarray'ones ba {
    if {[lrange $ba 0 1] ne "bitarray |"} {error "expected bitarray but got $ba"}
    foreach {w h ints} [lindex $ba 2] break
    set res {}
    set x 0; set y 0
    foreach int $ints {
        for {set i 0} {$i<32} {incr i} {
            if {$int & (1<<$i)} {lappend res [expr {$x+$i}] $y}
        }
        if {[incr x 32]>=$w} {set x 0; incr y}
    }
    set res
 }
#--- Test suite:
 proc ? {cmd expected} {
    set t0 [clock clicks -milli]
    catch {uplevel 1 $cmd} res
    puts [list $cmd [expr {[clock clicks -milli]-$t0}] msec]
    if {$res ne $expected} {puts "$cmd->$res, expected $expected"}
 }
 ? {set a [bitarray 5 5]} {bitarray | {5 5 {0 0 0 0 0}}}
 ? {bitarray'set $a 1 2}   0
 #-- Set a bit, and then another (nonzero counts as 1):
 ? {set a [bitarray'set $a 1 2 1]} {bitarray | {5 5 {0 0 2 0 0}}}
 ? {bitarray'ones $a}      {1 2}
 ? {set a [bitarray'set $a 0 0 42]} {bitarray | {5 5 {1 0 2 0 0}}}
 ? {bitarray'ones $a}      {0 0 1 2}
 #-- Unset a bit:
 ? {set a [bitarray'set $a 1 2 0]} {bitarray | {5 5 {1 0 0 0 0}}}
 ? {bitarray'ones $a}      {0 0}
 #-- Testing copy constructor:
 ? {set b [bitarray 5 5 [bitarray'ones $a]]} {bitarray | {5 5 {1 0 0 0 0}}}
 #-- But just reassignment makes a good copy, too :)
 ? {set c $b}              {bitarray | {5 5 {1 0 0 0 0}}}
 ? {bitarray'ones $c}      {0 0}
 #-- Testing a bigger bitarray - "list" avoids lengthy output:
 ? {set d [bitarray 100 100 {99 99 0 0 47 11}]; list} {}
 ? {bitarray'ones $d}      {0 0 47 11 99 99}
 ? {bitarray'set $d 99 99} 1
 ? {bitarray'set $d 98 76} 0
 
if 0 {
See also [Bit vectors]
----
[Arts and crafts of Tcl-Tk programming]
}