[gtk-cffi-cvs] CVS gtk-cffi/examples
CVS User rklochkov
rklochkov at common-lisp.net
Mon May 7 09:02:04 UTC 2012
Update of /project/gtk-cffi/cvsroot/gtk-cffi/examples
In directory tiger.common-lisp.net:/tmp/cvs-serv22276/examples
Modified Files:
ex2.lisp ex4.lisp ex6.lisp ex7.lisp ex8.lisp ex9.lisp
Log Message:
Added with-progress in extensions
Added GtkOrientable, GtkRange, GtkBuildable, & Cairo support in gdk (see examples/ex6)
Fixed all examples.
--- /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex2.lisp 2011/12/31 17:20:56 1.5
+++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex2.lisp 2012/05/07 09:02:03 1.6
@@ -1,7 +1,7 @@
(asdf:oos 'asdf:load-op :gtk-cffi)
(defpackage :test-ex2
- (:use #:common-lisp #:gtk-cffi #:cffi-object #:g-object-cffi))
+ (:use #:common-lisp #:gtk-cffi #:cffi-objects #:g-object-cffi))
(in-package :test-ex2)
@@ -16,7 +16,7 @@
("finance" (480 360))))
(cffi:defcallback clicked
- :void ((widget :pointer) (activated-module gtk-string))
+ :void ((widget :pointer) (activated-module :string))
(declare (ignore widget))
(declare (ignorable widget))
(format t "button_clicked: ~a~%" activated-module)
@@ -30,7 +30,7 @@
(cffi:defcallback on-delete :boolean ((widget :pointer)
(event :pointer)
- (module gtk-string))
+ (module :string))
(declare (ignore widget event))
(unless (string= module "main")
(hide (gethash module *apps*))
@@ -39,7 +39,7 @@
(cffi:defcallback on-key :boolean ((widget :pointer)
(event :pointer)
- (module gtk-string))
+ (module :string))
(declare (ignore widget))
(when (eq (gdk-cffi:parse-event event :keyval) (gdk-cffi:key :f12))
(format t "~a~%" module)
@@ -70,7 +70,7 @@
(pack h-box (make-instance 'label) :fill t :expand t)
(setf (gsignal button :clicked
:data (cffi:convert-to-foreign
- (car module) 'gtk-string))
+ (car module) :string))
(cffi:callback clicked))))
*mods*)))
@@ -78,7 +78,7 @@
(defun setup-app (module)
(let ((dialog (make-instance 'dialog :title (car module) :flags :modal)))
- (setf (window-position dialog) :center-always)
+ (setf (position-type dialog) :center-always)
(setf (size-request dialog) (second module))
;(setf (property dialog :content-area-border) 10)
(let ((top-area (content-area dialog)))
@@ -99,10 +99,10 @@
(show-buttons top-area (car module)))
;(setf (has-separator dialog) nil)
(setf (gsignal dialog :delete-event
- :data (cffi:convert-to-foreign (car module) 'gtk-string))
+ :data (cffi:convert-to-foreign (car module) :string))
(cffi:callback on-delete)
(gsignal dialog :key-press-event
- :data (cffi:convert-to-foreign (car module) 'gtk-string))
+ :data (cffi:convert-to-foreign (car module) :string))
(cffi:callback on-key))
dialog))
--- /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex4.lisp 2011/08/26 17:16:13 1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex4.lisp 2012/05/07 09:02:03 1.3
@@ -8,24 +8,24 @@
(gtk-init)
(let ((window (make-instance 'window :width 400 :height 280))
(hpane (make-instance 'h-paned)))
-
+
(setf (gsignal window :destroy) :gtk-main-quit)
-
+
(let ((v-box (make-instance 'v-box)))
(add window v-box)
-
+
(let ((title (make-instance 'label :text "Use of GtkHPaned")))
(setf (font title) "Times New Roman Italic 10"
(color title) "#0000ff")
(setf (size-request title) '(-1 40))
(pack v-box title :expand nil))
-
+
(pack v-box (make-instance
- 'label :text "Click on the options on the left pane.")
+ 'label :text "Click on the options on the left pane.")
:expand nil)
(pack v-box (make-instance 'label) :expand nil)
(pack v-box hpane :fill t :expand t))
-
+
(let ((left-pane (make-instance 'frame))
(v-box (make-instance 'v-box)))
(setf (shadow-type left-pane) :in)
@@ -35,7 +35,8 @@
(pack v-box (create-link "Qty > 10"))
(pack v-box (create-link "Price < $10"))
(pack hpane left-pane))
-
+
+
(let ((right-pane (make-instance 'frame))
(data '(("row 0" "item 42" 2 3.1)
("row 1" "item 36" 20 6.21)
@@ -44,17 +45,17 @@
("row 4" "item 7" 5 15.5)
("row 5" "item 4" 17 18.6)
("row 6" "item 3" 20 21.73))))
-
+
(setf data (append data data))
(setf data (append data data))
(setf data (append data data))
-
+
(setf (shadow-type right-pane) :in)
(pack hpane right-pane :pane-type 2 :resize t)
(format t "parent of ~a is ~a~%" right-pane
(property right-pane :parent))
(display-table right-pane data))
-
+
(show window :all t)
(gtk-main)))
@@ -110,7 +111,7 @@
(setf (widget column) label)
(show label))
(if (/= col 0) (setf (reorderable column) t))
- (setf (cell-data-func column cell-renderer col)
+ (setf (cell-data-func column cell-renderer :data col)
(cffi:callback format-col))
(append-column *view* column)))))
--- /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex6.lisp 2011/08/08 15:02:01 1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex6.lisp 2012/05/07 09:02:03 1.3
@@ -33,18 +33,23 @@
((setf hbox (make-instance 'h-box :homogeneous t))
:expand t :fill t)))
-(defun expose-event (widget event &optional (img "none"))
- (format t "~a ~a ~a~%" widget event img)
+(defun expose-event (widget context &optional (img "none"))
+ (format t "~a ~a ~a~%" widget context img)
(let* ((pixbuf (make-instance 'pixbuf :file img))
(w (width pixbuf))
- ;(h (height pixbuf))
- (dest-x (- (allocation-width (allocation widget)) w))
+ (dest-x (- (width (allocation widget)) w))
(dest-y 0))
- (draw-pixbuf (gdk-window widget)
- (style-field widget :bg-gc) pixbuf 0 0 dest-x dest-y)
- (let ((ch (child widget)))
- (when ch
- (propagate-expose widget ch event)))
+ (format t "~a~%" pixbuf)
+ (unless (cffi:null-pointer-p (cffi-objects:pointer pixbuf))
+ (cl-cairo2:with-context ((make-instance 'cl-cairo2:context
+ :pointer context))
+ (cairo-set-source-pixbuf pixbuf dest-x dest-y)
+ (cl-cairo2:paint)))
+; (draw-pixbuf (gdk-window widget)
+; (style-field widget :bg-gc) pixbuf 0 0 dest-x dest-y)
+ ;(let ((ch (child widget)))
+ ; (when ch
+ ; (propagate- widget ch event)))
t))
@@ -57,7 +62,7 @@
((make-instance 'label :text "The green ball is the bg image."))
((make-instance 'label :text "Note that this eventbox"))
((make-instance 'label :text "uses the default gray backgd color.")))
- (setf (gsignal eventbox-left :expose-event :data "ball_green3.png")
+ (setf (gsignal eventbox-left :draw :data "ball_green3.png")
#'expose-event))
(let ((eventbox-right (make-instance 'event-box)))
@@ -68,8 +73,8 @@
((make-instance 'label :text "The blue ball is the bg image."))
((make-instance 'label :text "Note that you can also set"))
((make-instance 'label :text "backgd color for the eventbox!")))
- (setf (color eventbox-right :bg) "#BAFFB3")
- (setf (gsignal eventbox-right :expose-event :data "ball_blue3.png")
+ (setf (color eventbox-right :type :bg) "#BAFFB3")
+ (setf (gsignal eventbox-right :draw :data "ball_blue3.png")
#'expose-event))
(show window :all t)
--- /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex7.lisp 2011/08/26 17:16:13 1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex7.lisp 2012/05/07 09:02:03 1.4
@@ -107,29 +107,30 @@
(setf (search-column view) i)))))
(defun on-click (view path-list)
- (destructuring-bind (path column x y) path-list
- (declare (ignore y))
- (let ((cell (get-cell-at column x)))
- (format t "cell: ~A~%" cell)
- (when (equal cell *cell-pix*)
- (let ((dialog (make-instance 'dialog :title "Edit text"
- :parent *window*
- :buttons '((:gtk-ok :ok)
- (:gtk-cancel :cancel)))))
- (let ((text-view (make-instance 'text-view))
- (iter (path->iter (model view) path)))
- (setf (text (buffer text-view))
- (car (model-values (model view) :columns '(1) :iter iter)))
- (let ((top-area (content-area dialog)))
- (pack top-area text-view :pack-fill t :expand t)
- (show text-view))
- (setf (window-position dialog) :center-on-parent)
-
- ;(pack top-area text-view :fill t :expand t))
- (run dialog)
- (setf (model-values (model view) :columns '(1) :iter iter)
- (list (text (buffer text-view))))
- (destroy dialog)))))))
+ (when path-list
+ (destructuring-bind (path column x y) path-list
+ (declare (ignore y))
+ (let ((cell (get-cell-at column x)))
+ (format t "cell: ~A~%" cell)
+ (when (equal cell *cell-pix*)
+ (let ((dialog (make-instance 'dialog :title "Edit text"
+ :parent *window*
+ :buttons '((:gtk-ok :ok)
+ (:gtk-cancel :cancel)))))
+ (let ((text-view (make-instance 'text-view))
+ (iter (path->iter (model view) path)))
+ (setf (text (buffer text-view))
+ (car (model-values (model view) :columns '(1) :iter iter)))
+ (let ((top-area (content-area dialog)))
+ (pack top-area text-view :pack-fill t :expand t)
+ (show text-view))
+ (setf (window-position dialog) :center-on-parent)
+
+ ;(pack top-area text-view :fill t :expand t))
+ (run dialog)
+ (setf (model-values (model view) :columns '(1) :iter iter)
+ (list (text (buffer text-view))))
+ (destroy dialog))))))))
(main)
--- /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex8.lisp 2011/08/08 15:02:01 1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex8.lisp 2012/05/07 09:02:03 1.3
@@ -3,9 +3,9 @@
(asdf:oos 'asdf:load-op :gtk-cffi)
(asdf:oos 'asdf:load-op :closer-mop)
-(defpackage #:test
+(defpackage #:test8
(:use #:common-lisp #:gtk-cffi #:g-object-cffi))
-(in-package #:test)
+(in-package #:test8)
(defun main ()
(gtk-init)
--- /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex9.lisp 2012/01/21 18:35:00 1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex9.lisp 2012/05/07 09:02:03 1.4
@@ -1,8 +1,8 @@
(asdf:oos 'asdf:load-op :gtk-cffi-ext)
;(declaim (optimize speed))
-(defpackage #:test
+(defpackage #:test9
(:use #:common-lisp #:iter #:gtk-cffi #:gtk-cffi-ext #:g-object-cffi))
-(in-package #:test)
+(in-package #:test9)
(gtk-init)
(defparameter *model*
More information about the gtk-cffi-cvs
mailing list