A small example of a widget serving a program

Arjen Markus (31 march 2003) While the source code below still holds all the scars and bruises of experimentation, it illustrates how Tcl/Tk can be used to provide interaction and presentation facilities to a program that actually remains unaware of this fact, that is, it is not necessary to adjust the program beyond a few basic principles that do not depend on Tcl.

GPS coined the phrase widgets as executables for this and let me summarise the idea in my own words:

  • An application interacts with a server script by commands and responses
  • The application provides the specific functionality but the server executes the code.
  • Thus the application does not depend on the Tcl library; it only needs to contain the code for sending commands and handling responses - which can be done via standard input and standard output.

The server script in this case consists of some generic handlers and a basic canvas window. It sources the application script - though this is a mere detail, as one can imagine it starting the computational program (when then provides the specifics) or listening to sockets instead of pipes.


 # module_server.tcl --
 #    Simple implementation of a Tcl/Tk server
 #
 # Note:
 #    The assumption is that the server needs to do something
 #    graphical, hence loads Tk
 #

 package require Tk

 # startProgram --
 #    Start a program via a two-way pipe
 #
 # Arguments:
 #    prog      Name of the program (with arguments) to start
 # Result:
 #    None
 # Side effects:
 #    Two-way pipe opened to the program, event handlers set up
 #
 proc startProgram { prog } {
    global extprog
    set extprog [open "|$prog" "w+"]
    fconfigure $extprog -buffering line

    fileevent $extprog readable {
       HandleInput $extprog
    }
 }

 # HandleInput --
 #    Handle the input from the external program line by line
 #
 # Arguments:
 #    extprog   Channel to the external program
 # Result:
 #    None
 # Side effects:
 #    Whatever the commands are
 # Note:
 #    Should use a safe interpreter instead
 #
 proc HandleInput { extprog } {
    if { [gets $extprog line] > -1 } {
       puts "In: $line"
       eval $line
    } else {
       close $extprog
    }
 }

 # @OK --
 #    Send acknowledgement to the external program
 #
 # Arguments:
 #    None
 # Result:
 #    None
 # Side effects:
 #    The line "@OK" is sent with a given delay
 #
 proc @OK { } {
    #global extprog
    #global delay
    #puts "@OK"
    #puts $extprog "@OK"
    #after $delay [list flush $extprog ]
 }

 # @STOP --
 #    Close the channel
 #
 # Arguments:
 #    None
 # Result:
 #    None
 # Side effects:
 #    Channel closed
 #
 proc @STOP { } {
    global extprog
    close $extprog
 }

 # main --
 #    Main code. Source the script given on the command line to get
 #    started

 set delay 100

 source [lindex $argv 0]

The application script provides procedures and event bindings - implementing the program's commands and the user's methods of interaction (here: clicking the mouse button).


 # client.tcl --
 #    Simple client script
 #
 # Note:
 #    Should be revised - no explicit reference to "extprog"
 #

 canvas .c
 pack   .c -fill both
 bind   .c <Button-1> {storePos %x %y}
 .c create text 100 20 -text "Click mouse button"

 #
 # Handle the requests
 #
 proc start { } {
    global xp
    global yp
    global xcentr
    global ycentr
    set xp 150
    set yp 150
    set xcentr 200
    set ycentr 200
    puts $::extprog "$xp $yp" ;# Visible point
    puts $::extprog "@OK"
    .c create oval [expr {$xp-2}] [expr {$yp-2}] \
                   [expr {$xp+2}] [expr {$yp+2}] -fill blue -tag POINT
    .c create oval [expr {$xcentr-5}] [expr {$ycentr-5}] \
                   [expr {$xcentr+5}] [expr {$ycentr+5}] \
                   -fill yellow -outline red -tag CENTRE
 }
 proc position { } {
    global delay
    puts $::extprog "$::xcentr $::ycentr"
    after $delay [list puts $::extprog "@OK"]
 }
 proc move { xpnew ypnew } {
    global xp
    global yp
    .c move POINT [expr {$xpnew-$xp}] [expr {$ypnew-$yp}]
    set xp $xpnew
    set yp $ypnew
 }
 proc storePos { xc yc } {
    global xcentr
    global ycentr
    .c move CENTRE [expr {$xc-$xcentr}] [expr {$yc-$ycentr}]
    set xcentr   $xc
    set ycentr   $yc
 }

 #console show
 startProgram "fclient.exe"

The computational program is written in Fortran 90, but that is a detail that tells you more about me than about the technique. It starts by sending the command "start", which results in the initialisation of the canvas.

Then it asks for the coordinates of the centre and calculates the new position of the blue dot. The "move" command instructs the server to move the dot.

The server module in this program contains a lot of logic mainly to take care of possible errors - these should not result in an unexpected end of the program (though little care is taken to protect the server script itself).


 ! fclient.f90 --
 !    Illustrate the concept of executable widgets/modules
 !
 ! The idea:
 ! - Have a Tcl script that acts as a server
 ! - Have other widgets or programs use that server
 !   (present a GUI or present graphics or both)
 ! - The computational program is quite independent of the
 !   server.
 !
 ! Here:
 ! Simple program that calculates the new position of a
 ! point orbiting a given centre
 ! The program asks the server to provide the centre's coordinates
 ! (via the command "position") and then instructs it to move
 ! the point ("move"). If the channel to the server closes,
 ! so does the program - it has no reason to continue.
 !

 ! tcl_server --
 !    Client-server communication via standard input/output
 !
 module tcl_server
    logical, private     :: server_connected = .true.
    integer, private     :: flush_lun  = 6 ! Not always 6

 contains

 ! server_send
 !    Send a line of text containing a command to the server
 !
 ! Arguments:
 !    line           Line of text to be sent
 !    end_of_send    End of the message (optional)
 ! Result:
 !    None
 ! Side effects:
 !    The line is written to standard output, check that the
 !    connection remains open.
 !
 subroutine server_send( line, end_of_send )
    character(len=*)   :: line
    logical, optional  :: end_of_send

    integer            :: ierr
    logical            :: do_flush

    do_flush = .true.
    if ( present( end_of_send ) ) do_flush = end_of_send

    if ( server_connected ) then
       write( *, '(a)', iostat = ierr ) trim(line)
       if ( ierr .eq. 0 ) then
          write( *, '(a)' ) '@OK'
          if ( do_flush ) call flush( flush_lun )
       else
          server_connected = .false.
       endif
    endif
 end subroutine server_send

 ! server_get
 !    Get a line of text containing information from the server
 !
 ! Arguments:
 !    line           Line of text to be read
 ! Result:
 !    True, if a line was read, false if not
 ! Side effects:
 !    A line is read and the function waits until the final
 !    acknowledgement (disregarding all other input)
 !
 logical function server_get( line )
    character(len=*)   :: line

    integer            :: ierr
    character(len=20)  :: ack

    server_get = .true.
    if ( server_connected ) then
       read( *, '(a)', iostat = ierr ) line
       if ( ierr .eq. 0 .and. trim(line) .ne. '@STOP' ) then
          do
             read( *, '(a)', iostat = ierr ) ack
             if ( trim(ack) .eq. '@OK' .or. ierr .ne. 0 ) exit
          enddo
       endif
       if ( ierr .ne. 0 ) then
          server_connected = .false.
          server_get       = .false.
       endif
       if ( trim(line) .eq. '@STOP' ) then
          server_get       = .false.
       endif
    endif
 end function server_get

 end module tcl_server

 program calc
    use tcl_server
    implicit none

    real               :: xcentr
    real               :: ycentr
    real               :: x
    real               :: y
    real               :: dx
    real               :: dy
    real               :: angle
    real               :: rad
    integer            :: ierr

    character(len=256) :: line

    !
    ! Get start position
    !
    call server_send( 'start' )
    if ( server_get(line) ) then
       read( line, *, iostat = ierr ) x, y
    endif

    !
    ! Start the loop
    !
    call server_send( 'position' )
    do while ( server_get(line) )
       read( line, *, iostat = ierr ) xcentr, ycentr
       if ( ierr .eq. 0 ) then
          dx    = x - xcentr
          dy    = y - ycentr
          if ( dx .ne. 0.0 .and. dy .ne. 0.0 ) then
             angle = atan2(dy,dx) + 0.2
             rad   = sqrt(dx**2 + dy**2)
             x     = xcentr + rad * cos(angle)
             y     = ycentr + rad * sin(angle)
          else
             ! No change
          endif
          write( line, '(a,2f10.3)' ) 'move ', x, y
       else
          write( line, '(a,a)' ) '# Unknown: ', line(1:30)
       endif
       call server_send( line )
       call server_send( 'position' )
    enddo

    stop
 end program

I wrote a system to add GUI interfaces to shell scripts that uses a similar approach. Details can be found at http://www.satisoft.com/satshell (Adrian Davis)


See also: managing Fortran programs, FORTRAN via open pipe, open