exec wish $0 ${1+"$@"}
package require Tk
proc ReadFile fn {
global Data P0
set i 0
set Comment 0
set nData 0
set fp [open $fn r]
fconfigure $fp -buffering line
gets $fp Line
while {$Line ne {}} {
incr i 1
set Line [string trim $Line]
switch -- [string index $Line 0] {
default {
incr nData 1
set w 0
set D {}
foreach Word [split $Line { }] {
if {$Word ne {}} {
if {$w == 0} {
set Key $Word
} else {
set Val grey
catch { set Val $::ColorTab($Word) }
lappend D $Val
}
incr w 1
}
}
set Data($nData) $D
}
}
gets $fp Line
}
close $fp
puts "#EOF: $nData = [array size Data]"
return [array size Data]
}
set ::pi [expr {atan(1)*4}]
proc translation {dx dy} {list 1 0 0 1 $dx $dy}
proc reflect-y {} {list 1 0 0 -1 0 0}
proc reflect-x {} {list -1 0 0 1 0 0}
proc shear {sx sy} {list 1 $sx $sy 1 0 0}
proc rotation {angle {units radians}} {
global pi
switch -- $units {
d - de - deg - degr - degre - degree - degrees {
set angle [expr {double($angle)/180*$pi}]
}
g - gr - gra - grad - gradi - gradie - gradien -
gradient - gradients { # I think I've spelt this one right...
set angle [expr {double($angle)/200*$pi}]
}
r - ra - rad - radi - radia - radian - radians {
}
default {
return -code error "unknown angle unit \"$units\": \
must be one of degrees, gradients or radians"
}
}
list [expr { cos($angle)}] [expr {sin($angle)}] \
[expr {-sin($angle)}] [expr {cos($angle)}] 0 0
}
proc apply_affine {transform args} {
if {[llength $args]==1} {set args [lindex $args 0]}
set result [list]
foreach {a b c d e f} $transform {break}
foreach {x y} $args {
lappend result [expr {$a*$x+$b*$y+$e}] [expr {$c*$x+$d*$y+$f}]
}
return $result
}
proc combine_affine {transform args} {
foreach {a b c d e f} $transform {break}
foreach xform $args {
foreach {i j k l m n} $xform {break}
foreach {a b c d e f} [list \
[expr {$a*$i+$c*$j}] [expr {$b*$i+$d*$j}] \
[expr {$a*$k+$c*$l}] [expr {$b*$k+$d*$l}] \
[expr {$e*$i+$f*$j+$m}] [expr {$e*$k+$f*$l+$n}]] break
}
list $a $b $c $d $e $f
}
proc ReadPic {w fn} {
set midX [expr { $::maxX / 2 }]
set midY [expr { $::maxY / 2 }]
catch {image delete $im1}
set im1 [image create photo -file $fn]
$w create image $midX $midY -image $im1 -tags {all img}
}
proc DrawDots w {
set i 0
foreach {x1 y1} { 90 80 120 80 150 80 180 80
90 110 120 110 150 110 180 110
90 140 120 140 150 140 180 140
90 170 120 170 150 170 180 170
90 200 120 200 150 200 180 200 210 200} {
set nr [lindex {Fz Cz Pz FP1 FP2 F7 F3 F4 F8 T3 C3 C4 T4 \
T5 P3 P4 T6 O1 O2 A1 A2} $i]
set xx [expr { $x1 + 15 }]
set yy [expr { $y1 + 15 }]
$w create oval $x1 $y1 $xx $yy -fill white -tags [list all $nr]
incr i 1
}
}
proc DrawHead1 w {
set x1 32
set y1 40
set x2 [expr { $x1 + 220 }]
set y2 [expr { $y1 + 220 }]
$w create oval $x1 $y1 $x2 $y2 -fill $::Fill -tags [list all Head1]
$w create poly [expr { $x1 + 94 }] [expr { $y1 + 1 }] \
[expr { $x1 +111 }] [expr { $y1 - 13 }] \
[expr { $x1 +111 }] [expr { $y1 - 13 }] \
[expr { $x1 +125 }] [expr { $y1 + 1 }] \
-fill $::Fill -tags [list all Head1]
$w create line [expr { $x1 + 94 }] [expr { $y1 + 1 }] \
[expr { $x1 +111 }] [expr { $y1 - 13 }] \
-tags [list all Head1]
$w create line [expr { $x1 +111 }] [expr { $y1 - 13 }] \
[expr { $x1 +125 }] [expr { $y1 + 1 }] \
-tags [list all Head1]
$w create rect [expr { $x1 - 4 }] [expr { $y1 + 90 }] \
[expr { $x1 + 2 }] [expr { $y1 +122 }] \
-fill $::Fill -tags [list all Head1]
$w create rect [expr { $x1 +219 }] [expr { $y1 + 90 }] \
[expr { $x1 +225 }] [expr { $y1 +122 }] \
-fill $::Fill -tags [list all Head1]
foreach {nr x1 y1} {Fz 135 95 Cz 135 142 Pz 135 192
FP1 106 60 FP2 166 60
F7 66 90 F3 100 100
F4 170 100 F8 206 90
T3 50 140 C3 90 140
C4 185 140 T4 225 140
T5 66 195 P3 95 185
P4 175 185 T6 205 195
O1 108 225 O2 165 225
A1 10 130 A2 260 130} {
set x2 [expr { $x1 + 15 }]
set y2 [expr { $y1 + 15 }]
$w create oval $x1 $y1 $x2 $y2 -fill white -tags [
list all $nr Head1]
set xT [expr { $x1 + 8 }]
set yT [expr { $y1 + 21 }]
$w create text $xT $yT -text $nr -tags [list all Head1]
}
}
proc HeadPoints {} {
lappend H 63 251 65 235 66 220 62 207 50 192 \
44 180 35 158 33 139 38 124 48 96 \
77 62 106 52 149 47 186 58 205 70 \
223 93 231 134 226 146 256 180 258 186 \
240 197 241 214 229 218 243 222 239 228 \
234 247 213 257 202 262 195 266 190 274
return $H
}
proc DrawHead2 w {
set x [expr { $::maxX / 2 }]
set y [expr { $::maxY / 2 }]
set HeadCoords1 [HeadPoints]
set xform [combine_affine [translation -$x -$y] [reflect-x] [
translation $x $y]]
set HeadCoords2 [apply_affine $xform $HeadCoords1]
$w create poly $HeadCoords2 -outline red -fill $::Fill \
-tags {all Head2}
foreach {nr x1 y1} {Fz 100 50 Cz 170 45 Pz 230 85
FP1 66 106
C3 160 80 T3 146 140
F3 108 85 F7 98 126
P3 208 103 T5 202 150
O1 233 145
A1 135 200} {
set x2 [expr { $x1 + 15 }]
set y2 [expr { $y1 + 15 }]
$w create oval $x1 $y1 $x2 $y2 -fill white -tags [
list all $nr Head2]
set xT [expr { $x1 + 8 }]
set yT [expr { $y1 + 20 }]
$w create text $xT $yT -text $nr -tags [list all Head2]
}
}
proc DrawHead3 w {
$w create poly [HeadPoints] -outline black -fill $::Fill -tags {all Head3}
foreach {nr x1 y1} {Fz 180 50 Cz 100 45 Pz 43 88
FP2 208 108
C4 115 85 T4 130 138
P4 66 106 F8 180 120
F4 170 85 T6 77 146
O2 45 150
A2 140 200} {
set x2 [expr { $x1 + 15 }]
set y2 [expr { $y1 + 15 }]
$w create oval $x1 $y1 $x2 $y2 -fill white -tags [
list all $nr Head3]
set xT [expr { $x1 + 8 }]
set yT [expr { $y1 + 20 }]
$w create text $xT $yT -text $nr -tags "all Head3"
}
}
proc ClrCanvas {} {
foreach w {.cA .cB .cC .cD} {$w delete all}
}
proc ColorAllDots c {
foreach {nr} {Fz Cz Pz
FP1 FP2
F7 F3 F4 F8
T3 C3 C4 T4
T5 P3
P4 T6
O1 O2
A1 A2} {
foreach w {.cA .cB .cC .cD} {$w itemconfig $nr -fill $c}
}
}
proc ColorDots Colors {
ColorAllDots white
set i 0
foreach {nr} {Fz Cz Pz FP1 FP2 F7 F3 F4 F8
T3 C3 C4 T4 T5 P3 P4 T6 O1 O2 A1 A2} {
set c [lindex $Colors $i]
if {$c eq {}} {set c white}
foreach w {.cA .cB .cC .cD} { $w itemconfig $nr -fill $c }
incr i 1
}
}
proc NextSample inc {
global Data P0
set P $P0
if {[catch {incr P $inc}]} { StopAnimation; bell; return 1 }
set x [array get Data $P]
if {$x eq {}} {
StopAnimation
bell
return 1
} else {
set P0 $P
ColorDots $Data($P0)
return 0
}
}
proc every {ms body} {after $ms [namespace code [info level 0]]; try $body}
proc StartAnimation {} {
every 100 { NextSample +1 }
}
proc StopAnimation {} {
foreach id [after info] {after cancel $id}
}
proc Init {} {
global maxX maxY Data P0 ColorTab Fill Color P1 P2
set maxX 290
set maxY 290
array set ColorTab { a red b yellow d green t blue 0 white x grey }
set Fill {light yellow}
set Color blue
set Data(0) {}
set P0 NoData
set P1 {yellow gold goldenrod
blue green4
cyan SteelBlue1 green2 green
SteelBlue2 SteelBlue3 aquamarine SeaGreen1
DodgerBlue3 SteelBlue4 {lime green} {medium sea green}
magenta PaleGreen3
gray44 gray88
orange}
set P2 {OrangeRed2 red tomato
green4 blue
{medium sea green} PaleGreen3 cyan SteelBlue1
{lime green} green2 SteelBlue2 SteelBlue3
aquamarine SeaGreen1 DodgerBlue3 SteelBlue4
green magenta
grey black}
frame .f1
frame .f2
frame .f3
frame .f4
pack .f1 .f2 .f3 .f4
foreach {w} {.cA .cB .cC .cD} { canvas $w -width $maxX -height $maxY -bg white }
pack .cA .cB -in .f1 -side left
pack .cC .cD -in .f2 -side left
button .b1 -text Clear -command { ClrCanvas }
button .b2 -text Image -command { ReadPic .cA stampr1.gif }
button .b3 -text Dots -command { DrawDots .cA }
button .b4 -text Heads -command { DrawHead1 .cB; DrawHead2 .cC; DrawHead3 .cD }
label .-
button .b5 -text AllDots -command { ColorAllDots $Color }
button .b6 -text Pattern1 -command { ColorDots $P1 }
button .b7 -text Pattern2 -command { ColorDots $P2 }
label .nr -textvar P0
button .bF -text {Read File} -command { set P0 [ReadFile eeg2.txt] }
button .b0 -text Reset -command { set P0 0; NextSample 0 }
button .b- -text { - } -command { NextSample -1 }
button .b+ -text { + } -command { NextSample +1 }
button .bA -text Play -command { StartAnimation }
button .bS -text Stop -command { StopAnimation }
pack .b1 .b2 .b3 .b4 .- .b5 .b6 .b7 -in .f3 -side left -padx 2
pack .bF .b0 .b- .nr .b+ .bA .bS -in .f4 -side left -padx 2
bind . <Key-a> { ColorAllDots $Color }
bind . <Key-1> { ColorDots $P1 }
bind . <Key-2> { ColorDots $P2 }
bind . <Key-r> { set P0 [ReadFile "eeg2.txt"] }
bind . <Key-0> { set P0 0; NextSample 0 }
bind . <Key-minus> { NextSample -1 }
bind . <Key-KP_Subtract> { NextSample -1 }
bind . <Key-plus> { NextSample +1 }
bind . <Key-KP_Add> { NextSample +1 }
bind . <Return> { StartAnimation }
bind . <Key-space> { StopAnimation }
wm title . {Toy EEG}
focus -force .
}
Init
DrawDots .cA
DrawHead1 .cB
DrawHead2 .cC
DrawHead3 .cD
bind . <F1> { console show }
proc int x { expr int($x) }
bind .cD <Motion> {wm title . [int [%W canvasx %x]],[int [%W canvasy %y]]}
bind .cA <Motion> {wm title . [.cA itemcget current -tag ] }