./pump standard p003 10000

tomas@rasputin:~/tcltk/control$ ./pump standard p003 10000 &
[1] 4231
tomas@rasputin:~/tcltk/control$ telnet localhost 10000
Trying 127.0.0.1...
Connected to localhost.
Escape character is '^]'.
STATUS
p003 standard  STOPPED
START
STATUS
p003 standard  RUNNING
^]
telnet> quit
Connection closed.

#!/usr/bin/wish
# usage pump <model name> <id> <port>

if {[llength $argv] != 3} {
  puts stderr "usage: pump <model name> <id> <port>"
  exit 1
}

lassign $argv model id port

switch -exact -- $model {
  grizzly {
    set size 100.0 ;# pixels
    set nblades 4 ;# ideally a divisor of nsteps
    set nbsteps 20 ;# steps per blade
    set dir 1 ;# 1: clockwise; -1 counter-clockwise
    set tick 100 ;# ms/step
    set color blue
  }
  squirrel {
    set size 40.0 ;# pixels
    set nblades 2 ;# ideally a divisor of nsteps
    set nbsteps 8 ;# steps per blade
    set dir -1 ;# 1: clockwise; -1 counter-clockwise
    set tick 75 ;# ms/step
    set color red
  }
  standard {
    set size 60.0 ;# pixels
    set nblades 3 ;# ideally a divisor of nsteps
    set nbsteps 12 ;# steps per blade
    set dir 1 ;# 1: clockwise; -1 counter-clockwise
    set tick 80 ;# ms/step
    set color black
  }
  default {
    puts stderr "bad model: must be one of \
                  grizzly squirrel standard"
    exit 1;
  }
}

set nsteps [expr {$nblades * $nbsteps}]
set radius [expr {$size / 2}]
set twopi [expr {2 * 3.14159265378979323}]
# angle steps in radians:
set astep [expr {$twopi / $nsteps}]
# blade tip coords for all positions:
for {set alpha 0} {$alpha < $twopi} {set alpha [expr {$alpha + $astep}]} {
  lappend posn [list [expr {$radius * (1.0 + cos($alpha))}] \
                     [expr {$radius * (1.0 + $dir*sin($alpha))}]]
}

set canv [canvas .c -width $size -height $size]
pack $canv
$canv create oval 0 0 $size $size

set pos 0 ;# start

proc draw {} {
  global pos canv posn radius nsteps nbsteps color
  set i $pos
  $canv delete blade
  for {set i $pos} {$i < $nsteps} {incr i $nbsteps} {
    $canv create line [concat $radius $radius [lindex $posn $i]] -fill $color -width 3 -tag blade
  }
}

proc spin {} {
  global pos nbsteps tick spinner
  # pos goes from 0 to $nbsteps - 1 then starts over at 0:
  set pos [expr {[incr pos] % $nbsteps}] ;# next "tick"
  draw
  # schedule next step after $tick ms, keep timer id around
  set spinner [after $tick spin]
}

proc listen {} {
  global listener port
  set listener [socket -server serve $port]
}

proc serve {chan cli port} {
  global listener
  close $listener ;# don't accept more connections
  fconfigure $chan -blocking 0
  fileevent $chan readable [list readsome $chan]
}

proc readsome {chan} {
  global id model spinner
  # data available
  if {[eof $chan]} {
    catch {close $chan}
    listen ;# ready for new connections
    return
  }
  set cmd [gets $chan] ;# gets never blocks, gets us whole line
  switch -exact -- $cmd {
    START -
    STOP {
      if {[info exists spinner]} {
        after cancel $spinner
        unset spinner
      }
      if {$cmd eq "START"} spin
    }
    STATUS {
      puts $chan "$id $model \
                   [expr {[info exists spinner] ? {RUNNING} : {STOPPED}}]"
      flush $chan
    }
  }
}

listen
draw

#!/usr/bin/wish

# range of TCP ports to look for pumps (on $host)
# including first, excluding last
set host localhost ;# watch out for blocking DNS!
set portrange {10000 10010}
set scantime 50 ;# scan next port after $scantime ms

set activeports [dict create] ;# indexed by port number

proc bgerror {err} {puts "BGERROR: $err"}

proc scanport {} {
  global activeports portrange host scantime thisport
  # try thisport; connect if there
  if {![info exists thisport] || $thisport >= [lindex $portrange 1]} {
    set thisport [lindex $portrange 0]
  }

  if {![dict exists $activeports $thisport]} {
    # not active: poke at it
    if {![catch {
      set sock [socket -async $host $thisport]
    }]} {
      # readable will be called also on failure: we handle this there:
      fileevent $sock writable [list newpump $sock $thisport]
      dict set activeports $thisport 1 ;# tentatively
    }
  }
  incr thisport
  after $scantime scanport
}

proc newpump {sock port} {
  global activeports
  # possibly a new pump at $sock?
  if {[fconfigure $sock -error] ne {}} {
    # FIXME: handle "other" errors. We assume here "connection refused",
    # i.e. "nobody there"
    dict unset activeports $port
    close $sock
    return
  }
  fileevent $sock writable [list init1pump $sock $port]
}

proc init1pump {sock port} {
  ctrlpump $sock $port STATUS
  fileevent $sock readable [list init2pump $sock $port]
  fileevent $sock writable {}
}

proc init2pump {sock port} {
  lassign [regexp -all -inline {\w+} [gets $sock]] id model status
  puts "new pump: $id $model $status"
  fileevent $sock readable [list rdready $sock $port]
  pumpwidget_create $sock $port $id $model $status
}

proc rdready {sock port} {
  global activeports
  # our pumps don't talk much; but they might go away,
  # that puts us here too
  set err [fconfigure $sock -error]
  # FIXME: handle "other" errors.
  #  We just assume here $sock went away, i.e. "nobody there"
  if {$err ne {} || [eof $sock]} {
    dict unset activeports $port
    close $sock
    pumpwidget_delete $sock $port
    return
  }
  # Unexpected: pump is yelling at us:
  puts "pump at $port says [gets $sock]"
}  

proc ctrlpump {sock port command} {
  # we can write right away to sock; Tcl buffers for us
  # downside: we don't know when things succeed
  puts $sock $command
  flush $sock
}

proc pumpwidget_create {sock port id model status} {
  # create a "pump widget"
  # to avoid collissions: name each frame after the port attached to it
  switch -exact -- $status {
    RUNNING {
      set curstate START
    }
    STOPPED {
      set curstate STOP
    }
    default {
      # Any other value causes *both* buttons to be pushable:
      set curstate UNKNOWN
    }
  }

  set fr [frame .f$port]
  pack [label $fr.lab -text "pump $id/$model at $port"] \
      -side left -anchor w
  set ::state($port) $curstate
  foreach cmd {STOP START} {
    pack [radiobutton $fr.b$cmd -text $cmd -indicatoron 0 \
              -command [list ctrlpump $sock $port $cmd] \
              -relief flat -value $cmd -variable ::state($port)] \
        -side right -anchor e
  }
  pack $fr -side top -fill x
}

proc pumpwidget_delete {sock port} {
  # delete a "pump widget"
  destroy .f$port
}
scanport