[Richard Suchenwirth] 2002-12-07: Here is another educational Tcltoy: a
set of 8 checkboxes that represent the bits of a byte. Each is labeled
with its positional value below. The button at bottom displays the
current value of the byte in hexadecimal, octal and decimal. Clicking on
it resets all bits to 0, or, if they already are, to 1.

[WikiDbImage bits.jpg]



** Changes **

   [PYK] 2016-01-15:   Fixed a bug the reset proc, eliminated calls to `[eval]`, and widgetified so to allow multiple instances of this widget in one application.  The code grew, but not by much considering the additional functionality.  I attempted to use `[focus]` to make the widget behave as I imagine is expected, and change the behaviour from restarting on `<Escape>` to destroying and recreating the GUI elements on `<Escape>`.   Made analagous changes to the widget by [JJM] at the bottom of this page. 



** Description **

The simple code below contains some tricks that are unique to Tcl. The
positional values of the 8 bits serve as variable names as well, and
with prefixed "." as widget names of the checkboxes. The two procedures
first import the global list of positional values, then via [eval]
[global] each of them separately. As name and ''onvalue'' of a "bit"
are the same, the otherwise puzzling command

======
set $i $i
======

makes perfect sense - if i is 16, it assigns the value 16 to the
variable 16...




** Code **


======
#! /usr/bin/env tclsh

package require Tk

proc bitplay master {
    set name [info cmdcount]
    namespace eval $name {} {
        namespace ensemble create
        namespace export *

        proc destroy {} {
            namespace delete [namespace current]
        }
         
        proc init {} {
            variable master
            variable positionalValues {128 64 32 16 8 4 2 1}
            foreach i $positionalValues {
                checkbutton $master.$i -variable [namespace current]::$i \
                    -onvalue $i -command [namespace which compute]
                keybindings $master.$i
                lappend buttons $master.$i
                lappend labels [label $master.l$i -text $i]
            }
            grid {*}$buttons
            grid {*}$labels
            button $master.result -textvar [namespace current]::result \
                -command [namespace which reset] -borderwidth 1
            keybindings $master.$i
            bind $master <Destroy> [namespace code destroy]
            grid $master.result -columnspan 8 -sticky ew
            focus $master
            compute ;# show the initial state (should be 0)
        }

        proc keybindings w {
            bind $w <Escape> [namespace code restart]
        }

        proc reset {} {
            variable positionalValues
            variable result
            foreach i $positionalValues {
                variable $i
                if {[lindex $result end-1] == 0} {
                    set $i $i
                } else {set $i 0}
            }
            compute
        }

        proc compute {} {
            variable positionalValues
            variable result
            set res 0
            foreach i $positionalValues {
                variable $i
                incr res [set $i]
            }
            set result [
                format "Hex: 0x%02X, Octal: 0o%02o, Decimal: %d (%c)" \
                    $res $res $res $res]
        }

        proc restart {} {
            variable master
            destroy {*}[winfo children $master]
            after 0 [list after idle [list [namespace which init]]]
        }
        set master [uplevel set master]
    }
    $name keybindings $master
    bind $master <ButtonPress> [list focus $master]
    $name init
    return $name
}

#bind . <Escape> {exec [info nameofexecutable] $argv0 &; exit}
frame .bitplay
grid .bitplay
bitplay .bitplay 
======

----

[JJM] 2002-12-09: Fixed typo in the hex and octal format strings. - [RS]: Thanks! I originally started this at home in all leisure, but when at work I hurriedly try to insert fixes (and don't test well - the screenshot above still shows the octal bug!), such things happen... Thanks again for attention, and new ideas!

----

[JJM] 2002-12-09: By changing these lines:

======
grid .result -columnspan 8 -sticky ew
set result [format "Hex: 0x%2X, Octal: 0o%02o, Decimal: %d (%c)" $res $res $res $res]
======

to these:

======
grid .result -columnspan [llength $positionalValues] -sticky ew
set result [format "Hex: 0x%02X, Octal: 0o%02o, Decimal: %d" $res $res $res]
======

You can add an arbitrary number of values to the positionalValues list and the code will still work properly.

It looks like this:

[http://rohanpall.com/tclerspub/coderx2-morebits.jpg]

----

JDR 2007-01-08: Give this a try.

Replace this line

======
set positionalValues {128 64 32 16 8 4 2 1}
======

With this for loop, set i to whatever number you want to a maximum value of 31.

======
for {set i 31} {$i > 0} {incr i -1} {
    lappend positionalValues $i
}
======

Replace this line

======
checkbutton .$i -variable $i -onvalue $i -command compute
======

With this

======
checkbutton .$i -variable $i -onvalue [expr {int(pow(2,($i - 1)))}] -command compute
======

Replace this line

======
set $i $i
======

With this
======
set $i [expr {int(pow(2,($i - 1)))}]
======

One final note, you might want to change the positionalValues name to positionalLabels

----

[JJM] 2002-12-09, Far more radical modifications:

======
#! /usr/bin/env tclsh

package require Tk

proc mbitplay master {
    set name [info cmdcount]
    namespace eval $name {
        namespace ensemble create
        namespace export *

        set positionalValues(1) {0x00000008 0x00000004 0x00000002 0x00000001}
        set positionalValues(2) {0x00000080 0x00000040 0x00000020 0x00000010}
        set positionalValues(3) {0x00000800 0x00000400 0x00000200 0x00000100}
        set positionalValues(4) {0x00008000 0x00004000 0x00002000 0x00001000}
        set positionalValues(5) {0x00080000 0x00040000 0x00020000 0x00010000}
        set positionalValues(6) {0x00800000 0x00400000 0x00200000 0x00100000}
        set positionalValues(7) {0x08000000 0x04000000 0x02000000 0x01000000}
        set positionalValues(8) {0x80000000 0x40000000 0x20000000 0x10000000}   
        
        proc compute {} {
            variable positionalValues
            variable result

            set res 0
            foreach j [lsort -integer [array names positionalValues]] {

                foreach i $positionalValues($j) {
                    variable $i
                    set res [expr {wide($res) + wide([set $i])}]
                }
            }

            set result [format "Hex: 0x%02X, Octal: 0o%02o, Decimal: %ld" \
                $res $res $res]
        }

        proc destroy {} {
            namespace delete [namespace current]
        }
         
        proc init {} {
            variable master
            variable positionalValues
            set row 0
             
            foreach j [lsort -integer [array names positionalValues]] {
                set buttons {}
                set labels {}
             
                foreach i $positionalValues($j) {
                    checkbutton $master.$i -variable [namespace current]::$i \
                        -onvalue $i -command [namespace code compute] \
                            -borderwidth 2
                    keybindings $master.$i
                    lappend buttons $master.$i
                    lappend labels [label $master.l$i -text $i]
                }
             
                eval grid $buttons -row $row -columnspan [
                    llength $positionalValues(1)] 
                eval grid $labels -row [expr {$row + 1}] -columnspan [
                    llength $positionalValues(1)]
             
                set row [expr {$row + 2}]
            }

            bind $master <Destroy> [namespace code destroy]
             
            button $master.result -textvar [namespace current]::result \
                -command reset -borderwidth 1
            grid $master.result -row [expr {$row + 2}] -columnspan [
                expr {[llength $positionalValues(1)] * 4}] -sticky ew

            focus $master
            compute ;# show the initial state (should be 0)
        }

        proc keybindings w {
            bind $w <Escape> [namespace code restart]
        }
         
        proc reset {} {
            variable positionalValues
            variable result
         
            foreach j [lsort -integer [array names positionalValues]] {
                eval global $positionalValues($j)
         
                foreach i $positionalValues($j) {
                    if {[lindex $result end] == 0} {
                        set $i $i
                    } else {
                        set $i 0
                    }
                }
            }
         
            compute
        }

        proc restart {} {
            variable master
            destroy {*}[winfo children $master]
            after 0 [list after idle [list [namespace which init]]]
        }

        set master [uplevel set master]

    }

    $name init
    $name keybindings $master
    return $name
}

frame .mbitplay
grid .mbitplay
mbitplay .mbitplay 
======

----

[escargo] 2005-08-16: Changed the last format statement to use positional specifiers instead of
sequential ones.

----

[AMG]: Relax with bits!  [http://www.engrish.com/detail.php?imagename=bits2%20copy.jpg&category=Containers&date=2001-03-28] [http://www.engrish.com/detail.php?imagename=bits3copy.jpg&category=Containers&date=2001-02-20]

<<categories>> Toys | Arts and crafts of Tcl-Tk programming