[gtk-cffi-cvs] CVS gtk-cffi/gdk
CVS User rklochkov
rklochkov at common-lisp.net
Fri Aug 26 17:16:14 UTC 2011
Update of /project/gtk-cffi/cvsroot/gtk-cffi/gdk
In directory tiger.common-lisp.net:/tmp/cvs-serv16215/gdk
Modified Files:
color.lisp gdk-cffi.asd image.lisp loadlib.lisp package.lisp
pixbuf.lisp window.lisp
Added Files:
rectangle.lisp
Log Message:
Added GTK3 support. Dropped GTK2 support.
Refactored CFFI layer.
--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/color.lisp 2011/04/25 19:16:07 1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/color.lisp 2011/08/26 17:16:14 1.2
@@ -1,7 +1,7 @@
(in-package :gdk-cffi)
(defcstruct color-struct
- ""
+ "GdkColor"
(pixel :int32)
(red :int16)
(green :int16)
@@ -24,6 +24,33 @@
(defmethod translate-from-foreign (ptr (type color-cffi))
(gdk-color-to-string ptr))
-(defmethod free-translated-object (value (name color-cffi) free-p)
- (when free-p
- (foreign-free value)))
\ No newline at end of file
+(defmethod free-translated-object (value (name color-cffi) param)
+ (foreign-free value))
+
+(defcstruct rgba-struct
+ "GdkRGBA"
+ (red :double)
+ (green :double)
+ (blue :double)
+ (alpha :double))
+
+(define-foreign-type rgba-cffi ()
+ ()
+ (:actual-type :pointer)
+ (:simple-parser prgba))
+
+(defcfun gdk-rgba-parse :boolean (color rgba-struct) (str :string))
+(defcfun gdk-rgba-to-string :string (color rgba-struct))
+
+(defmethod translate-to-foreign (value (type rgba-cffi))
+ (if (pointerp value) value
+ (let ((color-st (foreign-alloc 'rgba-struct)))
+ (assert (gdk-rgba-parse color-st (string value)) (value)
+ "Bad RGBA color")
+ color-st)))
+
+(defmethod translate-from-foreign (ptr (type rgba-cffi))
+ (gdk-rgba-to-string ptr))
+
+(defmethod free-translated-object (value (name rgba-cffi) param)
+ (foreign-free value))
\ No newline at end of file
--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/gdk-cffi.asd 2011/04/25 19:16:07 1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/gdk-cffi.asd 2011/08/26 17:16:14 1.2
@@ -14,19 +14,19 @@
:author "Roman Klochkov <kalimehtar at mail.ru>"
:version "0.1"
:license "BSD"
- :depends-on (g-object-cffi g-lib-cffi)
+ :depends-on (g-object-cffi g-lib-cffi cl-cairo2)
:components
- ((:file :package)
- (:file :loadlib :depends-on (:package))
- (:file :generics :depends-on (:package))
- (:file :screen :depends-on (:loadlib :generics))
- (:file :keys :depends-on (:package))
- (:file :threads :depends-on (:package))
- (:file :event :depends-on (:loadlib :generics))
- (:file :color :depends-on (:loadlib :generics))
- (:file :drawable :depends-on (:loadlib :generics))
- (:file :window :depends-on (:drawable))
- (:file :gc :depends-on (:loadlib :generics))
- (:file :visual :depends-on (:loadlib :generics))
- (:file :image :depends-on (:visual))
- (:file :pixbuf :depends-on (:image :drawable :gc))))
+ ((:file package)
+ (:file loadlib :depends-on (package))
+ (:file generics :depends-on (package))
+ (:file rectangle :depends-on (loadlib generics))
+ (:file screen :depends-on (loadlib generics))
+ (:file keys :depends-on (package))
+ (:file threads :depends-on (package))
+ (:file event :depends-on (loadlib generics))
+ (:file color :depends-on (loadlib generics))
+ (:file window :depends-on (loadlib generics))
+ (:file gc :depends-on (loadlib generics))
+ (:file visual :depends-on (loadlib generics))
+ (:file image :depends-on (visual))
+ (:file pixbuf :depends-on (image gc))))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/image.lisp 2011/04/25 19:16:07 1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/image.lisp 2011/08/26 17:16:14 1.2
@@ -1,14 +1,14 @@
-(in-package :gdk-cffi)
+;(in-package :gdk-cffi)
+;
+;(defclass image (gobject)
+; ())
-(defclass image (gobject)
- ())
+;(defcenum image-type
+; :normal :shared :fastest)
-(defcenum image-type
- :normal :shared :fastest)
+;(defcfun "gdk_image_new" :pointer
+; (image-type image-type) (visual pobject) (width :int) (height :int))
-(defcfun "gdk_image_new" :pointer
- (image-type image-type) (visual pobject) (width :int) (height :int))
-
-(defmethod gconstructor ((image image)
- &key (type :fastest) visual width height)
- (gdk-image-new type (or visual (make-instance 'visual)) width height))
\ No newline at end of file
+;(defmethod gconstructor ((image image)
+; &key (type :fastest) visual width height)
+; (gdk-image-new type (or visual (make-instance 'visual)) width height))
\ No newline at end of file
--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/loadlib.lisp 2011/04/25 19:16:07 1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/loadlib.lisp 2011/08/26 17:16:14 1.2
@@ -8,8 +8,8 @@
(in-package :gdk-cffi)
(define-foreign-library :gdk
- (:unix "libgdk-x11-2.0.so")
- (:windows "libgdk-win32-2.0-0.dll"))
+ (:unix "libgdk-3.so.0")
+ (:windows "libgdk-win32-3xs-0.dll"))
(load-foreign-library :gdk)
--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/package.lisp 2011/04/25 19:16:07 1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/package.lisp 2011/08/26 17:16:14 1.2
@@ -8,12 +8,15 @@
(in-package #:cl-user)
(defpackage #:gdk-cffi
- (:use #:common-lisp #:cffi #:cffi-object #:g-lib-cffi #:g-object-cffi)
+ (:use #:common-lisp
+ #:cffi #:cffi-object #:g-lib-cffi #:g-object-cffi)
+ (:import-from #:cl-cairo2 #:x #:y #:width #:height #:cairo_rectangle_t)
(:export
; types
#:event-mask
#:extension-mode
#:pcolor
+ #:prgba
#:color-struct
#:event
;; methods of event
@@ -22,16 +25,17 @@
#:parse-event
+ #:rectangle
+ #:intersect
+ #:union
+
#:screen
;; slots of screen
#:height
#:width
- #:drawable
- #:draw-pixbuf
-
-
#:window
+ #:modifier-type
#:pixmap
--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pixbuf.lisp 2011/04/25 19:16:07 1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pixbuf.lisp 2011/08/26 17:16:14 1.2
@@ -21,25 +21,25 @@
(defgeneric new-from-image (image width height src-x src-y))
-(defcfun "gdk_pixbuf_get_from_image" :void (pixbuf pobject) (image pobject)
- (colormap pobject) (src-x :int) (src-y :int) (dst-x :int) (dst-y :int)
- (width :int) (height :int))
-
-(defcfun "gdk_pixbuf_get_from_drawable" :void (pixbuf pobject)
- (drawable pobject) (colormap pobject)
- (src-x :int) (src-y :int) (dst-x :int) (dst-y :int)
- (width :int) (height :int))
-
-(defmethod new-from-image ((image image) width height src-x src-y)
- (gdk-pixbuf-get-from-image (null-pointer) image (null-pointer)
- src-x src-y 0 0 width height))
-
-(defmethod new-from-image ((drawable drawable) width height src-x src-y)
- (gdk-pixbuf-get-from-drawable (null-pointer) drawable (null-pointer)
- src-x src-y 0 0 width height))
+;; (defcfun "gdk_pixbuf_get_from_image" :void (pixbuf pobject) (image pobject)
+;; (colormap pobject) (src-x :int) (src-y :int) (dst-x :int) (dst-y :int)
+;; (width :int) (height :int))
+
+;; (defcfun "gdk_pixbuf_get_from_drawable" :void (pixbuf pobject)
+;; (drawable pobject) (colormap pobject)
+;; (src-x :int) (src-y :int) (dst-x :int) (dst-y :int)
+;; (width :int) (height :int))
+
+;(defmethod new-from-image ((image image) width height src-x src-y)
+; (gdk-pixbuf-get-from-image (null-pointer) image (null-pointer)
+; src-x src-y 0 0 width height))
+
+;(defmethod new-from-image ((drawable drawable) width height src-x src-y)
+; (gdk-pixbuf-get-from-drawable (null-pointer) drawable (null-pointer)
+; src-x src-y 0 0 width height))
(defmethod gconstructor ((obj-pixbuf pixbuf)
- &key image file loader pixbuf
+ &key file loader pixbuf
height width
has-alpha (bits-per-sample 8)
(preserve-aspect-ratio t)
@@ -56,7 +56,7 @@
(gdk-pixbuf-new-from-file file g-error))))
;; from GdkImage or GdkDrawable
- (image (new-from-image image width height src-x src-y))
+; (image (new-from-image image width height src-x src-y))
;(loader (new-from-loader loader))
(pixbuf
@@ -77,15 +77,15 @@
(defcenum rgb-dither
:none :normal :max)
-(defcfun "gdk_draw_pixbuf" :void (drawable pobject) (gc pobject)
- (pixbuf pobject) (src-x :int) (src-y :int) (dst-x :int) (dst-y :int)
- (width :int) (height :int) (dither rgb-dither)
- (x-dither :int) (y-dither :int))
-
-(defmethod draw-pixbuf ((drawable drawable) (gc gc) (pixbuf pixbuf)
- &optional (src-x 0) (src-y 0)
- (dst-x 0) (dst-y 0) (width -1) (height -1)
- (dither :none) (x-dither 0) (y-dither 0))
- (gdk-draw-pixbuf drawable gc pixbuf src-x src-y dst-x dst-y
- width height dither x-dither y-dither))
+;; (defcfun "gdk_draw_pixbuf" :void (drawable pobject) (gc pobject)
+;; (pixbuf pobject) (src-x :int) (src-y :int) (dst-x :int) (dst-y :int)
+;; (width :int) (height :int) (dither rgb-dither)
+;; (x-dither :int) (y-dither :int))
+
+;; (defmethod draw-pixbuf ((drawable drawable) (gc gc) (pixbuf pixbuf)
+;; &optional (src-x 0) (src-y 0)
+;; (dst-x 0) (dst-y 0) (width -1) (height -1)
+;; (dither :none) (x-dither 0) (y-dither 0))
+;; (gdk-draw-pixbuf drawable gc pixbuf src-x src-y dst-x dst-y
+;; width height dither x-dither y-dither))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/window.lisp 2011/04/25 19:16:07 1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/window.lisp 2011/08/26 17:16:14 1.2
@@ -1,5 +1,12 @@
(in-package :gdk-cffi)
-(defclass window (drawable)
+(defclass window (g-object)
())
+(defclass x11-window (window)
+ ())
+
+(defbitfield modifier-type
+ :shift :lock :control :mod1 :mod2 :mod3 :mod4 :mod5
+ :button1 :button2 :button3 :button4 :button5
+ (:super #.(ash 1 26)) :hyper :meta (:release #.(ash 1 30)))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/rectangle.lisp 2011/08/26 17:16:14 NONE
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/rectangle.lisp 2011/08/26 17:16:14 1.1
(in-package :gdk-cffi)
(defclass rectangle (object)
())
(defmacro with-rectangle (rect &body body)
`(with-object (,rect) (make-instance 'rectangle) , at body))
(defmethod gconstructor ((rectangle rectangle) &key &allow-other-keys)
(foreign-alloc 'cairo_rectangle_t))
(defmethod free :before ((rectangle rectangle))
(foreign-free (pointer rectangle)))
(defcstruct-accessors (rectangle . cairo_rectangle_t)
x y height width)
(defcfun gdk-rectangle-intersect :boolean
(src1 pobject) (src2 pobject) (dest pobject))
(defmethod intersect ((rect1 rectangle) (rect2 rectangle))
(let ((dest (make-instance 'rectangle)))
(if (gdk-rectangle-intersect rect1 rect2 dest)
dest
(progn (free dest) nil))))
(defcfun gdk-rectangle-union :void
(src1 pobject) (src2 pobject) (dest pobject))
(defmethod rectangle-union ((rect1 rectangle) (rect2 rectangle))
(let ((dest (make-instance 'rectangle)))
(gdk-rectangle-union rect1 rect2 dest)))
(defcfun gdk-rectangle-get-type g-type)
More information about the gtk-cffi-cvs
mailing list