gacela_physics.lisp

   1 ;;;
   2 ;;; Chipmunk Physics Engine
   3 ;;;
   4
   5 (clines "#include \"gacela_chipmunk.c\"")
   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 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"))
  20
  21 ;;; C-Gacela functions
  22 (defentry set-cp-space-gravity (int float float) (void "set_cp_space_gravity"))
  23
  24 ;;; Physics Subsystem
  25 (defstruct cp-space address gravity)
  26 (defstruct cp-body address position)
  27 (defstruct cp-shape address)
  28
  29 (let ((initialized nil)
  30       (mobs-cp-space nil))
  31
  32   (defun init-chipmunk ()
  33     (cond ((null initialized) (cpInitChipmunk) (setq initialized t))
  34           (t initialized)))
  35
  36   (defun init-cp-space (&key (gravity nil))
  37     (cond ((null mobs-cp-space) (init-chipmunk) (setq mobs-cp-space (create-cp-space)))
  38           (t mobs-cp-space)))
  39
  40   (defun add-cp-body (body)
  41     (cpSpaceAddBody (cp-space-address mobs-cp-space) (cp-body-address body)))
  42
  43   (defun add-cp-shape (shape)
  44     (cpSpaceAddShape (cp-space-address mobs-cp-space) (cp-shape-address shape))))
  45
  46 (defun create-cp-space (&key (gravity nil))
  47   (init-chipmunk)
  48   (let ((new-cp-space (make-cp-space :address (cpSpaceNew) :gravity gravity))
  49         (properties nil))
  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))))
  53     new-cp-space))
  54
  55 (defun create-cp-body (&key (mass INFINITY) (inertia INFINITY) (x 0) (y 0))
  56   (init-chipmunk)
  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))
  59     new-cp-body))
  60
  61 (defun create-circle-cp-shape (cp-body shape)
  62   (init-chipmunk)
  63   (destructure ((shape ((x y) r)))
  64                (make-cp-shape :address (cpCircleShapeNew cp-body r x y))))
  65
  66 (defun create-cp-shape (cp-body shape)
  67   (init-chipmunk)
  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))
  70     new-cp-shape))
  71
  72 (defun cp-moment (mass shape)
  73   (cond ((circle-p shape) (destructure ((shape ((x y) r))) (cpMomentForCircle mass 0.0 r x y)))
  74         t INFINITY))
  75
  76 ;(defun use-chipmunk ()
  77 ;  (defun physics-add-mob (mass shape x y)
  78 ;    (init-cp-space)
  79 ;    (let ((new-cp-body (create-cp-body mass (cp-moment mass shape))))
  80 ;      (add-cp-body new-cp-body)
  81