test.boxed-ng.lisp

   1 (in-package :gobject)
   2
   3 (define-g-boxed-cstruct rectangle "GdkRectangle"
   4   (left :int :initform 0)
   5   (top :int :initform 0)
   6   (width :int :initform 0)
   7   (height :int :initform 0))
   8
   9 (at-init () (eval (type-initializer-call "gdk_rectangle_get_type")))
  10
  11 (define-g-boxed-cstruct point nil
  12   (x :int :initform 0)
  13   (y :int :initform 0))
  14
  15 (defun mem-copy (source destination count)
  16   (iter (for i from 0 below count)
  17         (setf (mem-aref destination :uchar i)
  18               (mem-aref source :uchar i))))
  19
  20 (defmethod boxed-copy-fn ((type-info (eql (get 'point 'g-boxed-foreign-info))) native)
  21   (let ((native-copy (foreign-alloc (generated-cstruct-name (g-boxed-info-name type-info)))))
  22     (mem-copy native native-copy (foreign-type-size (generated-cstruct-name (g-boxed-info-name type-info))))
  23     native-copy))
  24
  25 (defmethod boxed-free-fn ((type-info (eql (get 'point 'g-boxed-foreign-info))) native)
  26   (foreign-free native))
  27
  28 (defcallback make-rect-cb (g-boxed-foreign rectangle :return)
  29     ((a (g-boxed-foreign point)) (b (g-boxed-foreign point)))
  30   (make-rectangle :left (min (point-x a) (point-x b))
  31                   :top (min (point-y a) (point-y b))
  32                   :width (abs (- (point-x a) (point-x b)))
  33                   :height (abs (- (point-y a) (point-y b)))))
  34
  35 (defun call-make-rect-cb (a b)
  36   (foreign-funcall-pointer (callback make-rect-cb) ()
  37                            (g-boxed-foreign point) a
  38                            (g-boxed-foreign point) b
  39                            (g-boxed-foreign rectangle :return)))
  40
  41 (define-g-boxed-cstruct vector4 nil
  42   (coords :double :count 4 :initform (vector 0d0 0d0 0d0 0d0)))
  43
  44 (define-g-boxed-cstruct segment nil
  45   (a point :inline t :initform (make-point))
  46   (b point :inline t :initform (make-point)))
  47
  48 (define-g-boxed-variant-cstruct var-segment nil
  49   (deep :boolean :initform t)
  50   (a point :inline t :initform (make-point))
  51   (b point :inline t :initform (make-point))
  52   (:variant deep
  53             (t deep-segment
  54                (depth point :inline t :initform (make-point)))))
  55
  56 (define-g-boxed-variant-cstruct event nil
  57   (type :int :initform 0)
  58   (time :int :initform 0)
  59   (:variant type
  60             (0 zero-event
  61                (x :int :initform 0))
  62             (1 one-event
  63                (x :double :initform 0.0d0))
  64             (2 three-event
  65                (three-type :int :initform 0)
  66                (:variant three-type
  67                          (1 three-one-event
  68                             (y :uchar :initform 0))
  69                          (2 three-two-event
  70                             (z :double :initform 0.0d0))
  71                          (3 segment-event
  72                             (segment segment :inline t :initform (make-segment)))))))
  73
  74 (defcallback copy-event-cb (g-boxed-foreign event :return)
  75     ((event (g-boxed-foreign event)))
  76   (let ((new-event (copy-event event)))
  77     (incf (event-time new-event) (random 100))
  78     new-event))
  79
  80 (defun call-copy-event (e)
  81   (foreign-funcall-pointer (callback copy-event-cb) ()
  82                            (g-boxed-foreign event) e
  83                            (g-boxed-foreign event :return)))
  84