gtk/gtk.timer.lisp

   1 (in-package :gtk)
   2
   3 (defclass timer ()
   4   ((fn :initform nil :initarg :fn :accessor timer-fn)
   5    (interval-msec :initform 100 :initarg :interval-msec :accessor timer-interval-msec)
   6    (source-id :initform nil)))
   7
   8 (defun timer-enabled-p (timer)
   9   (not (null (slot-value timer 'source-id))))
  10
  11 (defun (setf timer-enabled-p) (new-value timer)
  12   (unless (eq new-value (timer-enabled-p timer))
  13     (if new-value
  14         (start-timer timer)
  15         (stop-timer timer))))
  16
  17 (defmethod (setf timer-interval-msec) :after (new-value (timer timer))
  18   (when (timer-enabled-p timer)
  19     (stop-timer timer)
  20     (start-timer timer)))
  21
  22 (defun start-timer (timer)
  23   (unless (slot-value timer 'source-id)
  24     (setf (slot-value timer 'source-id)
  25           (gtk-main-add-timeout (timer-interval-msec timer) (lambda () (funcall (timer-fn timer)) t)))))
  26
  27 (defun stop-timer (timer)
  28   (when (slot-value timer 'source-id)
  29     (glib:g-source-remove (slot-value timer 'source-id))
  30     (setf (slot-value timer 'source-id) nil)))
  31
  32 (export '(timer timer-fn timer-interval-msec timer-enabled-p timer-interval-msec start-timer stop-timer))