#!/bin/sh
# Restart with tcl: -*- mode: tcl; tab-width: 4; -*- \
exec wish $0 ${1+"$@"}
# demo5-EEG.tcl - HaJo Gurt - 2005-12-20 - 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!) :
# "0001 a b d t 0 0 x y a a b b d d t t"
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 "#> $Key: '$D'" ;##
}
} ;#switch
gets $fp Line
} ;#while
close $fp
puts "#EOF: $nData = [array size Data]" ;##
return [array size Data]
}
#
# 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} { 50 70 80 70 110 70 140 70
50 100 80 100 110 100 140 100
50 130 80 130 110 130 140 130
50 160 80 160 110 160 140 160 } {
incr i 1
set x2 [expr { $x1 + 15 }]
set y2 [expr { $y1 + 15 }]
$w create oval $x1 $y1 $x2 $y2 -fill white -tags "all Dot$i"
}
}
proc DrawHead1 {w} {
#: Draw a round head, as viewed from above
set x1 20
set y1 40 ;# 120-80=40
set x2 [expr { $x1 + 160 }]
set y2 [expr { $y1 + 160 }]
$w create oval $x1 $y1 $x2 $y2 -tags "all Head1"
# Nose up:
$w create line [expr { $x1 + 69 }] [expr { $y1 + 1 }] \
[expr { $x1 + 80 }] [expr { $y1 - 10 }] -tags "all Head1"
$w create line [expr { $x1 + 80 }] [expr { $y1 - 10 }] \
[expr { $x1 + 91 }] [expr { $y1 + 1 }] -tags "all Head1"
# Ears:
$w create rect [expr { $x1 - 2 }] [expr { $y1 + 70 }] \
[expr { $x1 + 2 }] [expr { $y1 + 90 }] -tags "all Head1"
$w create rect [expr { $x1 +158 }] [expr { $y1 + 70 }] \
[expr { $x1 +162 }] [expr { $y1 + 90 }] -tags "all Head1"
# Only some dots on this head:
foreach {nr x1 y1} { Dot5 50 70 Dot6 80 70
Dot7 110 70 Dot8 140 70 } {
set x2 [expr { $x1 + 15 }]
set y2 [expr { $y1 + 15 }]
$w create oval $x1 $y1 $x2 $y2 -fill white -tags "all $nr"
}
}
proc DrawHead2 {w} {
#: Draw oval head, side view
set x1 20
set y1 20 ;# 120-100=20
set x2 [expr { $x1 + 160 }]
set y2 [expr { $y1 + 200 }]
$w create oval $x1 $y1 $x2 $y2 -tags "all Head2"
# Nose on left:
$w create line [expr { $x1 + 4 }] [expr { $y1 + 70 }] \
[expr { $x1 - 10 }] [expr { $y1 +120 }] -tags "all Head2"
$w create line [expr { $x1 - 10 }] [expr { $y1 +120 }] \
[expr { $x1 + 4 }] [expr { $y1 +121 }] -tags "all Head2"
# Create a grid of dots:
set i 0
foreach {x1 y1} { 50 70 80 70 110 70 140 70
50 100 80 100 110 100 140 100
50 130 80 130 110 130 140 130
50 160 80 160 110 160 140 160 } {
incr i 1
set x2 [expr { $x1 + 15 }]
set y2 [expr { $y1 + 15 }]
$w create oval $x1 $y1 $x2 $y2 -fill white -tags "all Dot$i"
}
}
proc DrawHead3 {w} {
#: Draw oval head, side view
#set x1 380
set x1 20
set y1 20 ;# 120-100=20
set x2 [expr { $x1 + 160 }]
set y2 [expr { $y1 + 200 }]
$w create oval $x1 $y1 $x2 $y2 -tags "all Head3"
# Nose on right:
$w create line [expr { $x1 +156 }] [expr { $y1 + 70 }] \
[expr { $x1 +170 }] [expr { $y1 +120 }] -tags "all Head3"
$w create line [expr { $x1 +170 }] [expr { $y1 +120 }] \
[expr { $x1 +156 }] [expr { $y1 +121 }] -tags "all Head3"
# Grid of dots:
set i 0
foreach {x1 y1} {140 70 110 70 80 70 50 70
140 100 110 100 80 100 50 100
140 130 110 130 80 130 50 130
140 160 110 160 80 160 50 160 } {
incr i 1
set x2 [expr { $x1 + 15 }]
set y2 [expr { $y1 + 15 }]
$w create oval $x1 $y1 $x2 $y2 -fill white -tags "all Dot$i"
}
}
#
# 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
for { set i 1 } { $i <= 16 } { incr i 1 } {
foreach {w} {.cA .cB .cC .cD} { $w itemconfig Dot$i -fill $c }
}
}
proc ColorDots {Colors} {
#: Set all dots to the colors in array Colors
ColorAllDots white
set i 0
foreach c $Colors {
incr i 1
foreach {w} {.cA .cB .cC .cD} { $w itemconfig Dot$i -fill $c }
}
}
proc NextSample {inc} {
#: Show next sample from data-array, with range-check
global Data P0
set P $P0
if {[catch {incr P $inc}]} { bell; return }
set x [array get Data $P]
#puts "x: $x" ;##
if {$x ==""} {
bell
return 1 ;# Error
} else { ;# ok:
set P0 $P
ColorDots $Data($P0)
return 0
}
}
# Repeating timer:
proc every {ms body} {eval $body; after $ms [info level 0]}
proc StartAnimation {} {
#: Show data from data-array as animation
every 100 { NextSample +1 }
# ?? automatic stop at end of data ??
}
proc StopAnimation {} {
#: Reset all 'every' timers
foreach id [after info] {after cancel $id}
}
#########1#########2#########3#########4#########5#########6#########7#####
proc Init {} {
#: Init. values, Build GUI
global maxX maxY Data P0 ColorTab Color P1 P2
set maxX 200
set maxY 240
array set ColorTab { a red b yellow d green t blue 0 white x grey }
set Color blue
set Data(0) {}
set P0 NoData
set P1 {red yellow blue green grey
pink yellow cyan green2 grey25
red2 yellow blue green4 grey50 orange}
set P2 {OrangeRed2 red tomato pink salmon
orange goldenrod bisque yellow
cyan SteelBlue1 blue green green4
magenta grey white 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
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 "eeg1.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
}
#
#: Main :
#
Init
ReadPic .cA "stampr1.gif"
DrawDots .cA
DrawHead1 .cB ;# Nose up
DrawHead2 .cC ;# Nose left
DrawHead3 .cD ;# Nose right
### Debug:
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)"
#.