#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# 1.1 has better color scheme
set version "1.3"
#
# set these two flags to 1 to get a stand-alone version
# as used by me; set them to 0 to get plug-in netscape
# compatible version:
#
set ownwindow 0
set verbose 0
if {$verbose>=1} {
    puts "Hamming Code version $version         David J C MacKay 1997"
    puts "                                      written under tcl 8.3 on linux"
    puts "                                      believed to require tcl 7.6 or greater"
}

global verbose ; set verbose 0
global   transmitcolor decodecolor zerocolor  szerocolor 
global   syndromecolor receivedcolor
set textx 3
set texty 3
global errorcolor ; set errorcolor "red"
global brighterrorcolor ; set brighterrorcolor "orange"
global brightnoisecolor ; set brightnoisecolor "orange1"
set canvascolor "#000052d052ef"
global backgroundcol ; set backgroundcol gray90 ; set backgroundcol $canvascolor
set textcolor green1
set transmitcolor gold1
set decodecolor gold1
set zerocolor gray
set noisecolor red
set szerocolor white
set syndromecolor purple1
set syndromecolor slateblue1
set syndromecolor cyan1
set receivedcolor green
set inferrednoisecolor "deeppink1"
set inferrednoisecolor "pink1"
# gray50: smaller is darker.
# check.tcl --

# answered qs
# how to make buttons inactive (grey) -state inactive
# rand
# how to list multiple commands to associate with a button? can put them in quotes separated by ";"

# questions: high priority
# how to get help on functions? Sometimes man xxxx produces the C page for xxxx
#  instead of the tcl page -- man n open
# how to get things to happen in my order visibly and immediately?
# how to bind an entire frame (including its contents) -- I find that
#       buttons in my frame will hog an action even if they don't respond
#       to it. bindtags command tells the order of binding of widgets.
#              need to know about widget classes USEFUL!

# medium
# how to bind leaving-scale (fn) to the dons command?
# spacers inbetween frames?
# why do I need to declare some things global
#  and others not (eg $syndrome.msg flash
#   worked fine when syndrome was actually
#  high level, (top) but not when I put it in 
#   antoher frame

# low priority
# how to invoke the command that pushing a check button causes
#       *without* changing its state?
# why did my if ($...) not work, and my if {$verbose} work?
# how to make text arranged in new lines in a frame (without making subframes)
# (e.g. I want to pack things at l.h.s.)

set top .
if {$ownwindow>=1} {
    wm title . "(7,4) Hamming Code Demonstration"
    wm iconname . "hamming"
    wm geometry . +10+10
}

############################ canvas stuff
set canvasescreated 1 ;# not to be confused with doingcanvases
set w ""
frame $w.canvases 
set w $w.canvases
set canvases $w
# make a canvas for the 7,4 case
# encoder and syndrome
set ce $w.ce
set cs $w.cs
set cn $w.cn
set ct $w.ct
# circle color
set red gray45

foreach c [list $ct $cn $cs $ce] {
    canvas $c -width 195 -height 195 -background $canvascolor
}

foreach c [list $ct $cn $cs $ce] {
# the three parity discs
    # circles hoops
    $c create oval 10 185  130 65 -outline $red -width 10 -tags z3
    $c create oval 190 185 70 65 -outline $red -width 10 -tags z2
    $c create oval 40 10 160 130 -outline $red -width 10 -tags z1

    set wi 10
    $c create oval [expr 60+$wi] [expr 85+$wi] [expr 60-$wi] [expr 85-$wi] -fill lightgray -tags t1
    $c create text 60 85 -text s1 -tags r1 
    $c create oval [expr 140+$wi] [expr 85+$wi] [expr  140-$wi] [expr 85-$wi]  -fill lightgray -tags t2
    $c create text 140 85 -text s2 -tags r2 
    $c create oval [expr 100+$wi] [expr 105+$wi] [expr 100-$wi] [expr 105-$wi]  -fill lightgray -tags t3
    $c create text 100 105 -text s3 -tags r3 
    $c create oval [expr 100+$wi] [expr 150+$wi] [expr 100-$wi] [expr 150-$wi]  -fill lightgray -tags t4
    $c create text 100 150 -text s4 -tags r4
    $c create oval [expr 100+$wi] [expr 40+$wi] [expr  100-$wi] [expr 40-$wi]  -fill lightgray -tags t5 
    $c create text 100 40 -text t5 -tags r5 
    $c create oval [expr 160+$wi] [expr 140+$wi] [expr 160-$wi] [expr 140-$wi]  -fill lightgray -tags t6
    $c create text 160 140 -text t6 -tags r6 
    $c create oval [expr 50+$wi] [expr 140+$wi] [expr  50-$wi] [expr 140-$wi]  -fill lightgray -tags t7
    $c create text 50 140 -text t7 -tags r7 
}
set font "Courier 20"
$ct create text $textx $texty -text Transmitted -anchor nw -fill $textcolor   -font $font
$cn create text $textx $texty -text Noise -anchor nw -fill $textcolor  -font $font
$cs create text $textx $texty -text Received -anchor nw -fill $textcolor  -font $font
$ce create text $textx $texty -text Decoded -anchor nw -fill $textcolor  -font $font
#$ct create text 0 0 -text Transmitted -anchor nw -fill $transmitcolor   -font $font
#$cn create text 0 0 -text Noise -anchor nw -fill $noisecolor  -font $font
#$cs create text 0 0 -text Received -anchor nw -fill $receivedcolor  -font $font
#$ce create text 0 0 -text Decoded -anchor nw -fill $decodecolor  -font $font

# add an extra disc to the syndrome dude, to represent y$i, and to the error panel.
foreach c [list $cs $ce] {
    set wi 10
    $c create oval [expr 60+$wi] [expr 85+$wi] [expr 60-$wi] [expr 85-$wi] -outline lightgray -tags y1 -width 0
    $c create oval [expr 140+$wi] [expr 85+$wi] [expr  140-$wi] [expr 85-$wi]  -outline lightgray -tags y2  -width 0
    $c create oval [expr 100+$wi] [expr 105+$wi] [expr 100-$wi] [expr 105-$wi]  -outline lightgray -tags y3 -width 0
    $c create oval [expr 100+$wi] [expr 150+$wi] [expr 100-$wi] [expr 150-$wi]  -outline lightgray -tags y4 -width 0
    $c create oval [expr 100+$wi] [expr 40+$wi] [expr  100-$wi] [expr 40-$wi]  -outline lightgray -tags y5  -width 0
    $c create oval [expr 160+$wi] [expr 140+$wi] [expr 160-$wi] [expr 140-$wi]  -outline lightgray -tags y6 -width 0
    $c create oval [expr 50+$wi] [expr 140+$wi] [expr  50-$wi] [expr 140-$wi]  -outline lightgray -tags y7 -width 0
}

foreach i {1 2 3 4 5 6 7} {
    $cs itemconfig r$i -text r$i
    $cn itemconfig r$i -text n$i
    $ce itemconfig r$i -text "<$i>"
}
####################################################################
# define buttons and status
####################################################################
set w ""

frame $w.status ; set status $w.status
frame $w.buttons ; set buttons $w.buttons
#
# make a noise level
#
global fn
scale $status.fn -orient vertical -length 184 -from 0 -to 0.5 \
	-variable fn -tickinterval 0.1 -resolution 0.01 -bigincrement 0 \
	-label "Noise level"
scale $w.buttons.fn -orient horizontal -length 200 -from 0 -to 0.5 \
	-variable fn -tickinterval 0 -resolution 0.01 -bigincrement 0 \
	-label "Noise level"
set fn 0.1
# -command {dons $fn}
# note scale automatically passes its value to the command
# but a plain "-command" gets executed every time the scale is touched
#   rather than when it is set and left alone.

button $w.buttons.dismiss -text Quit -command "destroy ."
button $w.buttons.dismiss2 -text Quit -command "destroy ."
button $w.buttons.activateall -text "Systems on" -command {systemson ; dots}
button $w.buttons.unactivate -text "Systems off" -command systemsoff
button $w.buttons.allzero -text "All Zero" -command allzero
bind . <z> allzero
bind . <q> {destroy .} 
bind . <Control-c> {destroy .} 
global doingcanvases ; set doingcanvases 0
checkbutton $w.buttons.canvas -variable doingcanvases -command canvaspack -text "show figure"
#
pack   $w.buttons.dismiss  -side right
pack $w.buttons.dismiss2 $w.buttons.activateall $w.buttons.unactivate $w.buttons.allzero $w.buttons.canvas $w.buttons.fn  -side left -padx 4

pack  $status -side bottom -fill x -pady 2m
pack $w.buttons  -side top -fill x -pady 2m

proc systemson { } {
    global doingtransmit ; set doingtransmit 1 ;
    global doingsyndrome ; set doingsyndrome 1
    global doingreceive ; set doingreceive 1
    global doinginfer ; set doinginfer 1
    global doingdecode ; set doingdecode 1
    global doingerror ; set doingerror 1
}
proc systemsoff { } {
    global doingtransmit ; set doingtransmit 0
    global doingsyndrome ; set doingsyndrome 0
    global doingreceive ; set doingreceive 0
    global doinginfer ; set doinginfer 0
    global doingdecode ; set doingdecode 0
    global doingerror ; set doingerror 0
}
systemsoff
# systemson
global Z Noise ; set Noise 0 ; set Z 0 
global noisevec ; set noisevec 1
global totalerror ; set totalerror 0
global P N K M 
global latestchanged ; set latestchanged 0 
global noisemethod ; set noisemethod singlet

###############################################################
#
#               Status
#
###############################################################
#
# make a column of status buttons
#
frame $status.buttons  -relief groove -borderwidth 2
set statusb $w.status.buttons
pack $statusb -side left -anchor ne

# label $statusb.msg  -justify center -text "Status" -pady 15
# pack $statusb.msg  -side top

checkbutton $statusb.t -text "encode immediately" -variable doingtransmit -command {if $doingtransmit dots}

frame $statusb.noise
label $statusb.noise.l -text "Noise generation:"
pack $statusb.noise.l  -side left -pady 2 -anchor w
foreach i {zero singlet cycle random} {
    radiobutton $statusb.noise.b$i -text "$i" -variable noisemethod \
	    -relief flat -value $i -command {dons $fn}
    pack  $statusb.noise.b$i  -side left -pady 2 -anchor w
}

checkbutton $statusb.r -text "transmit immediately" -variable doingreceive -command {if $doingreceive dors}
checkbutton $statusb.z -text "syndrome" -variable doingsyndrome -command {if $doingsyndrome dozs}
checkbutton $statusb.y -text "infer immediately" -variable doinginfer -command {if $doinginfer doys}
checkbutton $statusb.x -text "decode immediately" -variable doingdecode -command {if $doingdecode doxs}
checkbutton $statusb.e -text "errors" -variable doingerror -command {if $doingerror does}
# spacer here
checkbutton $statusb.flashy -text "flashy" -variable flashy 
# whether things flash when updated

pack $statusb.t $statusb.noise  $statusb.r $statusb.z $statusb.y $statusb.x  $statusb.e $statusb.flashy -side top -anchor w -padx 30
#
# make a syndrome record and number of errors
#
frame $status.numbers -relief groove -borderwidth 4 
set n $status.numbers
if { $verbose >= 2 } {
    label $n.nnn -text "Noise number: "
    label $n.nn -textvariable noisevec
    pack $n.nnn $n.nn -side top -fill x -expand 1 -pady 3
}
label $n.nl -text "Noise flipped: "
label $n.n -textvariable Noise
pack $n.nl $n.n -side top -fill x -expand 1 -pady 3
label $n.zl -text "Syndrome: "
label $n.z -textvariable Z 
pack $n.zl $n.z -side top -fill x -expand 1 -pady 3
label $n.el -text "Errors: "
label $n.e -textvariable totalerror
pack $n.el $n.e -side top -fill x -expand 1 -pady 3
# 
# put fn and numbers 
#
pack $w.status.fn $n -side left -anchor center -padx 10
# $w.status bind fn <Any-Leave> {dons $fn}

###############################################################
#
#               Code definition
#
###############################################################
set N 7
set K 4
set M [expr $N-$K]

# Main packing:
# label .msg -wraplength 4i -justify center -text "($N,$K) Hamming Code" -padx 5 -pady 5
# pack .msg -side top
pack $ct $cn $cs $ce -side left -fill y
proc canvaspack { } {
    global canvases ; global doingcanvases 
    global status , buttons , N 
    if $doingcanvases {
	pack $canvases -side top -fill y -before $status -after $buttons
#	transfers $N ; transfern ; transferr ; transfery ; transfere ; transferz 
	alltransfer 
    } else {
	pack forget $canvases
    }
}
set bo 2
frame .encoder -relief groove -borderwidth $bo 
frame .encoder.source  -background $backgroundcol
frame .encoder.transmit  -background  $backgroundcol
set source   .encoder.source 
set transmit .encoder.transmit

frame .noise  -relief flat -borderwidth $bo -background $backgroundcol
set noise .noise

frame .decoder -relief groove -borderwidth $bo -background $backgroundcol
frame .decoder.receive   -background $backgroundcol
frame .decoder.syndrome -background $backgroundcol
frame .decoder.decodey -background $backgroundcol
frame .decoder.decodex -background $backgroundcol
set receive  .decoder.receive  
set syndrome .decoder.syndrome
set decodey  .decoder.decodey
set decodex  .decoder.decodex

frame .error  -relief flat -borderwidth $bo -background $backgroundcol
set error .error

pack  $source $transmit \
    -side left -fill y
pack  .encoder .noise .decoder .error \
    -side left -fill y -padx 6
pack   $receive $syndrome $decodey $decodex \
    -side left -fill y

# generator matrix's parity block
set p "1 1 1 0   0 1 1 1  1 0 1 1"
set i -1 ;
for {set m 1} {$m<=$M} {incr m} {
    for {set k 1} {$k<=$K} {incr k} {
	incr i
	set P($m,$k) [lindex $p $i]
	if {$verbose>=2} {puts $P($m,$k)}
    }
}


###############################################################
#
#               The vectors headings
#
###############################################################
set w $source
button $w.msg  -justify left -text "Source bits" -command {doss 0.5}
pack $w.msg -side top

set w $transmit
button $w.msg  -justify left -text "Transmitted" -command dots
bind $w <1>  dots ;# any click here activates dots
bind . t dots     ;# and pressing t anywhere
bind $w <2> "$statusb.t invoke" 
bind $w.msg <2> "$statusb.t invoke"   ;# this is a pain!
pack $w.msg -side top

set w $noise
button $w.msg  -justify left -text "Noise" -command {dons $fn}
pack $w.msg -side top

set w $receive
button $w.msg  -justify left -text "Received" -command dors
bind $w <2> "$statusb.r invoke" 
pack $w.msg -side top

set w $syndrome
button $w.msg  -justify left -text "Syndrome" -command  dozs
bind $w <2> "$statusb.z invoke" 
pack $w.msg -side top

set w $decodey
button $w.msg  -justify left -text "Inferred noise"  -command doys
bind $w <2> "$statusb.y invoke"
pack $w.msg -side top

set w $decodex
button $w.msg  -justify left -text "Decoded message"  -command doxs
bind $w <2> "$statusb.x invoke"
pack $w.msg -side top

set w $error
button $w.msg  -justify left -text "Errors" -command does
bind $w <2> "$statusb.e invoke" 
pack $w.msg -side top

###############################################################
#
#               Vectors
#
###############################################################


proc alltransfer { } {
    global N
    transfers $N ; transfern ; transferr ; transfery; transferx ; transfere ; transferz 
}
proc allzero { } {
    global K N M 
    for {set k 1} {$k<=$K} {incr k} {
	global s$k
	set s$k 0
    }
    for {set k 1} {$k<=$N} {incr k} {
	global x$k e$k y$k
	set x$k 0 ;	set e$k 0 ;	set y$k 0
	global t$k n$k r$k
	set t$k 0 ; set n$k 0 ; set r$k 0 
    }
    for {set k 1} {$k<=$M} {incr k} {
	global z$k
	set z$k 0 
    }
    global canvasescreated ; if { $canvasescreated }  {
	alltransfer
    }
}

# make the buttons for the vectors
# source buttons

set w $source
set command "pack"
for {set k 1} {$k<=$K} {incr k} {
    checkbutton $w.s$k -text "s$k" -variable s$k -relief flat -command { if $doingcanvases "transfers $K"; if $doingtransmit dots} -selectcolor $transmitcolor  -background  $backgroundcol -fg  $transmitcolor
    append command " \$w.s$k"
}
append command " -side top -pady 2 -anchor w"
eval $command

#############################################
# more canvases stuff - bind the s dots to be like s buttons
if { $canvasescreated } {
    foreach i {1 2 3 4} {
	$ct bind t$i <1> "$w.s$i toggle ; transfers $K ; if \$doingtransmit dots"
	$ct bind r$i <1> "$w.s$i toggle ; transfers $K ; if \$doingtransmit dots"
    }
}
#############################################

set w $transmit
set command "pack"
for {set k 1} {$k<=$N} {incr k} {
    checkbutton $w.t$k -text "t$k" -variable t$k -relief flat -command "oi transmitted; dots" -selectcolor $transmitcolor -highlightcolor "gray50"  -background $backgroundcol  -fg  $transmitcolor
    append command " \$w.t$k"
}
append command " -side top -pady 2 -anchor w"
eval $command

set w $noise
set command "pack"
for {set k 1} {$k<=$N} {incr k} {
    checkbutton $w.n$k -text "n$k" -variable n$k -relief flat -command {if $doingcanvases transfern; if $doingreceive dors} -selectcolor $noisecolor -background $backgroundcol  -fg  $brightnoisecolor
    append command " \$w.n$k"
}
append command " -side top -pady 2 -anchor w"
eval $command

###################### canvas stuff
if { $canvasescreated } {
    foreach i {1 2 3 4 5 6 7} {
	$cn bind t$i <1> "$w.n$i toggle ; countNoise ; transfern  ; if \$doingreceive dors"
	$cn bind r$i <1> "$w.n$i toggle ; countNoise ; transfern  ; if \$doingreceive dors"
    }
}
######################################

set w $receive          ;# set up the r buttons
set command "pack"
for {set k 1} {$k<=$N} {incr k} {
    checkbutton $w.r$k -text "r$k" -variable r$k -relief flat -command "oi received;  dors"   -highlightcolor "gray70" -selectcolor $receivedcolor -background $backgroundcol  -fg  $receivedcolor
    append command " \$w.r$k"  
}
append command " -side top -pady 2 -anchor w"
eval $command

set w $syndrome
set command "pack"
for {set k $M} {$k>=1} {incr k -1} {
    checkbutton $w.z$k -text "z$k" -variable z$k -relief flat -command "oi syndrome; dozs" -selectcolor $syndromecolor -background $backgroundcol   -fg  $syndromecolor
    append command " \$w.z$k"
}
append command " -side bottom -pady 2 -anchor w"
eval $command

set w $decodex
set command "pack"
for {set k 1} {$k<=$N} {incr k} {
    checkbutton $w.x$k -text "<t$k>" -variable x$k -relief flat -command "oi decoded; doxs" -selectcolor $decodecolor -background $backgroundcol   -fg  $decodecolor
    append command " \$w.x$k"
}
append command " -side top -pady 2 -anchor w"
eval $command

set w $decodey
set command "pack"
for {set k 1} {$k<=$N} {incr k} {
    checkbutton $w.y$k -text "<n$k>" -variable y$k -relief flat -command "oi inferred; doys" -selectcolor $inferrednoisecolor -background $backgroundcol   -fg  $inferrednoisecolor
    append command " \$w.y$k"
}
append command " -side top -pady 2 -anchor w"
eval $command

set w $error
set command "pack"
for {set k 1} {$k<=$N} {incr k} {
    checkbutton $w.e$k -text "e$k" -variable e$k -relief flat -command "oi error; does" -selectcolor $errorcolor -background $backgroundcol   -fg  $brighterrorcolor
    append command " \$w.e$k"
}
append command " -side top -pady 2 -anchor w"
eval $command


###############################################################
#
#               Update rules
#
###############################################################

# this does the t's to their values
proc dots { } {
    global transmit
    global verbose ; if {$verbose>=2} {puts "entering dots"}
    global N M K P p doingreceive

    for {set k 1} {$k<=$K} {incr k} {
	global s$k
    }
    for {set k 1} {$k<=$N} {incr k} {
	global t$k
    }
    # show visually that we are redoing t
    global flashy ;    if { $flashy } {    $transmit.msg flash }
    for {set k 1} {$k<=$K} {incr k} {
	set t$k [set s$k]
    }
    for {set m 1} {$m<=$M} {incr m} {
	set mm [expr $m + $K]
	set t$mm 0 ; 
	for {set k 1} {$k<=$K} {incr k} {
	    set t$mm [expr ([set t$mm] ^ ($P($m,$k)&[set s$k]))]
	}
    }
    global doingcanvases ; if { $doingcanvases } {
	transfers $N
    }
    update idletasks ;# to force things to happen
    set latestchanged 1
    if $doingreceive dors
}

################################### these copy bits to the canvas elements
proc transfers { NN } {
    global transmitcolor decodecolor zerocolor 
    global ct ; global N ; global K
    for {set k 1} {$k<=$K} {incr k} {
	global s$k 
    }
    for {set k 1} {$k<=$N} {incr k} {
	global t$k 
    }
    for {set k 1} {$k<=$NN} {incr k} {
	if {$k<=$K} {	set this [set s$k]  } else { set this [set t$k] }
#	puts $this
	# WAS  [expr "$this ? $transmitcolor : $zerocolor" ]
#	set query 
#	puts $query
	$ct itemconfig t$k -fill   [expr {$this ? $transmitcolor : $zerocolor} ]
    }
}

proc transferr { } {
    global transmitcolor decodecolor zerocolor receivedcolor
    global cs  ; global N
    for {set k 1} {$k<=$N} {incr k} {
	global r$k
    }
    for {set m 1} {$m<=$N} {incr m} {
	$cs itemconfig t$m -fill  [expr {[set r$m] ? $receivedcolor : {gray} } ]
    }
}
proc transfern { } {
    global transmitcolor decodecolor zerocolor 
    global cn ; global N
    for {set k 1} {$k<=$N} {incr k} {
	global n$k
    }
    for {set m 1} {$m<=$N} {incr m} {
	$cn itemconfig t$m -fill  [expr {[set n$m] ? {red} : {gray} } ]
    }
}
proc transferz { } {
    global transmitcolor decodecolor szerocolor syndromecolor
    global cs ; global M
    for {set k 1} {$k<=$M} {incr k} {
	global z$k
    }
    for {set m 1} {$m<=$M} {incr m} {
	$cs itemconfig z$m -outline  [expr {[set z$m] ? $syndromecolor : $szerocolor } ]
    }
}
# y isthe name forthehypothesized noise
proc transfery { } {
    global transmitcolor decodecolor zerocolor receivedcolor
    global cs ; global N
    for {set k 1} {$k<=$N} {incr k} {
	global y$k
    }
    for {set m 1} {$m<=$N} {incr m} {
	$cs itemconfig y$m -outline  [expr {[set y$m] ? {deeppink1} : $zerocolor } ] 
	$cs itemconfig y$m -width   [expr {[set y$m] ? {6} : {0} } ] 
    }
}
proc transfere { } {
    global transmitcolor decodecolor zerocolor errorcolor
    global ce ; global N
    for {set k 1} {$k<=$N} {incr k} {
	global e$k
    }
    for {set m 1} {$m<=$N} {incr m} {
	$ce itemconfig y$m -outline  [expr {[set e$m] ? $errorcolor : {white} } ] 
	$ce itemconfig y$m -width   [expr {[set e$m] ? {6} : {2} } ] 
# make errors show up a lot
    }
}
proc transferx { } {
    global transmitcolor decodecolor zerocolor 
    global ce ; global N
    for {set k 1} {$k<=$N} {incr k} {
	global x$k
    }
    for {set m 1} {$m<=$N} {incr m} {
	$ce itemconfig t$m -fill [expr {[set x$m] ? $decodecolor : $zerocolor}]
    }
}

###################################
# this makes a random s
proc doss { fn } {
    global verbose ; if {$verbose>=2} {puts "entering doss"}
    global N M K P p doingtransmit
    for {set k 1} {$k<=$K} {incr k} {
	global s$k
    }
    # end of declarations
    # show visually that we are redoing s
    global flashy ;    if { $flashy } {    $source.msg flash }
    for {set k 1} {$k<=$K} {incr k} {
	set s$k [expr (rand())>$fn ? 0:1 ]
    }
    global doingcanvases ; if { $doingcanvases } {
	transfers $K
    }
    update idletasks ;# to force things to happen
    if $doingtransmit dots
}
proc countNoise { } {
    global Noise N
    for {set k 1} {$k<=$N} {incr k} {
	global n$k
    }
    set Noise 0 
    for {set k 1} {$k<=$N} {incr k} {
	if [set n$k] {incr Noise}
    }
}
# this makes n
proc dons { fn } {
    global noise
    global verbose ; if {$verbose>=2} {puts "entering dons"}
    global N M K P p doingreceive Noise noisevec noisemethod
    for {set k 1} {$k<=$N} {incr k} {
	global n$k
    }
    # end of declarations
    # show visually that we are redoing n
    global flashy ;    if { $flashy } {    $noise.msg flash }
    for {set k 1} {$k<=$N} {incr k} {
	set n$k 0
    }
    incr noisevec
    if {$verbose>=2} { puts "noisevec = $noisevec" }
    switch $noisemethod {
	singlet {
	    if {$verbose>=2} {puts "singlet noisevec = $noisevec"}
	    if {$noisevec>$N} {set noisevec 0}
	    if {$noisevec>0} { set n$noisevec 1 }
	}
	cycle { 
	    set noi $noisevec
	    for {set k 1} {$k<=$N} {incr k} {
		set n$k [expr $noi%2]
		set noi [expr $noi/2]
	    }
	}
	random {
	    for {set k 1} {$k<=$N} {incr k} {
		set n$k [expr (rand())>$fn ? 0:1 ]
	    }
	}
	one {
	    for {set k 1} {$k<=$N} {incr k} {
		set n$k 1
	    }
	}
	zero {
	}
    }
    countNoise
#    set Noise 0 
#    for {set k 1} {$k<=$N} {incr k} {
#	if [set n$k] {incr Noise}
#    }
    global doingcanvases ; if { $doingcanvases } {
	transfern
    }
    update idletasks ;# to force things to happen
    if $doingreceive dors
}

global RAND_MAX ; set RAND_MAX 1000
proc ranu { } {
    set ret 1
# [expr (rand())]
#    set ret [expr (rand()/(RAND_MAX+1.0));
    return $ret
}

# this does the r's to their values
proc dors { } {
    global receive
    global verbose ; if {$verbose>=2} {puts "entering dors"}
    global N M K P p doingsyndrome

    # show visually that we are redoing 
    global flashy ;    if { $flashy } {    $receive.msg flash }
    for {set k 1} {$k<=$N} {incr k} {
	global t$k r$k n$k
    }
    for {set k 1} {$k<=$N} {incr k} {
	set r$k [expr [set t$k]^[set n$k]]
    }
    global doingcanvases ; if { $doingcanvases } {
	transferr
    }
    set latestchanged 2
    update idletasks ;# to force things to happen
    if $doingsyndrome dozs
}

# this does the z's to their values
proc dozs { } {
    global syndrome
    global verbose ; if {$verbose>=2} {puts "entering dozs"}
    global N M K P p doinginfer Z

    # show visually that we are redoing 
    global flashy ;    if { $flashy } {    $syndrome.msg flash }
    for {set k 1} {$k<=$M} {incr k} {
	global z$k
    }
    for {set k 1} {$k<=$N} {incr k} {
	global r$k
    }
    set Z 0 ; set factor 1 ;# Z will contain the binary repn of the whole syndrome
    for {set m 1} {$m<=$M} {incr m} {
	set mm [expr $m + $K]
	set z$m [set r$mm] ; 
	for {set k 1} {$k<=$K} {incr k} {
	    set z$m [expr ([set z$m] ^ ($P($m,$k)&[set r$k]))]
	}
	incr Z [expr [set z$m]*$factor]
	set factor ($factor*2)
    }
    global doingcanvases ; if { $doingcanvases } {
	transferz
    }
    set latestchanged 2
    if {$verbose>=1} {puts "syndrome is $Z"}
    update idletasks ;# to force things to happen
    if $doinginfer doys
}
proc doys { } {
    global decodey
    global verbose ; if {$verbose>=2} {puts "entering doys"}
    global N M K P p doingdecode Z

    # show visually that we are redoing 
    global flashy ;    if { $flashy } {    $decodey.msg flash }
    for {set k 1} {$k<=$M} {incr k} {
	global z$k
    }
    for {set k 1} {$k<=$N} {incr k} {
	global r$k y$k
    }
    # how to do the decoding if we ignore the parity bits
    for {set m 1} {$m<=$N} {incr m} {
	set y$m 0 
    }
    # we need a ML decoder here!
    if {($N == 7)&&($K == 4)} {
	switch $Z {
	    0 { }
	    1 { flip 5 }
	    2 { flip 6 }
	    3 { flip 2 }
	    4 { flip 7 }
	    5 { flip 1 }
	    6 { flip 4 }
	    7 { flip 3 }
	}
    } else {
	puts "Don't know a decoder for N=$N, K=$K"
    }
    global doingcanvases ; if { $doingcanvases } {
	transfery
    }
    update idletasks ;# to force things to happen
    if $doingdecode doxs
}

proc flip { n } {
    global y$n
    set y$n 1 
}

proc doxs { } {
    global decodex
    global verbose ; if {$verbose>=2} {puts "entering doxs"}
    global N M K P p doingerror Z

    # show visually that we are redoing 
    global flashy ;    if { $flashy } {    $decodex.msg flash }
    for {set k 1} {$k<=$N} {incr k} {
	global r$k x$k y$k
    }
    # how to do the decoding if we ignore the parity bits
    for {set m 1} {$m<=$N} {incr m} {
	set x$m [expr [set r$m]^[set y$m]]
    }
    global doingcanvases ; if { $doingcanvases } {
	transferx
    }
    update idletasks ;# to force things to happen
    if $doingerror does
}

proc does { } {
    global error
    global verbose ; if {$verbose>=2} {puts "entering does"}
    global N M K P p totalerror

    # show visually that we are redoing 
    global flashy ;    if { $flashy } {    $error.msg flash }

    for {set k 1} {$k<=$N} {incr k} {
	global x$k t$k e$k
    }
    set totalerror 0 
    for {set m 1} {$m<=$N} {incr m} {
	set e$m [expr [set x$m]^[set t$m]] ; 
	incr totalerror [set e$m]
    }
    global doingcanvases ; if { $doingcanvases } {
	transfere
    }
    if {$verbose>=2} {puts "Number of errors: $totalerror"}
    update idletasks ;# to force things to happen
}

proc oi { s }  {
    puts "you can't change the $s bits directly"
}

allzero
.buttons.canvas select
canvaspack
# invokes canvaspack andsets variable