2 ;;; Chipmunk Physics Engine
5 (clines "#include \"gacela_chipmunk.c\"")
8 (defentry cpInitChipmunk () (void "gacela_cpInitChipmunk"))
9 (defentry cpResetShapeIdCounter () (void "gacela_cpResetShapeIdCounter"))
10 (defentry cpSpaceNew () (int "gacela_cpSpaceNew"))
11 (defentry cpSpaceAddBody (int int) (void "gacela_cpSpaceAddBody"))
12 (defentry cpSpaceAddShape (int int) (void "gacela_cpSpaceAddShape"))
13 (defentry cpSpaceFree (int) (void "gacela_cpSpaceFree"))
14 (defentry cpBodyNew (float float float) (int "gacela_cpBodyNew"))
15 (defentry cpMomentForCircle (float float float float float) (float "gacela_cpMomentForCircle"))
16 (defentry cpBodyFree (int) (void "gacela_cpBodyFree"))
17 (defentry cpCircleShapeNew (int float float float) (int "gacela_cpCircleShapeNew"))
18 (defentry cpPolyShapeNew (int int int float float) (int "gacela_cpPolyShapeNew"))
19 (defentry cpShapeFree (int) (void "gacela_cpShapeFree"))
21 ;;; C-Gacela functions
22 (defentry set-cp-space-gravity (int float float) (void "set_cp_space_gravity"))
25 (defstruct cp-space address gravity)
26 (defstruct cp-body address position)
27 (defstruct cp-shape address)
29 (let ((initialized nil)
32 (defun init-chipmunk ()
33 (cond ((null initialized) (cpInitChipmunk) (setq initialized t))
36 (defun init-cp-space (&key (gravity nil))
37 (cond ((null mobs-cp-space) (init-chipmunk) (setq mobs-cp-space (create-cp-space)))
40 (defun add-cp-body (body)
41 (cpSpaceAddBody (cp-space-address mobs-cp-space) (cp-body-address body)))
43 (defun add-cp-shape (shape)
44 (cpSpaceAddShape (cp-space-address mobs-cp-space) (cp-shape-address shape))))
46 (defun create-cp-space (&key (gravity nil))
48 (let ((new-cp-space (make-cp-space :address (cpSpaceNew) :gravity gravity))
50 (set-resource 'cp-space new-cp-space (gentemp))
51 (cond (gravity (setq properties (union gravity properties))))
52 (cond (properties (apply #'set-cp-space-properties (cons (cp-space-address new-cp-space) properties))))
55 (defun create-cp-body (&key (mass INFINITY) (inertia INFINITY) (x 0) (y 0))
57 (let ((new-cp-body (make-cp-body :address (cpNewBody mass inertia INFINITY) :position `(,x ,y))))
58 (set-resource 'cp-body new-cp-body (gentemp))
61 (defun create-circle-cp-shape (cp-body shape)
63 (destructure ((shape ((x y) r)))
64 (make-cp-shape :address (cpCircleShapeNew cp-body r x y))))
66 (defun create-cp-shape (cp-body shape)
68 (let ((new-cp-shape (cond ((circle-p shape) (create-circle-cp-shape cp-body shape)))))
69 (set-resource 'cp-shape new-cp-shape (gentemp))
72 (defun cp-moment (mass shape)
73 (cond ((circle-p shape) (destructure ((shape ((x y) r))) (cpMomentForCircle mass 0.0 r x y)))
76 ;(defun use-chipmunk ()
77 ; (defun physics-add-mob (mass shape x y)
79 ; (let ((new-cp-body (create-cp-body mass (cp-moment mass shape))))
80 ; (add-cp-body new-cp-body)