[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 {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] ---- [Category Example] | [Category GUI]