The obvious thing (to me, at least) is to define a C extension to add sleep()
to stk.
Here is such a thing I coded in about ten minutes, along with a simple test
program.
All you do is put
(sleep nnn)
when you want to sleep.
--berry
(P.S. Extending this to call usleep or select for sub-second waits is left as
an exercise.)
#include <stk.h>
/*
* write a byte to a port. Use the low 8 bits of the integer i
*/
static PRIMITIVE stk_sleep(SCM n)
{
if (NINTEGERP(n)) err("sleep: not an integer", n);
sleep(INTEGER(n));
return UNDEFINED;
}
void init_sleep(void)
{
add_new_primitive("sleep", tc_subr_1, stk_sleep);
}
#
# A makefile for extensions files on Sun (with gcc)
#
# Copyright (C) 1993, 1994 Erick Gallesio - I3S - CNRS / UNSA <eg_at_unice.fr>
#
#
# Permission to use, copy, and/or distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that both the above copyright notice and this permission notice appear in
# all copies and derived works. Fees for distribution or use of this
# software or derived works may only be charged with express written
# permission of the copyright holder.
# This software is provided ``as is'' without express or implied warranty.
#
# Author: Erick Gallesio [eg_at_kaolin.unice.fr]
# Creation date: 6-Mar-1994 15:49
# Last file update: 6-Mar-1994 15:57
#
# Fixed for sleep() extension...
TOP=/import/stk/src
#include ${TOP}/config.make
#define here how to obtain Position Independant Code (pic) with your compiler
PIC = -fpic
# Define here the extension you want to be defined
#EXT = hash.so time.so
EXT= sleep.so
CC=gcc
CFLAGS= $(PIC) $(STKCFLAGS) -I/import/X11R4/include -DUSE_TK -I${TOP}/Tk
-I${TOP}/Tcl -I${TOP}/Src $(XINCLUDES)
##############################################################################
.SUFFIXES: .so .o .c
.c.so:
$(CC) -c $(CFLAGS) -o $*.o $<
ld -assert pure-text -o $*.so $*.o
.o.so:
ld -assert pure-text -o $*.so $<
##############################################################################
all: $(EXT)
install:
$(INSTALL) $(EXT) $(libdir)
clean:
_at_/bin/rm -f *.o *.so core *~f
#!/import/stk/sol1/bin/stk -f
(load "foredriver/stk/sleep.so")
(load "logical.scm")
(define seconds 5)
(define do-sleep
(lambda ()
(format #t "Sleeping for ~A seconds...~%" seconds)
(sleep seconds)
(format #t "Waking up!~%")
))
(button ".quit"
:text "Quit"
:command '(begin
(display "Quitting sleep test\n")
(destroy "."))
:foreground 'red)
(button ".sleep"
:text "Do Sleep"
:command 'do-sleep)
(pack 'append "." .quit "top fillx")
(pack 'append "." .sleep "top fillx")
(frame ".secframe" :bd 2 :relief 'raised)
(pack 'append "." .secframe "top fillx")
(pack [label ".secframe.label"
:text "Seconds to sleep: "
:width 15
:anchor 'e]
:side "left")
(pack [scale ".secframe.scale"
:orient 'hor
:from 1 :to 60
:font "fixed"
:command "set! seconds"]
:side "right" :expand #t :fill "x")
(.secframe.scale 'set seconds)
(wm 'title '. "Sleep Test")
Received on Thu Sep 29 1994 - 18:34:00 CET
This archive was generated by hypermail 2.3.0
: Mon Jul 21 2014 - 19:38:59 CEST