From 186393b1d4ace5ac7515f81e74a2b77d0be87a82 Mon Sep 17 00:00:00 2001 From: Dmitry Kalyanov Date: Sun, 8 Nov 2009 18:47:31 +0300 Subject: [PATCH] Add Gdk/Visuals and Gdk/Cursors --- gdk/cl-gtk2-gdk.asd | 4 +- gdk/gdk.cursor.lisp | 49 ++++++++++++++++++++ gdk/gdk.objects.lisp | 122 ++++++++++++++++++++++++++++++++++++++++++++++++-- gdk/gdk.visual.lisp | 94 ++++++++++++++++++++++++++++++++++++++ 4 files changed, 264 insertions(+), 5 deletions(-) create mode 100644 gdk/gdk.cursor.lisp create mode 100644 gdk/gdk.visual.lisp diff --git a/gdk/cl-gtk2-gdk.asd b/gdk/cl-gtk2-gdk.asd index 9060856..d64bdaa 100644 --- a/gdk/cl-gtk2-gdk.asd +++ b/gdk/cl-gtk2-gdk.asd @@ -17,5 +17,7 @@ (:file "gdk.rgb") (:file "gdk.images") (:file "gdk.pixbufs") - (:file "gdk.colors")) + (:file "gdk.colors") + (:file "gdk.visual") + (:file "gdk.cursor")) :depends-on (:cl-gtk2-glib :cffi :cl-gtk2-pango)) \ No newline at end of file diff --git a/gdk/gdk.cursor.lisp b/gdk/gdk.cursor.lisp new file mode 100644 index 0000000..324143e --- /dev/null +++ b/gdk/gdk.cursor.lisp @@ -0,0 +1,49 @@ +(in-package :gdk) + +(defcstruct %gdk-cursor + (cursor-type cursor-type)) + +(defun cursor-cursor-type (cursor) + (foreign-slot-value (pointer cursor) '%gdk-cursor 'cursor-type)) + +(export 'cursor-cursor-type) + +(defcfun (cursor-new "gdk_cursor_new") (g-boxed-foreign cursor :return) + (cursor-type cursor-type)) + +(export 'cursor-new) + +(defcfun (cursor-new-from-pixmap "gdk_cursor_new_from_pixmap") (g-boxed-foreign cursor :return) + (source (g-object pixmap)) + (make (g-object pixmap)) + (fg-color (g-boxed-foreign color)) + (bg-color (g-boxed-foreign color)) + (x :int) + (y :int)) + +(export 'cursor-new-from-pixmap) + +(defcfun (cursor-new-from-pixbuf "gdk_cursor_new_from_pixbuf") (g-boxed-foreign cursor :return) + (display (g-object display)) + (pixbuf (g-object pixbuf)) + (x :int) + (y :int)) + +(export 'cursor-new-from-pixbuf) + +(defcfun (cursor-new-from-name "gdk_cursor_new_from_name") (g-boxed-foreign cursor :return) + (display (g-object display)) + (name :string)) + +(export 'cursor-new-from-name) + +(defcfun (cursor-new-for-display "gdk_cursor_new_for_display") (g-boxed-foreign cursor :return) + (display (g-object display)) + (cursor-type cursor-type)) + +(export 'cursor-new-for-display) + +(define-boxed-opaque-accessor cursor cursor-display :type (g-object display) :reader "gdk_cursor_get_display") +(define-boxed-opaque-accessor cursor cursor-image :type (g-object pixbuf) :reader "gdk_cursor_get_image") + +(export '(cursor-display cursor-image)) diff --git a/gdk/gdk.objects.lisp b/gdk/gdk.objects.lisp index fbd4a64..a03eb8b 100644 --- a/gdk/gdk.objects.lisp +++ b/gdk/gdk.objects.lisp @@ -106,6 +106,106 @@ (:normal 1) (:max 2)) +(define-g-enum "GdkVisualType" + visual-type + (:export t :type-initializer "gdk_visual_type_get_type") + (:static-gray 0) + (:grayscale 1) + (:static-color 2) + (:pseudo-color 3) + (:true-color 4) + (:direct-color 5)) + +(define-g-enum "GdkByteOrder" + byte-order + (:export t :type-initializer "gdk_byte_order_get_type") + (:lsb-first 0) + (:msb-first 1)) + +(define-g-enum "GdkCursorType" + gdk-cursor-type + (:export t :type-initializer "gdk_cursor_type_get_type") + (:x-cursor 0) + (:arrow 2) + (:based-arrow-down 4) + (:based-arrow-up 6) + (:boat 8) + (:bogosity 10) + (:bottom-left-corner 12) + (:bottom-right-corner 14) + (:bottom-side 16) + (:bottom-tee 18) + (:box-spiral 20) + (:center-ptr 22) + (:circle 24) + (:clock 26) + (:coffee-mug 28) + (:cross 30) + (:cross-reverse 32) + (:crosshair 34) + (:diamond-cross 36) + (:dot 38) + (:dotbox 40) + (:double-arrow 42) + (:draft-large 44) + (:draft-small 46) + (:draped-box 48) + (:exchange 50) + (:fleur 52) + (:gobbler 54) + (:gumby 56) + (:hand1 58) + (:hand2 60) + (:heart 62) + (:icon 64) + (:iron-cross 66) + (:left-ptr 68) + (:left-side 70) + (:left-tee 72) + (:leftbutton 74) + (:ll-angle 76) + (:lr-angle 78) + (:man 80) + (:middlebutton 82) + (:mouse 84) + (:pencil 86) + (:pirate 88) + (:plus 90) + (:question-arrow 92) + (:right-ptr 94) + (:right-side 96) + (:right-tee 98) + (:rightbutton 100) + (:rtl-logo 102) + (:sailboat 104) + (:sb-down-arrow 106) + (:sb-h-double-arrow 108) + (:sb-left-arrow 110) + (:sb-right-arrow 112) + (:sb-up-arrow 114) + (:sb-v-double-arrow 116) + (:shuttle 118) + (:sizing 120) + (:spider 122) + (:spraycan 124) + (:star 126) + (:target 128) + (:tcross 130) + (:top-left-arrow 132) + (:top-left-corner 134) + (:top-right-corner 136) + (:top-side 138) + (:top-tee 140) + (:trek 142) + (:ul-angle 144) + (:umbrella 146) + (:ur-angle 148) + (:watch 150) + (:xterm 152) + (:last-cursor 153) + (:blank-cursor -2) + (:cursor-is-pixmap -1)) + (define-g-object-class "GdkDisplay" display () ((:cffi name display-name (glib:g-string :free-from-foreign nil) "gdk_display_get_name" nil) @@ -143,7 +243,22 @@ (:cffi displays display-manager-displays (glib:gslist (g-object display) :free-from-foreign t) "gdk_display_manager_list_displays" nil))) -(define-g-object-class "GdkVisual" visual () ()) +(define-g-object-class "GdkVisual" visual () + ((:cffi screen visual-screen (g-object screen) "gdk_visual_get_screen" nil) + (:cffi visual-type visual-visual-type visual-type gdk-visual-get-visual-type nil) + (:cffi depth visual-depth :int gdk-visual-get-depth nil) + (:cffi byte-order visual-byte-order byte-order gdk-visual-get-byte-order nil) + (:cffi colormap-size visual-colormap-size :int gdk-visual-get-colormap-size nil) + (:cffi bits-per-rgb visual-bits-per-rgb :int gdk-visual-get-bits-per-rgb nil) + (:cffi red-mask visual-red-mask :uint32 gdk-visual-get-red-mask nil) + (:cffi red-shift visual-red-shift :int gdk-visual-get-red-shift nil) + (:cffi red-prec visual-red-prec :int gdk-visual-get-red-prec nil) + (:cffi green-mask visual-green-mask :uint32 gdk-visual-get-green-mask nil) + (:cffi green-shift visual-green-shift :int gdk-visual-get-green-shift nil) + (:cffi green-prec visual-green-prec :int gdk-visual-get-green-prec nil) + (:cffi blue-mask visual-blue-mask :uint32 gdk-visual-get-blue-mask nil) + (:cffi blue-shift visual-blue-shift :int gdk-visual-get-blue-shift nil) + (:cffi blue-prec visual-blue-prec :int gdk-visual-get-blue-prec nil))) (define-g-object-class "GdkColormap" gdk-colormap (:superclass g-object :export t :interfaces @@ -434,7 +549,7 @@ (glib:at-init () (foreign-funcall-pointer (foreign-symbol-pointer "gdk_cursor_get_type") () :int)) -(gobject:define-g-enum "GdkCursorType" cursor-type (:export t :type-initializer "gdk_cursor_type_get_type") +(define-g-enum "GdkCursorType" cursor-type (:export t :type-initializer "gdk_cursor_type_get_type") (:x-cursor 0) (:arrow 2) (:based-arrow-down 4) (:based-arrow-up 6) (:boat 8) (:bogosity 10) (:bottom-left-corner 12) (:bottom-right-corner 14) @@ -467,8 +582,7 @@ (export 'cursor-type) -(define-g-boxed-cstruct cursor "GdkCursor" - (type cursor-type)) +(define-g-boxed-opaque cursor "GdkCursor" :alloc (error "GdkCursor can not be created from Lisp side")) (export (boxed-related-symbols 'cursor)) diff --git a/gdk/gdk.visual.lisp b/gdk/gdk.visual.lisp new file mode 100644 index 0000000..1579539 --- /dev/null +++ b/gdk/gdk.visual.lisp @@ -0,0 +1,94 @@ +(in-package :gdk) + +(defcfun (%gdk-query-depths "gdk_query_depths") :void + (depths (:pointer (:pointer :int))) + (count (:pointer :int))) + +(defun gdk-query-depths () + (with-foreign-objects ((count-r :int) (depths-r :pointer)) + (%gdk-query-depths depths-r count-r) + (iter (with count = (mem-ref count-r :int)) + (with depths = (mem-ref depths-r :pointer)) + (for i from 0 below count) + (collect (mem-aref depths :int i))))) + +(export 'gdk-query-depths) + +(defcfun (%gdk-query-visual-types "gdk_query_visual_types") :void + (depths (:pointer (:pointer visual-type))) + (count (:pointer :int))) + +(defun gdk-query-visual-types () + (with-foreign-objects ((count-r :int) (types-r 'visual-type)) + (%gdk-query-visual-types types-r count-r) + (iter (with count = (mem-ref count-r :int)) + (with types = (mem-ref types-r :pointer)) + (for i from 0 below count) + (collect (mem-aref types 'visual-type i))))) + +(export 'gdk-query-visual-types) + +(defcstruct gdk-visual-cstruct + (parent-instance gobject.ffi::%g-object) + (visual-type visual-type) + (depth :int) + (byte-order byte-order) + (colormap-size :int) + (bits-per-rgb :int) + (red-mask :uint32) + (red-shift :int) + (red-prec :int) + (green-mask :uint32) + (green-shift :int) + (green-prec :int) + (blue-mask :uint32) + (blue-shift :int) + (blue-prec :int)) + +(defmacro def-visual-accessor (slot) + `(defun ,(intern (format nil "~A-GET-~A" (symbol-name 'gdk-visual) (symbol-name slot))) (visual) + (foreign-slot-value (pointer visual) 'gdk-visual-cstruct ',slot))) + +(def-visual-accessor visual-type) +(def-visual-accessor depth) +(def-visual-accessor byte-order) +(def-visual-accessor colormap-size) +(def-visual-accessor bits-per-rgb) +(def-visual-accessor red-mask) +(def-visual-accessor red-shift) +(def-visual-accessor red-prec) +(def-visual-accessor green-mask) +(def-visual-accessor green-shift) +(def-visual-accessor green-prec) +(def-visual-accessor blue-mask) +(def-visual-accessor blue-shift) +(def-visual-accessor blue-prec) + +(defcfun (list-visuals "gdk_list_visuals") (glib:glist (g-object visual) :free-from-foreign t)) + +(export 'list-visuals) + +(defcfun (visual-get-best-depth "gdk_visual_get_best_depth") :int) +(export 'visual-get-best-depth) + +(defcfun (visual-get-best-type "gdk_visual_get_best_type") visual-type) +(export 'visual-get-best-type) + +(defcfun (visual-get-system "gdk_visual_get_system") (g-object visual)) +(export 'visual-get-system) + +(defcfun (visual-get-best "gdk_visual_get_best") (g-object visual)) +(export 'visual-get-best) + +(defcfun (visual-get-best-with-depth "gdk_visual_get_best_with_depth") (g-object visual) + (depth :int)) +(export 'visual-get-best-with-depth) + +(defcfun (visual-get-best-with-both "gdk_visual_get_best_with_both") (g-object visual) + (depth :int) + (visual-type visual-type)) +(export 'visual-get-best-with-both) + +(defmethod print-object ((visual visual) stream) + (print-unreadable-object (visual stream :type t :identity t) + (format stream "~S at ~S bpp" (visual-visual-type visual) (visual-depth visual)))) -- 1.7.10.4