/[gtk-cffi]/gtk-cffi/examples/ex3-flash-button.lisp
ViewVC logotype

Contents of /gtk-cffi/examples/ex3-flash-button.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (hide annotations)
Fri Aug 26 17:16:13 2011 UTC (2 years, 7 months ago) by rklochkov
Branch: MAIN
Changes since 1.1: +3 -3 lines
Added GTK3 support. Dropped GTK2 support.
Refactored CFFI layer.
1 rklochkov 1.1 (asdf:oos 'asdf:load-op :gtk-cffi)
2    
3     (defpackage #:test-ex3
4     (:use #:common-lisp #:gtk-cffi #:g-lib-cffi))
5     (in-package #:test-ex3)
6    
7     (gtk-init)
8    
9     (defvar window)
10     (defvar title)
11     (defvar button)
12     (defvar v-box)
13     (defvar h-box)
14    
15     (setf window (make-instance 'window))
16    
17     (setf (gsignal window :destroy) :gtk-main-quit
18     (size-request window) '(400 150))
19    
20     (add window (setf v-box (make-instance 'v-box)))
21    
22     (setf title (make-instance 'label :text "Create a Flashing Button - Part 1"))
23    
24    
25     (setf (font title) "Times New Roman Italic 10"
26     (color title) "#0000ff"
27     (size-request title) '(-1 60))
28    
29     (pack v-box title)
30     (pack v-box (setf h-box (make-instance 'h-box)))
31    
32     (setf button (make-instance 'button :label "Click Me!"))
33     (setf (size-request button) '(80 32)
34 rklochkov 1.2 (color button :background t) "#FFCC66")
35 rklochkov 1.1
36     (defvar *TIMEOUT*)
37    
38     (pack h-box button :expand t)
39     (setf (gsignal button :clicked)
40     (lambda (widget)
41     (declare (ignore widget))
42     (format t "You have clicked Click Me!~%")
43     (format t "~a~%" *TIMEOUT*)
44     (timeout-remove *TIMEOUT*)
45     (format t "We here ~%")))
46    
47     (realize window)
48    
49 rklochkov 1.2 (defparameter *ORG-BG* (color window :background t))
50 rklochkov 1.1
51     (let (i)
52     (defun flash (button bgcolor)
53 rklochkov 1.2 (setf (color button :background t) (if i *ORG-BG* bgcolor))
54 rklochkov 1.1 (setf i (not i)) t))
55    
56     (setf *TIMEOUT* (timeout-add 200 #'flash :data (list button "#FFCC66")))
57    
58     (format t "Set ~a~%" *TIMEOUT*)
59    
60     (show window :all t)
61     (gtk-main)
62    
63    

  ViewVC Help
Powered by ViewVC 1.1.5