gacela_chip.lisp

   1 (in-package 'chipmunk)
   2
   3 (clines "#include \"gacela_chipmunk.c\"")
   4
   5 (defconstant INFINITY MOST-POSITIVE-LONG-FLOAT)
   6
   7 ;;; Chipmunk functions
   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 cpBodyFree (int) (void "gacela_cpBodyFree"))
  16 (defentry cpCircleShapeNew (int float float float) (int "gacela_cpCircleShapeNew"))
  17 (defentry cpPolyShapeNew (int int int float float) (int "gacela_cpPolyShapeNew"))
  18 (defentry cpShapeFree (int) (void "gacela_cpShapeFree"))
  19
  20 ;;; C-Gacela functions
  21 (defentry set-space-properties (int float float) (void "set_space_properties"))
  22
  23 ;;; Physics Subsystem
  24 (defstruct space address)
  25 (defstruct body address)
  26 (defstruct shape address)
  27
  28 (let ((initialized nil)
  29       (mobs-space nil))
  30
  31   (defun init-chipmunk ()
  32     (cond ((null initialized) (cpInitChipmunk) (setq initialized t))
  33           (t initialized)))
  34
  35   (defun init-mobs-physics (&key (gravity nil))
  36     (cond ((null mobs-space) (init-chipmunk) (setq mobs-space (create-space)))
  37           (t mobs-space))))
  38
  39 (defun create-space (&key (gravity nil))
  40   (init-chipmunk)
  41   (let ((new-space (make-space :address (cpSpaceNew)))
  42         (properties nil))
  43     (set-resource 'space new-space (gentemp))
  44     (cond (gravity (setq properties (union gravity properties))))
  45     (cond (properties (apply #'set-space-properties (cons (space-address new-space) properties))))
  46     new-space))
  47
  48 (defun create-body (&key (mass INFINITY) (inertia INFINITY))
  49   (init-chipmunk)
  50   (let ((new-body (make-body :address (cpNewBody mass inertia INFINITY))))
  51     (set-resource 'body new-body (gentemp))
  52     new-body))