/[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.4 - (show annotations)
Mon May 7 09:32:46 2012 UTC (23 months, 2 weeks ago) by rklochkov
Branch: MAIN
CVS Tags: HEAD
Changes since 1.3: +7 -4 lines
Fixed examples/ex6
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 context &optional (img "none"))
37 (format t "~a ~a ~a~%" widget context img)
38 (let* ((pixbuf (make-instance 'pixbuf :file img))
39 (w (width pixbuf))
40 (dest-x (- (width (allocation widget)) w))
41 (dest-y 0))
42 (format t "~a~%" pixbuf)
43 (cl-cairo2:with-context ((make-instance 'cl-cairo2:context
44 :pointer context))
45 (unless (cffi:null-pointer-p (cffi-objects:pointer pixbuf))
46 (cairo-set-source-pixbuf pixbuf dest-x dest-y)
47 (cl-cairo2:paint))
48 (let ((ch (child widget)))
49 (when ch (propagate-draw widget ch)))))
50 t)
51
52 ; (draw-pixbuf (gdk-window widget)
53 ; (style-field widget :bg-gc) pixbuf 0 0 dest-x dest-y)
54 ;(let ((ch (child widget)))
55 ; (when ch
56 ; (propagate- widget ch event)))
57
58
59 (let ((eventbox-left (make-instance 'event-box))
60 (vbox-left (make-instance 'v-box :homogeneous t)))
61 (pack hbox eventbox-left :expand t :fill t)
62 (add eventbox-left vbox-left)
63 (pack* vbox-left
64 ((make-instance 'label :text "This is left eventbox."))
65 ((make-instance 'label :text "The green ball is the bg image."))
66 ((make-instance 'label :text "Note that this eventbox"))
67 ((make-instance 'label :text "uses the default gray backgd color.")))
68 (setf (gsignal eventbox-left :draw :data "ball_green3.png")
69 #'expose-event))
70
71 (let ((eventbox-right (make-instance 'event-box)))
72 (pack hbox eventbox-right :expand t :fill t)
73 (add eventbox-right (setf vbox-right (make-instance 'v-box :homogeneous t)))
74 (pack* vbox-right
75 ((make-instance 'label :text "This is right eventbox."))
76 ((make-instance 'label :text "The blue ball is the bg image."))
77 ((make-instance 'label :text "Note that you can also set"))
78 ((make-instance 'label :text "backgd color for the eventbox!")))
79 (setf (color eventbox-right :type :bg) "#BAFFB3")
80 (setf (gsignal eventbox-right :draw :data "ball_blue3.png")
81 #'expose-event))
82
83 (show window :all t)
84 (gtk-main)
85
86
87
88
89

  ViewVC Help
Powered by ViewVC 1.1.5