#!/bin/sh
# Restart with tcl: -*- mode: tcl; tab-width: 4; -*- \
exec wish $0 ${1+"$@"}
# demo4-EEG.tcl - HaJo Gurt - 2005-12-18 - 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 ClrCanvas {w} {
#: Clear the canvas
$w delete "all"
}
proc DrawHead1 {w} {
#: Draw a round head, as viewed from above
set x1 200
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 HeadC"
# Nose:
$w create line [expr { $x1 + 69 }] [expr { $y1 + 1 }] \
[expr { $x1 + 80 }] [expr { $y1 - 10 }] -tags "all HeadC"
$w create line [expr { $x1 + 80 }] [expr { $y1 - 10 }] \
[expr { $x1 + 91 }] [expr { $y1 + 1 }] -tags "all HeadC"
# Ears:
$w create rect [expr { $x1 - 2 }] [expr { $y1 + 70 }] \
[expr { $x1 + 2 }] [expr { $y1 + 90 }] -tags "all HeadC"
$w create rect [expr { $x1 +158 }] [expr { $y1 + 70 }] \
[expr { $x1 +162 }] [expr { $y1 + 90 }] -tags "all HeadC"
}
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"
}
proc DrawHead3 {w} {
#: Draw oval head, side view
set x1 380
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 HeadO"
# 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"
}
proc DrawDots {w} {
#: Draw a grid of dots, to be colored later
# Dots on left head:
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"
}
# Dots on right head, with same tags:
set i 0
foreach {x1 y1} {500 70 470 70 440 70 410 70
500 100 470 100 440 100 410 100
500 130 470 130 440 130 410 130
500 160 470 160 440 160 410 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 ColorDots1 {w c} {
#: Set all dots to the same color c
for { set i 1 } { $i <= 16 } { incr i 1 } {
$w itemconfig Dot$i -fill $c
}
}
proc ColorDots2 {w Colors} {
#: Set all dots to the colors in array Colors
ColorDots1 .cv white
set i 0
foreach c $Colors {
incr i 1
$w itemconfig Dot$i -fill $c
}
}
proc ReadPic {w {fn ""}} {
#: Read imagefile, put image on canvas
global im1
set midX [expr { $::maxX / 2 }]
set midY [expr { $::maxY / 2 }]
if {$fn != ""} {
catch {image delete $im1}
set im1 [image create photo -file $fn]
$w create image $midX $midY -image $im1 -tag img
}
}
proc ReadFile {fn} {
#: Read + parse datafile
# Format of data:
# "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
#puts "[ format "%5d: %s " $nData $Line ]" ;##
#scan $Line "%d %s %s %s %s %s %s %s %s" Nr a1 a2 a3 a4 a5 a6 a7 a8
#puts "#> $Nr $a1 $a2 $a3 $a4 $a5 $a6 $a7 $a8" ;##
set w 0
set D {}
foreach Word [split $Line " "] {
if { $Word != ""} {
#puts "$w='$Word'" ;##
if { $w == 0} {
set Key $Word
#array set Data [concat $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'" ;##
#ColorDots2 .cv $D ;##
}
} ;#switch
gets $fp Line
} ;#while
close $fp
puts "#EOF: $nData = [array size Data]" ;##
ColorDots2 .cv $Data(1)
}
#proc Color1 {nr} {
# set c [lindex {red orange yellow green cyan blue magenta pink grey20 } $nr]
#}
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
} else {
set P0 $P
ColorDots2 .cv $Data($P0)
}
}
proc Init {} {
#: Build GUI
global maxX maxY
frame .f1
frame .f2
frame .f3
frame .f4
pack .f1 .f2 .f3 .f4
canvas .cv -width $maxX -height $maxY -bg white
pack .cv -in .f1
button .b1 -text "Clear" -command { ClrCanvas .cv }
button .b2 -text "Image" -command { ReadPic .cv "stampr1.gif" }
button .b3 -text "Heads" -command { DrawHead1 .cv; DrawHead2 .cv; DrawHead3 .cv }
button .b4 -text "Dots" -command { DrawDots .cv }
#button .b5 -text "Dot1" -command { .cv itemconfig Dot1 -fill $Color }
button .b5 -text "AllDots" -command { ColorDots1 .cv $Color}
button .b6 -text "Pattern1" -command { ColorDots2 .cv $P1}
button .b7 -text "Pattern2" -command { ColorDots2 .cv $P2}
button .b8 -text "File1" -command { ReadFile "eeg1.txt"; set P0 1; NextSample 0 }
button .b- -text " - " -command { NextSample -1 }
label .nr -textvar P0
button .b+ -text " + " -command { NextSample +1 }
pack .b1 .b2 .b3 .b4 .b5 .b6 .b7 .b8 .b- .nr .b+ -in .f2 -side left -padx 2
foreach {c} {red pink orange yellow green green4 cyan SteelBlue1 blue magenta white grey black} {
pack [ button .c$c -text "$c" -command "set Color $c" ] -in .f3 -side left
}
set xx {$Color}
for { set i 1 } { $i <= 16 } { incr i 1 } {
set cmd ".cv itemconfig Dot$i -fill $xx"
#puts "$cmd" ;##
pack [ button .d$i -text "Dot$i" -command $cmd ] -in .f4 -side left
}
}
###: Main:
set maxX 560
set maxY 240
set Color black
array set ColorTab { a red b yellow d green t blue 0 white x grey }
set P0 -
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}
set Data(0) {}
Init
DrawHead1 .cv
DrawHead2 .cv
DrawHead3 .cv# ReadPic .cv "stampr1.gif"
DrawDots .cv
### Debug:
proc int x { expr int($x) }
bind .cv <Motion> {wm title . [int [%W canvasx %x]],[int [%W canvasy %y]]}
#bind .cv <Motion> {wm title . [.cv itemcget current -tag ] }
#catch {console show}
#set c a; puts "$c : $ColorTab($c)"
#set date [clock format [clock sec] -format "%Y-%m-%d %T"]; puts $date#.