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:
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 programI 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