/[gtk-cffi]/gtk-cffi/examples/ex6.lisp
ViewVC logotype

Contents of /gtk-cffi/examples/ex6.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Mon Aug 8 15:02:01 2011 UTC (2 years, 8 months ago) by rklochkov
Branch: MAIN
Changes since 1.1: +7 -5 lines
Major commit. Now all exerices ex*.lisp work perfectly.
Added lisp-array model for tree-view (see ex9).
1 ;; 424
2
3 (asdf:oos 'asdf:load-op :gtk-cffi)
4
5 (defpackage #:test
6 (:use #:common-lisp #:gdk-cffi #:gtk-cffi #:g-object-cffi)
7 (:shadowing-import-from #:gtk-cffi #:image #:window))
8 (in-package #:test)
9
10 (gtk-init)
11
12 (defvar window)
13 (defvar vbox)
14 (defvar title)
15 (defvar hbox)
16 (defvar vbox-right)
17
18 (setf window (make-instance 'window))
19
20 (setf (gsignal window :destroy) :gtk-main-quit
21 (size-request window) '(600 240))
22
23 (add window (setf vbox (make-instance 'v-box)))
24
25 (let ((title (make-instance 'label :text
26 " Place a background image in GtkEventBox\n
27 Part 2 - using GdkDrawable::draw_pixbuf()")))
28 (setf (font title) "Times New Roman Italic 10"
29 (color title) "#0000ff"
30 (size-request title) '(-1 40))
31 (pack* vbox title
32 ((make-instance 'label))
33 ((setf hbox (make-instance 'h-box :homogeneous t))
34 :expand t :fill t)))
35
36 (defun expose-event (widget event &optional (img "none"))
37 (format t "~a ~a ~a~%" widget event img)
38 (let* ((pixbuf (make-instance 'pixbuf :file img))
39 (w (width pixbuf))
40 ;(h (height pixbuf))
41 (dest-x (- (allocation-width (allocation widget)) w))
42 (dest-y 0))
43 (draw-pixbuf (gdk-window widget)
44 (style-field widget :bg-gc) pixbuf 0 0 dest-x dest-y)
45 (let ((ch (child widget)))
46 (when ch
47 (propagate-expose widget ch event)))
48 t))
49
50
51 (let ((eventbox-left (make-instance 'event-box))
52 (vbox-left (make-instance 'v-box :homogeneous t)))
53 (pack hbox eventbox-left :expand t :fill t)
54 (add eventbox-left vbox-left)
55 (pack* vbox-left
56 ((make-instance 'label :text "This is left eventbox."))
57 ((make-instance 'label :text "The green ball is the bg image."))
58 ((make-instance 'label :text "Note that this eventbox"))
59 ((make-instance 'label :text "uses the default gray backgd color.")))
60 (setf (gsignal eventbox-left :expose-event :data "ball_green3.png")
61 #'expose-event))
62
63 (let ((eventbox-right (make-instance 'event-box)))
64 (pack hbox eventbox-right :expand t :fill t)
65 (add eventbox-right (setf vbox-right (make-instance 'v-box :homogeneous t)))
66 (pack* vbox-right
67 ((make-instance 'label :text "This is right eventbox."))
68 ((make-instance 'label :text "The blue ball is the bg image."))
69 ((make-instance 'label :text "Note that you can also set"))
70 ((make-instance 'label :text "backgd color for the eventbox!")))
71 (setf (color eventbox-right :bg) "#BAFFB3")
72 (setf (gsignal eventbox-right :expose-event :data "ball_blue3.png")
73 #'expose-event))
74
75 (show window :all t)
76 (gtk-main)
77
78
79
80
81

  ViewVC Help
Powered by ViewVC 1.1.5