---- #!/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 . { ColorAllDots $Color } bind . { ColorDots $P1 } bind . { ColorDots $P2 } bind . { set P0 [ReadFile "eeg2.txt"] } bind . { set P0 0; NextSample 0 } bind . { NextSample -1 } bind . { NextSample -1 } bind . { NextSample +1 } bind . { NextSample +1 } bind . { StartAnimation } bind . { 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 . { console show } proc int x { expr int($x) } bind .cD {wm title . [int [%W canvasx %x]],[int [%W canvasy %y]]} bind .cA {wm title . [.cA itemcget current -tag ] } #catch {console show} #set c a; puts "$c : $ColorTab($c)" #puts "P1: $P1" #. ---- [Category Toys]