Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 73 lines (58 sloc) 2.693 kb
d02c21d @Ramarren Generalize callbacks to resources, add LispClutterActor holding a res…
authored
1 (in-package :cffi-clutter)
2
3 ;;; create system for mapping lisp objects to-from integers, so that references to them can be
4 ;;; easily stored C-side
5
6 ;;; resources held in lists (?) (resource number pointer-to-foreign-number)
7 (defvar *resources* (make-array 32 :initial-element nil))
8 (defvar *resource-counter* 0)
9
10 (declaim (inline get-resource-meta-by-number get-resource-meta
11 resource resource-by-number (setf resource) (setf resource-by-number)))
12
13 (defun get-resource-meta-by-number (n)
14 (svref *resources* n))
15
16 (defun resource-by-number (n)
17 (car (get-resource-meta-by-number n)))
18
19 (defun get-resource-meta (foreign-pointer)
20 (get-resource-meta-by-number (mem-ref foreign-pointer :uint64)))
21
22 (defun resource (foreign-pointer)
23 (resource-by-number (mem-ref foreign-pointer :uint64)))
24
25 (defun (setf resource) (new-value foreign-pointer)
26 (setf (car (get-resource-meta foreign-pointer)) new-value))
27
28 (defun (setf resource-by-number) (new-value n)
29 (setf (car (get-resource-meta-by-number n)) new-value))
30
31 (defun grow-resource-array ()
32 (let ((new-array (make-array (* 2 (length *resources*)) :initial-element nil))
33 (old-array *resources*))
34 (loop for i from 0 below *resource-counter*
35 do (setf (svref new-array i)
36 (svref old-array i)))))
37
38 (defun shrink-resource-array ()
39 (let ((old-array *resources*))
40 (assert (> (/ (length old-array) 2) *resource-counter*))
41 (let ((new-array (make-array (/ (length old-array) 2))))
42 (loop for i from 0 below *resource-counter*
43 do (setf (svref new-array i)
44 (svref old-array i))))))
45
46 (defun register-resource (resource foreign-pointer)
47 (let ((n *resource-counter*))
48 (when (= (length *resources*) n)
49 (grow-resource-array))
50 (setf (svref *resources* n) (list resource n foreign-pointer)
51 (mem-ref foreign-pointer :uint64) n)
52 (incf *resource-counter*)
53 (values n)))
54
55 (defun move-resource (from to)
56 (assert (null (svref *resources* to)))
57 (destructuring-bind (resource n foreign-pointer) (svref *resources* from)
58 (assert (= n from))
59 (setf (svref *resources* to) (list resource to foreign-pointer)
60 (mem-ref foreign-pointer :uint64) to
61 (svref *resources* from) nil)))
62
63 (defun unregister-resource (foreign-pointer)
64 (destructuring-bind (resource i f-pointer) (get-resource-meta foreign-pointer)
6bcf122 @Ramarren Merge ignore declarations.
authored
65 (declare (ignore resource f-pointer))
d02c21d @Ramarren Generalize callbacks to resources, add LispClutterActor holding a res…
authored
66 (setf (svref *resources* i) nil)
67 (decf *resource-counter*)
68 (unless (eql i *resource-counter*)
69 (move-resource *resource-counter* i))
70 (when (< (* 4 *resource-counter*)
71 (length *resources*))
72 (shrink-resource-array))))
Something went wrong with that request. Please try again.