/[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 - (hide annotations)
Mon May 7 09:32:46 2012 UTC (23 months, 1 week ago) by rklochkov
Branch: MAIN
CVS Tags: HEAD
Changes since 1.3: +7 -4 lines
Fixed examples/ex6
1 rklochkov 1.1 ;; 424
2    
3     (asdf:oos 'asdf:load-op :gtk-cffi)
4    
5     (defpackage #:test
6 rklochkov 1.2 (:use #:common-lisp #:gdk-cffi #:gtk-cffi #:g-object-cffi)
7     (:shadowing-import-from #:gtk-cffi #:image #:window))
8 rklochkov 1.1 (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 rklochkov 1.3 (defun expose-event (widget context &optional (img "none"))
37     (format t "~a ~a ~a~%" widget context img)
38 rklochkov 1.1 (let* ((pixbuf (make-instance 'pixbuf :file img))
39     (w (width pixbuf))
40 rklochkov 1.3 (dest-x (- (width (allocation widget)) w))
41 rklochkov 1.1 (dest-y 0))
42 rklochkov 1.3 (format t "~a~%" pixbuf)
43     (cl-cairo2:with-context ((make-instance 'cl-cairo2:context
44     :pointer context))
45 rklochkov 1.4 (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 rklochkov 1.3 ; (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 rklochkov 1.1
58    
59 rklochkov 1.2 (let ((eventbox-left (make-instance 'event-box))
60     (vbox-left (make-instance 'v-box :homogeneous t)))
61 rklochkov 1.1 (pack hbox eventbox-left :expand t :fill t)
62 rklochkov 1.2 (add eventbox-left vbox-left)
63 rklochkov 1.1 (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 rklochkov 1.3 (setf (gsignal eventbox-left :draw :data "ball_green3.png")
69 rklochkov 1.1 #'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 rklochkov 1.3 (setf (color eventbox-right :type :bg) "#BAFFB3")
80     (setf (gsignal eventbox-right :draw :data "ball_blue3.png")
81 rklochkov 1.1 #'expose-event))
82    
83     (show window :all t)
84     (gtk-main)
85    
86    
87    
88    
89    

  ViewVC Help
Powered by ViewVC 1.1.5