----
 #!/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

#.
----