gdk/gdk.visual.lisp

   1 (in-package :gdk)
   2
   3 (defcfun (%gdk-query-depths "gdk_query_depths") :void
   4   (depths (:pointer (:pointer :int)))
   5   (count (:pointer :int)))
   6
   7 (defun gdk-query-depths ()
   8   (with-foreign-objects ((count-r :int) (depths-r :pointer))
   9     (%gdk-query-depths depths-r count-r)
  10     (iter (with count = (mem-ref count-r :int))
  11           (with depths = (mem-ref depths-r :pointer))
  12           (for i from 0 below count)
  13           (collect (mem-aref depths :int i)))))
  14
  15 (export 'gdk-query-depths)
  16
  17 (defcfun (%gdk-query-visual-types "gdk_query_visual_types") :void
  18   (depths (:pointer (:pointer visual-type)))
  19   (count (:pointer :int)))
  20
  21 (defun gdk-query-visual-types ()
  22   (with-foreign-objects ((count-r :int) (types-r 'visual-type))
  23     (%gdk-query-visual-types types-r count-r)
  24     (iter (with count = (mem-ref count-r :int))
  25           (with types = (mem-ref types-r :pointer))
  26           (for i from 0 below count)
  27           (collect (mem-aref types 'visual-type i)))))
  28
  29 (export 'gdk-query-visual-types)
  30
  31 (defcstruct gdk-visual-cstruct
  32   (parent-instance gobject.ffi::%g-object)
  33   (visual-type visual-type)
  34   (depth :int)
  35   (byte-order byte-order)
  36   (colormap-size :int)
  37   (bits-per-rgb :int)
  38   (red-mask :uint32)
  39   (red-shift :int)
  40   (red-prec :int)
  41   (green-mask :uint32)
  42   (green-shift :int)
  43   (green-prec :int)
  44   (blue-mask :uint32)
  45   (blue-shift :int)
  46   (blue-prec :int))
  47
  48 (defmacro def-visual-accessor (slot)
  49   `(defun ,(intern (format nil "~A-GET-~A" (symbol-name 'gdk-visual) (symbol-name slot))) (visual)
  50      (foreign-slot-value (pointer visual) 'gdk-visual-cstruct ',slot)))
  51
  52 (def-visual-accessor visual-type)
  53 (def-visual-accessor depth)
  54 (def-visual-accessor byte-order)
  55 (def-visual-accessor colormap-size)
  56 (def-visual-accessor bits-per-rgb)
  57 (def-visual-accessor red-mask)
  58 (def-visual-accessor red-shift)
  59 (def-visual-accessor red-prec)
  60 (def-visual-accessor green-mask)
  61 (def-visual-accessor green-shift)
  62 (def-visual-accessor green-prec)
  63 (def-visual-accessor blue-mask)
  64 (def-visual-accessor blue-shift)
  65 (def-visual-accessor blue-prec)
  66
  67 (defcfun (list-visuals "gdk_list_visuals") (glib:glist (g-object visual) :free-from-foreign t))
  68
  69 (export 'list-visuals)
  70
  71 (defcfun (visual-get-best-depth "gdk_visual_get_best_depth") :int)
  72 (export 'visual-get-best-depth)
  73
  74 (defcfun (visual-get-best-type "gdk_visual_get_best_type") visual-type)
  75 (export 'visual-get-best-type)
  76
  77 (defcfun (visual-get-system "gdk_visual_get_system") (g-object visual))
  78 (export 'visual-get-system)
  79
  80 (defcfun (visual-get-best "gdk_visual_get_best") (g-object visual))
  81 (export 'visual-get-best)
  82
  83 (defcfun (visual-get-best-with-depth "gdk_visual_get_best_with_depth") (g-object visual)
  84   (depth :int))
  85 (export 'visual-get-best-with-depth)
  86
  87 (defcfun (visual-get-best-with-both "gdk_visual_get_best_with_both") (g-object visual)
  88   (depth :int)
  89   (visual-type visual-type))
  90 (export 'visual-get-best-with-both)
  91
  92 (defmethod print-object ((visual visual) stream)
  93   (print-unreadable-object (visual stream :type t :identity t)
  94     (format stream "~S at ~S bpp" (visual-visual-type visual) (visual-depth visual))))