#!/bin/sh
# Restart with tcl: -*- mode: tcl; tab-width: 4; -*- \
exec wish $0 ${1+"$@"}
# demo7-EEG.tcl - HaJo Gurt - 2005-12-26 - http://wiki.tcl.tk/15146
#: Demo - Toy-EEG: draw dots on head, colored according to data-values
#########1#########2#########3#########4#########5#########6#########7#####
package require Tk
proc ReadFile {fn} {
#: Read + parse datafile
# Format of data (no tabs!) :
# #### Fz Cz Pz FP1 FP2 F7 F3 F4 F8 T3 C3 C4 T4 T5 P3 P4 T6 O1 O2 A1 A2
# "0001 a a a x x b b b b d d d d t t t t x x 0 0"
global Data P0
#puts "fn: $fn" ;##
set i 0
set Comment 0
set nData 0
# Read file one line at a time:
set fp [open $fn r]
fconfigure $fp -buffering line
gets $fp Line
while {$Line != ""} {
incr i 1
#puts "$i: $Line" ;##
set Line [string trim $Line]
switch -- [string index $Line 0] {
# {incr Comment 1}
default { incr nData 1
set w 0
set D {}
foreach Word [split $Line " "] {
if { $Word != ""} {
if { $w == 0} {
set Key $Word
} else {
#puts "$w '$Word'" ;##
set Val grey
catch { set Val $::ColorTab($Word) }
lappend D $Val
}
incr w 1
}
}
set Data($nData) $D
#puts "#> $nData $Key: '$D'" ;##
}
} ;#switch
gets $fp Line
} ;#while
close $fp
puts "#EOF: $nData = [array size Data]" ;##
return [array size Data]
}
#
#: 2D-Graphics Operations : affine transforms on a canvas
#
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 {
# Do nothing
}
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}
# Next line does simultaneous assignment...
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
}
#
# Routines to draw heads and set up their dot-arrangement:
#
proc ReadPic {w fn} {
#: Read imagefile, put image on canvas
#global im1
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} {
#: Same arrangement of dots as for head2
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 "all $nr"
incr i 1
}
}
proc DrawHead1 {w} {
#: Draw a round head, as viewed from above
set x1 32
set y1 40 ;# 120-80=40
set x2 [expr { $x1 + 220 }]
set y2 [expr { $y1 + 220 }]
$w create oval $x1 $y1 $x2 $y2 -fill $::Fill -tags "all Head1"
# Nose up:
$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 "all Head1"
$w create line [expr { $x1 + 94 }] [expr { $y1 + 1 }] \
[expr { $x1 +111 }] [expr { $y1 - 13 }] -tags "all Head1"
$w create line [expr { $x1 +111 }] [expr { $y1 - 13 }] \
[expr { $x1 +125 }] [expr { $y1 + 1 }] -tags "all Head1"
# Ears:
$w create rect [expr { $x1 - 4 }] [expr { $y1 + 90 }] \
[expr { $x1 + 2 }] [expr { $y1 +122 }] -fill $::Fill -tags "all Head1"
$w create rect [expr { $x1 +219 }] [expr { $y1 + 90 }] \
[expr { $x1 +225 }] [expr { $y1 +122 }] -fill $::Fill -tags "all Head1"
# Arrangement of dots according to 1020-system:
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 "all $nr Head1"
set xT [expr { $x1 + 8 }]
set yT [expr { $y1 + 21 }]
$w create text $xT $yT -text $nr -tags "all Head1"
}
}
proc HeadPoints {} {
#: Create polygon for a head in profile
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} {
#: Draw oval head, side view
set x [expr { $::maxX / 2 }]
set y [expr { $::maxY / 2 }]
set HeadCoords1 [HeadPoints]
# puts "HeadCoords1: $HeadCoords1"
#set xform [reflect-x]
set xform [combine_affine [translation -$x -$y] [reflect-x] [translation $x $y] ]
set HeadCoords2 [apply_affine $xform $HeadCoords1]
# puts "HeadCoords2: $HeadCoords2"
$w create poly $HeadCoords2 -outline red -fill $::Fill -tags "all Head2" ;# -smooth true
# Selected dots of 1020-system, as viewed from side:
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 "all $nr Head2"
set xT [expr { $x1 + 8 }]
set yT [expr { $y1 + 20 }]
$w create text $xT $yT -text $nr -tags "all Head2"
}
}
proc DrawHead3 {w} {
#: Draw oval head, side view
$w create poly [HeadPoints] -outline black -fill $::Fill -tags "all Head3" ;# -smooth true
# selected dots of 1020-system, as viewed from side:
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 "all $nr Head3"
set xT [expr { $x1 + 8 }]
set yT [expr { $y1 + 20 }]
$w create text $xT $yT -text $nr -tags "all Head3"
}
}
#########1#########2#########3#########4#########5#########6#########7#####
#
# Routines to change the color of dots:
proc ClrCanvas {} {
#: Clear all canvas
foreach {w} {.cA .cB .cC .cD} { $w delete "all" }
}
proc ColorAllDots {c} {
#: Set all dots to the same color 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} {
#: Set all dots to the colors in array 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==""} {set c white}
#puts "$i $nr: $c" ;##
foreach {w} {.cA .cB .cC .cD} { $w itemconfig $nr -fill $c }
incr i 1
}
}
proc NextSample {inc} {
#: Show next sample from data-array, with range-check
global Data P0
set P $P0
if {[catch {incr P $inc}]} { StopAnimation; bell; return 1 }
set x [array get Data $P]
#puts "x: $x" ;##
if {$x ==""} {
StopAnimation
bell
return 1 ;# Error
} else { ;# ok:
set P0 $P
ColorDots $Data($P0)
return 0
}
}
# Repeating timer:
proc every {ms body} {after $ms [info level 0]; eval $body; }
proc StartAnimation {} {
#: Show data from data-array as animation
every 100 { NextSample +1 }
}
proc StopAnimation {} {
#: Reset all 'every' timers
foreach id [after info] {after cancel $id}
}
#########1#########2#########3#########4#########5#########6#########7#####
proc Init {} {
#: Initialize values, build GUI
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" ;# yellow / bisque / bisque2 / wheat1 / tan / gold2
set Color blue
set Data(0) {}
set P0 NoData
# Fz Cz Pz / FP1 FP2 / F7 F3 F4 F8 /
# T3 C3 C4 T4 / T5 P3 P4 T6 / O1 O2 / A1 A2
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
#canvas .cA -width $maxX -height $maxY -bg white
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
# Alternative Layout:
#pack .cB .cD -in .f1 -side left
#pack .cA .cC -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 "Dot1" -command { .cA itemconfig Dot1 -fill $Color }
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 .
}
#
#: Main :
#
Init
ReadPic .cA "stampr1.gif"
DrawDots .cA
#ReadPic .cB "1020top.gif"
#ReadPic .cC "1020left.gif"
#ReadPic .cD "1020right.gif"
DrawHead1 .cB ;# Nose up
DrawHead2 .cC ;# Nose left
DrawHead3 .cD ;# Nose right
### Debug:
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 ] }
#catch {console show}
#set c a; puts "$c : $ColorTab($c)"
#puts "P1: $P1"
#.Category Toys