From 186393b1d4ace5ac7515f81e74a2b77d0be87a82 Mon Sep 17 00:00:00 2001
From: Dmitry Kalyanov <Kalyanov.Dmitry@gmail.com>
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