3 (define-g-boxed-cstruct rectangle
"GdkRectangle"
4 (left :int
:initform
0)
6 (width :int
:initform
0)
7 (height :int
:initform
0))
9 (at-init () (eval (type-initializer-call "gdk_rectangle_get_type")))
11 (define-g-boxed-cstruct point nil
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
))))
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
))))
25 (defmethod boxed-free-fn ((type-info (eql (get 'point
'g-boxed-foreign-info
))) native
)
26 (foreign-free native
))
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
)))))
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
)))
41 (define-g-boxed-cstruct vector4 nil
42 (coords :double
:count
4 :initform
(vector 0d0
0d0
0d0
0d0
)))
44 (define-g-boxed-cstruct segment nil
45 (a point
:inline t
:initform
(make-point))
46 (b point
:inline t
:initform
(make-point)))
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))
54 (depth point
:inline t
:initform
(make-point)))))
56 (define-g-boxed-variant-cstruct event nil
57 (type :int
:initform
0)
58 (time :int
:initform
0)
63 (x :double
:initform
0.0d0
))
65 (three-type :int
:initform
0)
68 (y :uchar
:initform
0))
70 (z :double
:initform
0.0d0
))
72 (segment segment
:inline t
:initform
(make-segment)))))))
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))
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
)))