* A Toy Pump Controller *

A toy "device control" application

** Summary **

A little demo to illustrate controlling of several "pumps" by concurrent
programming, making use of Tcl's event loop. The pumps are included in
the package.

** Pics **
... or it didn't happen. Mmh -- OK, here's one of the contraption in action:

A Standard Model pump: [pumpcontrol standard screenshot]

A Grizzly Model pump: [pumpcontrol grizzly screenshot]

The Controller [pumpcontrol controller screenshot]

The standard pump is stopped, the Grizzly is running. I resisted the temptation
to upload animated GIFs ;-)

** Global operation **
The whole package consists of two separate programs: the pump and the controller.

** The Pump **
The pump simulates a stylized pump with some blades, and listens to a network
connection at some configurable port. You can start one like so:

--------
======
./pump standard p003 10000
======
--------
The first argument is a model name for the pump. We support three models: '''standard'''
'''grizzly''' and '''squirrel'''. The second is an identifier (an arbitrary string with no
whitespace in it) and the third a TCP port to listen on.

Once someone connects to the pump, it can send commands. The pumps support three
commands: '''START''' starts the pump, '''STOP''' stops it, and '''STATUS''' answers with
three words: the identifier, the model and either '''RUNNING''' or '''STOPPED''', depending
on which state the pump is in.Commands to the pump are always in capital letters (call that nostalgia, if you wish).

You can try it by telnetting to the above port, like so:

--------
======
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.
======
--------
After closing the connection the pump stays in the last state and you can
re-connect and send more commands. While connected to the pump, it won't
accept more connections.

** The Controller **
This one doesn't take arguments. If you start it by itself, it just shows
a blank window.

In the background, though, it tries to connect to pumps at localhost
in a given port range (fixed in the program, from 10000 to
10009). Whenever it gets a connection, it request the pump's state,
and if successful, it opens a new row showing the model, identifier
and port, and also a radio button to start and stop the pump (pre-set
corresponding to the result of the '''STATUS''' inquiry).

You can start new pump instances (listening to a port within range)
and the corresponding lines in the controller will appear. Likewise,
if you terminate a pump instance (by closing its window), the
corresponding line in the controller will disappear.

If you start two controller instances they will fight for the
available pumps.  Since a pump only will accept one connection (modulo
bugs?), only one controller will get hold of a given pump.

If you terminate a controller, "its" pumps will stay in their last
state, waiting for a new controller to pick them up.

* The Code *
Here it goes. Enjoy.

As a general note, there are many global variables around. In a Real
World Application (TM), we would strive to tuck them away (either in
namespaces or by using some OO framework (itcl, TclOO, there are many
excellent ones to choose from). Otherwise the code will tend to evolve
into an unmaintainable mess.

** The Pump **
--------
======
#!/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
======
--------

*** How it works ***
At start the '''[switch]''' sets some parameters depending on the model --
those will determine the appearance (size, number of blades, rotation
speed etc.).

For convenience, the rotational positions of the blade tips are
pre-calculated in the list '''$posn'''. The global variable '''$pos'''
tracks at which position the rotation of the pump currently is.

The procedure '''[draw]''' draws the pump blades at the position '''$pos'''.
It deletes the blades at the old position, which have been tagged with
the tag '''blade''' at draw time, so they can be addressed collectively by
this name.

The procedure '''[spin]''' advances this position and invokes a redraw. Then
it schedules itself to run after the time given by the global variable
'''$tick'''. It notes the timer id in the global variable '''$spinner''',
which makes us able to stop the pending timer and thus stop the rotation.

This is already an example of concurrency: while rotation is going on
(which only needs our attention for one redraw every '''$tick'''
milliseconds) the whole channel machinery is listening, accepting
and carrying out commands.

The three procedures [listen], [serve] and [readsome] handle incoming
connections. Note that [serve] closes the listening channel, thus
disabling new connections whenever one has been accepted (there might
be a race condition here). Whenever the current connection is closed
on us ('''[eof $chan]'''), we listen again.

See also [A Simple Fan Animation] for a more fancy ummm... fan.

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

*** How it works ***

As a constant "background task" there is '''[scanport]'''. It goes
through all the ports in the pre-defined port range and tries to
connect. To allow for other things to happen, it just tries one port
for every invocation, increments '''$thisport''' and reschedules
itself. This is a typical strategy for explicitly concurrent programs:
break up long-running things into small steps and leave holes in them
for the scheduler to go about other businesses.

The group of procedures '''[newpump]''', '''[init1pump]''' and
'''[init2pump]''' handle the connection to a new pump, querying its
state, accepting its answer and setting up a controller widget for
it. They form already a rudimentary state automaton; it's easy to
see that we will need a better organizational principle when protocols
become more complex (as is the case in Real Life). Some form of
explicit state automaton or coroutines may save us from a Big Mess
here.

The procedure '''[rdready]''' is there to catch unexpected things
the pump may say to us (our pumps don't do that!) and more importantly,
to notice when the socket gets closed (our side signals that as
a readable channel with the '''[eof]''' condition set). General
communication errors should land here too.

Much state is kept either in global variables (e.g. the array
'''$state($sock)''' or in the widgets themselves (cf. the radio
button command, which knows which '''$socket''' is its own).

One obvious enhancement would be to ditch the button's command
and coordinate things via the '''$state($sock)''' variable by
adding a trace to it. This way, we could control things "from
behind", by setting this variable to an appropriate value (thus
making timed schedules very simple).


----
'''[arjen] - 2014-01-22 10:16:56'''
<<categories>>Concurrency Device Control | Toys