(: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
--- /dev/null
+(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))
(: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)
(: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
(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)
(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))
--- /dev/null
+(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))))
projects / cl-gtk2.git / commitdiff