Add physics engine
This commit is contained in:
parent
0306d65895
commit
d4c537e6ab
38
modules/ces/component/acceleration.scm
Normal file
38
modules/ces/component/acceleration.scm
Normal file
|
@ -0,0 +1,38 @@
|
|||
(define-module (ces component acceleration)
|
||||
#:pure
|
||||
#:use-module (scheme base)
|
||||
#:use-module (math vector)
|
||||
#:export (acceleration?
|
||||
acceleration-entity-id
|
||||
make-acceleration
|
||||
create-acceleration
|
||||
acceleration-x
|
||||
acceleration-y
|
||||
set-acceleration
|
||||
set-acceleration!))
|
||||
|
||||
(define-record-type <acceleration>
|
||||
(make-acceleration entity-id acc-vec)
|
||||
acceleration?
|
||||
(entity-id acceleration-entity-id)
|
||||
(acc-vec acceleration-vector))
|
||||
|
||||
(define (create-acceleration entity-id x y)
|
||||
(make-acceleration entity-id
|
||||
(vec2 x y)))
|
||||
|
||||
(define (acceleration-x acceleration)
|
||||
(vec2-x (acceleration-vector acceleration)))
|
||||
|
||||
(define (acceleration-y acceleration)
|
||||
(vec2-y (acceleration-vector acceleration)))
|
||||
|
||||
(define (set-acceleration acceleration x y)
|
||||
"Creates a copy of the acceleration component with the given x and y"
|
||||
(create-acceleration (acceleration-entity-id acceleration) x y))
|
||||
|
||||
(define (set-acceleration! acceleration x y)
|
||||
"Sets the coordinates of the given acceleration component"
|
||||
(begin
|
||||
(set-vec2-x! (acceleration-vector acceleration) x)
|
||||
(set-vec2-y! (acceleration-vector acceleration) y)))
|
|
@ -1,15 +0,0 @@
|
|||
(define-module (ces component level)
|
||||
#:pure
|
||||
#:use-module (scheme base)
|
||||
#:export (level?
|
||||
make-level
|
||||
level-entity-id
|
||||
level-rooms))
|
||||
|
||||
(define-record-type <level>
|
||||
(make-level entity-id rooms)
|
||||
level?
|
||||
(entity-id level-entity-id)
|
||||
(rooms level-rooms))
|
||||
|
||||
|
|
@ -1,9 +0,0 @@
|
|||
(define-module (ces component player)
|
||||
#:pure
|
||||
#:use-module (scheme base))
|
||||
|
||||
;; Player is a mostly empty component, used for tagging an entity for player systems
|
||||
(define-record-type <player>
|
||||
(make-player entity-id)
|
||||
player?
|
||||
(entity-id player-entity-id))
|
|
@ -4,6 +4,7 @@
|
|||
#:use-module (math vector)
|
||||
#:export (position?
|
||||
position-entity-id
|
||||
make-position
|
||||
create-position
|
||||
position-x
|
||||
position-y
|
||||
|
@ -11,14 +12,13 @@
|
|||
set-position!))
|
||||
|
||||
(define-record-type <position>
|
||||
(make-position type entity-id pos-vec)
|
||||
(make-position entity-id pos-vec)
|
||||
position?
|
||||
(type position-type)
|
||||
(entity-id position-entity-id)
|
||||
(pos-vec position-vector))
|
||||
|
||||
(define (create-position entity-id x y)
|
||||
(make-position 'position entity-id
|
||||
(make-position entity-id
|
||||
(vec2 x y)))
|
||||
|
||||
(define (position-x position)
|
||||
|
|
|
@ -1,15 +0,0 @@
|
|||
(define-module (ces component room)
|
||||
#:pure
|
||||
#:use-module (scheme base)
|
||||
#:export (room?
|
||||
make-room
|
||||
room-entity-id
|
||||
room-background
|
||||
room-game-objects))
|
||||
|
||||
(define-record-type <room>
|
||||
(make-room entity-id background game-objects)
|
||||
room?
|
||||
(room-id room-entity-id)
|
||||
(background room-background)
|
||||
(game-objects room-game-objects))
|
|
@ -4,11 +4,35 @@
|
|||
#:use-module (math vector)
|
||||
#:export (velocity?
|
||||
velocity-entity-id
|
||||
velocity-vector
|
||||
set-velocity-vector!))
|
||||
make-velocity
|
||||
create-velocity
|
||||
velocity-x
|
||||
velocity-y
|
||||
set-velocity
|
||||
set-velocity!))
|
||||
|
||||
(define-record-type <velocity>
|
||||
(make-velocity entity-id velocity-vec)
|
||||
(make-velocity entity-id vel-vec)
|
||||
velocity?
|
||||
(entity-id velocity-entity-id)
|
||||
(velocity-vec velocity-vector set-velocity-vector!))
|
||||
(vel-vec velocity-vector))
|
||||
|
||||
(define (create-velocity entity-id x y)
|
||||
(make-velocity entity-id
|
||||
(vec2 x y)))
|
||||
|
||||
(define (velocity-x velocity)
|
||||
(vec2-x (velocity-vector velocity)))
|
||||
|
||||
(define (velocity-y velocity)
|
||||
(vec2-y (velocity-vector velocity)))
|
||||
|
||||
(define (set-velocity velocity x y)
|
||||
"Creates a copy of the velocity component with the given x and y"
|
||||
(create-velocity (velocity-entity-id velocity) x y))
|
||||
|
||||
(define (set-velocity! velocity x y)
|
||||
"Sets the coordinates of the given velocity component"
|
||||
(begin
|
||||
(set-vec2-x! (velocity-vector velocity) x)
|
||||
(set-vec2-y! (velocity-vector velocity) y)))
|
||||
|
|
47
modules/ces/system/physics-engine.scm
Normal file
47
modules/ces/system/physics-engine.scm
Normal file
|
@ -0,0 +1,47 @@
|
|||
(define-module (ces system tilemap-renderer)
|
||||
#:pure
|
||||
#:use-module (scheme base)
|
||||
#:use-module (math vector)
|
||||
#:use-module (ces system)
|
||||
#:use-module (ces component)
|
||||
#:use-module (ces entity)
|
||||
#:export (create-physics-engine))
|
||||
|
||||
;(define desired-components '('imass 'position 'velocity 'acceleration))
|
||||
(define desired-components '('position 'velocity 'acceleration))
|
||||
|
||||
(define (wants-entity? entity)
|
||||
(and (game-entity? entity)
|
||||
(apply has-components? desired-components)))
|
||||
|
||||
(define (update-physics-entity entity dt)
|
||||
;; do math
|
||||
(let ((imass (get-component entity 'imass))
|
||||
(id (game-entity-id entity)))
|
||||
(if (positive? imass)
|
||||
(let* (
|
||||
(friction 0.75)
|
||||
;(imass (get-component entity 'imass))
|
||||
(imass 1.0)
|
||||
(pos (get-component entity 'position))
|
||||
(vel (get-component entity 'velocity))
|
||||
(acc (get-component entity 'acceleration))
|
||||
(p (position-vector pos))
|
||||
(v (velocity-vector vel))
|
||||
(a (velocity-vector acc))
|
||||
(p* (vec2-add! p (vec2-mul-scalar! v dt)))
|
||||
(v* (vec2-mul-scalar! (vec2-add! v (vec2-mul-scalar! a dt)) (* friction dt)))
|
||||
)
|
||||
;; update component(s)
|
||||
(let* ((updated-entity (set-component entity 'position (make-position id p*)))
|
||||
(updated-entity (set-component entity 'velocity (make-velocity id v*)))))
|
||||
;; reset entity
|
||||
(reset-entity! (get-entity-manager) updated-entity)
|
||||
)
|
||||
|
||||
)))
|
||||
|
||||
(define (create-physics-engine)
|
||||
(create-system wants-entity?
|
||||
(lambda (entity dt)
|
||||
(update-physics-entity entity dt))))
|
|
@ -36,7 +36,6 @@
|
|||
(y (+ y-offset (* (modulo index tl-height) ts-tile-height))))
|
||||
(renderer img x y tile-width tile-height))) data))) tm-layers))))
|
||||
|
||||
|
||||
(define (create-tilemap-renderer renderer)
|
||||
(create-system wants-entity?
|
||||
(lambda (entity dt)
|
||||
|
|
Loading…
Reference in a new issue