;;; ;;; Copyright (C) 2007 Lothar May l-may@gmx.de ;;; ;;; All rights reserved. ;;; ;;; Redistribution and use in source and binary forms, with or ;;; without modification, are permitted provided that the ;;; following conditions are met: ;;; 1. Redistributions of source code must retain the above ;;; copyright notice, this list of conditions and the ;;; following disclaimer. ;;; 2. Redistributions in binary form must reproduce the ;;; above copyright notice, this list of conditions and ;;; the following disclaimer in the documentation and/or ;;; other materials provided with the distribution. ;;; 3. Neither the name of the project nor the names of ;;; its contributors may be used to endorse or promote ;;; products derived from this software without specific ;;; prior written permission. ;;; ;;; THIS SOFTWARE IS PROVIDED BY THE PROJECT AND CONTRIBUTORS ;;; ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, ;;; BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF ;;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE ;;; DISCLAIMED. IN NO EVENT SHALL THE PROJECT OR CONTRIBUTORS ;;; BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ;;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT ;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; ;;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) ;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER ;;; IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE ;;; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY ;;; OF SUCH DAMAGE. ;;; ;;; Software timer ;;; (define timer-create (lambda (timeout-msec) (cons timeout-msec 0))) (define timer-gettimeout (lambda (timer) (car timer))) (define timer-getcurtime (lambda () (let ((time (gettimeofday))) (+ (* (car time) 1000) (quotient (cdr time) 1000))))) (define timer-start (lambda (timer) (cons (timer-gettimeout timer) (timer-getcurtime)))) (define timer-expired? (lambda (timer) (>= (timer-getcurtime) (+ (car timer) (cdr timer)))))