io-multiplex/timers.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Indent-tabs-mode: NIL -*-
   2 ;;;
   3 ;;; timers.lisp --- Creating and manipulating timer structures.
   4 ;;;
   5 ;;; Copyright (C) 2003 Zach Beane <xach@xach.com>
   6 ;;;
   7 ;;; Permission is hereby granted, free of charge, to any person obtaining
   8 ;;; a copy of this software and associated documentation files (the
   9 ;;; "Software"), to deal in the Software without restriction, including
  10 ;;; without limitation the rights to use, copy, modify, merge,publish,
  11 ;;; distribute, sublicense, and/or sell copies of the Software, and to
  12 ;;; permit persons to whom the Software is furnished to do so, subject to
  13 ;;; the following conditions:
  14 ;;;
  15 ;;; The above copyright notice and this permission notice shall be
  16 ;;; included in all copies or substantial portions of the Software.
  17 ;;;
  18 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  19 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  20 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  21 ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
  22 ;;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
  23 ;;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
  24 ;;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
  25
  26 (in-package :io.multiplex)
  27
  28 ;;;
  29 ;;; Timer
  30 ;;;
  31
  32 (defstruct (timer
  33              (:conc-name %timer-)
  34              (:constructor %make-timer (name function expire-time
  35                                         relative-time one-shot)))
  36   name
  37   ;; to call when the timer expires
  38   function
  39   ;; absolute expiry time
  40   expire-time
  41   ;; relative expiry time
  42   relative-time
  43   ;; when NIL, the timer is automatically rescheduled
  44   ;; when triggered
  45   one-shot)
  46
  47 (defmethod print-object ((object timer) stream)
  48   (print-unreadable-object (object stream)
  49     (format stream "TIMER ~S, Timeout: [ ~A , ~A ], ~:[persistent~;one-shot~]"
  50             (or (%timer-name object)
  51                 "(unnamed)")
  52             (%timer-relative-time object)
  53             (%timer-expire-time object)
  54             (%timer-one-shot object))))
  55
  56 (defun make-timer (function delay &key (name "A timer") one-shot)
  57   (%make-timer name function (abs-timeout delay) delay one-shot))
  58
  59 (defun timer-name (timer)
  60   (%timer-name timer))
  61
  62 (defun timer-expired-p (timer now &optional (delta 0.0d0))
  63   (assert (%timer-expire-time timer) ((%timer-expire-time timer))
  64            "Timer ~A must have an expiry time set." timer)
  65   (let ((compare-time (+ now delta)))
  66     (> compare-time (%timer-expire-time timer))))
  67
  68 (defun reset-timer (timer)
  69   (setf (%timer-expire-time timer) 0))