From 089f8e07b68f332f22027deb43a8ea43eebac0bc Mon Sep 17 00:00:00 2001 From: Dmitry Kalyanov Date: Sun, 18 Oct 2009 22:48:20 +0400 Subject: [PATCH] Add gtk:timer class --- gtk/cl-gtk2-gtk.asd | 1 + gtk/gtk.timer.lisp | 32 ++++++++++++++++++++++++++++++++ 2 files changed, 33 insertions(+) create mode 100644 gtk/gtk.timer.lisp diff --git a/gtk/cl-gtk2-gtk.asd b/gtk/cl-gtk2-gtk.asd index ee4ab70..621a7e9 100644 --- a/gtk/cl-gtk2-gtk.asd +++ b/gtk/cl-gtk2-gtk.asd @@ -60,6 +60,7 @@ (:file "gtk.dialog.example") (:file "gtk.demo") + (:file "gtk.timer") (:module "demo-files" :pathname "demo" :components ((:static-file "demo1.glade") diff --git a/gtk/gtk.timer.lisp b/gtk/gtk.timer.lisp new file mode 100644 index 0000000..cc93064 --- /dev/null +++ b/gtk/gtk.timer.lisp @@ -0,0 +1,32 @@ +(in-package :gtk) + +(defclass timer () + ((fn :initform nil :initarg :fn :accessor timer-fn) + (interval-msec :initform 100 :initarg :interval-msec :accessor timer-interval-msec) + (source-id :initform nil))) + +(defun timer-enabled-p (timer) + (not (null (slot-value timer 'source-id)))) + +(defun (setf timer-enabled-p) (new-value timer) + (unless (eq new-value (timer-enabled-p timer)) + (if new-value + (start-timer timer) + (stop-timer timer)))) + +(defmethod (setf timer-interval-msec) :after (new-value (timer timer)) + (when (timer-enabled-p timer) + (stop-timer timer) + (start-timer timer))) + +(defun start-timer (timer) + (unless (slot-value timer 'source-id) + (setf (slot-value timer 'source-id) + (gtk-main-add-timeout (timer-interval-msec timer) (lambda () (funcall (timer-fn timer))))))) + +(defun stop-timer (timer) + (when (slot-value timer 'source-id) + (glib:g-source-remove (slot-value timer 'source-id)) + (setf (slot-value timer 'source-id) nil))) + +(export '(timer timer-fn timer-interval-msec timer-enabled-p timer-interval-msec start-timer stop-timer)) -- 1.7.10.4