gdk/gdk.bitmaps.lisp

   1 (in-package :gdk)
   2
   3 (defcfun (pixmap-new "gdk_pixmap_new") (g-object pixmap :already-referenced)
   4   (drawable (g-object drawable))
   5   (width :int)
   6   (height :int)
   7   (depth :int))
   8
   9 (export 'pixmap-new)
  10
  11 (defcfun (bitmap-create-from-data "gdk_bitmap_create_from_data") (g-object pixmap :already-referenced)
  12   (drawable (g-object drawable))
  13   (data :pointer)
  14   (width :int)
  15   (height :int))
  16
  17 (export 'bitmap-create-from-data)
  18
  19 (defcfun (pixmap-create-from-data "gdk_pixmap_create_from_data") (g-object pixmap :already-referenced)
  20   (drawable (g-object drawable))
  21   (data :pointer)
  22   (width :int)
  23   (height :int)
  24   (depth :int)
  25   (fg-color (g-boxed-foreign color))
  26   (bg-color (g-boxed-foreign color)))
  27
  28 (export 'pixmap-create-from-data)
  29
  30 (defcfun gdk-pixmap-create-from-xpm (g-object pixmap :already-referenced)
  31   (drawable (g-object drawable))
  32   (mask :pointer)
  33   (transparent-color (g-boxed-foreign color))
  34   (filename :string))
  35
  36 (defcfun gdk-pixmap-colormap-create-from-xpm (g-object pixmap :already-referenced)
  37   (drawable (g-object drawable))
  38   (colormap (g-object colormap))
  39   (mask :pointer)
  40   (transparent-color (g-boxed-foreign color))
  41   (filename :string))
  42
  43 (defcfun gdk-pixmap-create-from-xpm-d (g-object pixmap :already-referenced)
  44   (drawable (g-object drawable))
  45   (mask :pointer)
  46   (transparent-color (g-boxed-foreign color))
  47   (data (:pointer :pointer)))
  48
  49 (defun gdk-pixmap-create-from-xpm-d-1 (drawable mask transparent-color data)
  50   (let ((n (length data)))
  51     (with-foreign-object (data-ptr :pointer n)
  52       (let ((i 0))
  53         (map nil
  54              (lambda (str)
  55                (setf (mem-aref data-ptr :pointer i) (cffi:foreign-string-alloc str))
  56                (incf i))
  57              data))
  58       (gdk-pixmap-create-from-xpm-d drawable mask transparent-color data-ptr))))
  59
  60 (defcfun gdk-pixmap-colormap-create-from-xpm-d (g-object pixmap :already-referenced)
  61   (drawable (g-object drawable))
  62   (colormap (g-object colormap))
  63   (mask :pointer)
  64   (transparent-color (g-boxed-foreign color))
  65   (data (:pointer :pointer)))
  66
  67 (defun gdk-pixmap-colormap-create-from-xpm-d-1 (drawable colormap mask transparent-color data)
  68   (let ((n (length data)))
  69     (with-foreign-object (data-ptr :pointer n)
  70       (let ((i 0))
  71         (map nil
  72              (lambda (str)
  73                (setf (mem-aref data-ptr :pointer i) (cffi:foreign-string-alloc str))
  74                (incf i))
  75              data))
  76       (gdk-pixmap-colormap-create-from-xpm-d drawable colormap mask transparent-color data-ptr))))
  77
  78 (defun pixmap-create-from-xpm (drawable transparent-color &key (colormap nil colormap-p) (filename nil filename-p) (xpm-data nil xpm-p))
  79   (unless (or filename-p xpm-p)
  80     (error "FILENAME or XPM-DATA must be specified"))
  81   (when (and filename-p xpm-p)
  82     (error "FILENAME and XPM-DATA may not be specified at the same time"))
  83   (with-foreign-object (mask-ptr :pointer)
  84     (let ((pixmap (if filename-p
  85                       (if colormap-p
  86                           (gdk-pixmap-colormap-create-from-xpm drawable colormap mask-ptr transparent-color filename)
  87                           (gdk-pixmap-create-from-xpm drawable mask-ptr transparent-color filename))
  88                       (if colormap-p
  89                           (gdk-pixmap-colormap-create-from-xpm-d-1 drawable colormap mask-ptr transparent-color xpm-data)
  90                           (gdk-pixmap-create-from-xpm-d-1 drawable mask-ptr transparent-color xpm-data)))))
  91       (values pixmap (convert-from-foreign mask-ptr '(g-object pixmap :already-referenced))))))
  92
  93 (export 'pixmap-create-from-xpm)