Commit 8a164881 by John Croisant

### shmup: Entity bbox defines its position.

```Instead of having a "pos" slot, an entity's bbox is now the
canonical definition of the entity's position. This simplifies
a lot of code.```
parent d6a904f0
 ... ... @@ -79,13 +79,13 @@ (: rect-centerx ((struct sdl2:rect) -> number)) (: rect-centerx-fx ((struct sdl2:rect) -> fixnum)) (define (rect-centerx r) (+ (sdl2:rect-x r) (sdl2:rect-w/2 r))) (define (rect-centerx-fx r) (fx+ (sdl2:rect-x r) (sdl2:rect-w/2-fx r))) (define (rect-centerx r) (+ (sdl2:rect-x r) (rect-w/2 r))) (define (rect-centerx-fx r) (fx+ (sdl2:rect-x r) (rect-w/2-fx r))) (: rect-centery ((struct sdl2:rect) -> number)) (: rect-centery-fx ((struct sdl2:rect) -> fixnum)) (define (rect-centery r) (+ (sdl2:rect-y r) (sdl2:rect-h/2 r))) (define (rect-centery-fx r) (fx+ (sdl2:rect-y r) (sdl2:rect-h/2-fx r))) (define (rect-centery r) (+ (sdl2:rect-y r) (rect-h/2 r))) (define (rect-centery-fx r) (fx+ (sdl2:rect-y r) (rect-h/2-fx r))) (: rect-center ((struct sdl2:rect) -> (struct sdl2:point))) (define (rect-center r) ... ... @@ -133,3 +133,25 @@ (fx- cx (fx/ w 2)) (fx- cy (fx/ h 2)) w h))) ;;; Returns the x and y amounts that r1 would need to move in order to ;;; be inside r2. Returns 0 0 if r1 is already inside r2. (define (need-clamp-rect r1 r2) ;; pos is either x or y. dim is either w or h. (define (change-needed pos1 dim1 pos2 dim2) ;; If r1 left/top is outside of r2... (if (< pos1 pos2) ;; Then move so left/top edges are equal. (- pos2 pos1) ;; Otherwise, if r1 right/bottom is outside of r2... (if (> (+ pos1 dim1) (+ pos2 dim2)) ;; Then move so right/bottom edges are equal. (- (+ pos2 dim2) (+ pos1 dim1)) ;; Otherwise, no change is needed. 0))) (receive (x1 y1 w1 h1) (sdl2:rect->values r1) (receive (x2 y2 w2 h2) (sdl2:rect->values r2) (values (change-needed x1 w1 x2 w2) (change-needed y1 h1 y2 h2)))))
 ... ... @@ -10,7 +10,7 @@ ;;; or powerup item. (define-record-type entity (%make-entity id type texture pos vel scale bbox updater props) (%make-entity id type texture bbox vel scale updater props) entity? ;; symbol for finding entity, or #f if not needed (id entity-id (setter entity-id)) ... ... @@ -18,14 +18,12 @@ (type entity-type (setter entity-type)) ;; sdl2:texture of entity's appearance (texture entity-texture (setter entity-texture)) ;; sdl2:point defining entity's position (center) (pos entity-pos (setter entity-pos)) ;; sdl2:rect defining the entity's bounding box (bbox entity-bbox (setter entity-bbox)) ;; sdl2:point defining entity's velocity (vel entity-vel (setter entity-vel)) ;; real number defining entity's size multiplier (scale entity-scale (setter entity-scale)) ;; sdl2:rect defining the entity's bounding box (bbox entity-bbox (setter entity-bbox)) ;; procedure called each game tick (updater entity-updater (setter entity-updater)) ;; alist of extra properties for gameplay logic ... ... @@ -34,6 +32,10 @@ (define-type entity (struct entity)) (define (entity-pos entity) (rect-center (entity-bbox entity))) (define (make-entity #!key id type texture (pos (sdl2:make-point)) ... ... @@ -42,10 +44,12 @@ (updater entity-basic-updater) (props '())) (assert (sdl2:texture? texture)) (let ((bbox (R 0 0 (* scale (s->w (sdl2:texture-w texture))) (* scale (s->w (sdl2:texture-h texture)))))) (%make-entity id type texture pos vel scale bbox updater props))) (let ((bbox (centered-rect (sdl2:point-x pos) (sdl2:point-y pos) (* scale (s->w (sdl2:texture-w texture))) (* scale (s->w (sdl2:texture-h texture)))))) (%make-entity id type texture bbox vel scale updater props))) (compose-accessors entity-pos-x (sdl2:point-x entity-pos)) ... ... @@ -56,10 +60,9 @@ (define-record-printer (entity e out) (fprintf out "#" "#" (entity-id e) (entity-pos-x e) (entity-pos-y e))) (sdl2:rect->list (entity-bbox e)))) (define (destroy-entity! entity) ... ... @@ -103,16 +106,9 @@ ;;; Update entity's position based on its current velocity. (define (update-entity-pos! entity dt) (sdl2:point-add! (entity-pos entity) (sdl2:point-scale (entity-vel entity) dt)) (update-entity-bbox! entity)) (define (update-entity-bbox! entity) (recenter-rect! (entity-bbox entity) (entity-pos-x entity) (entity-pos-y entity))) (sdl2:rect-add-point! (entity-bbox entity) (sdl2:point-scale (entity-vel entity) dt))) ;;; Returns #t if any of entity's bbox is touching scene's bounds. ... ... @@ -122,20 +118,18 @@ (scene-bounds scene))) ;;; Move the entity so its bbox is completely inside rect. (define (entity-clamp-to-rect! entity rect) (receive (dx dy) (need-clamp-rect (entity-bbox entity) rect) (sdl2:rect-move! (entity-bbox entity) dx dy))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; DRAW ENTITY (define (draw-entity! entity ren #!optional (off-x 0) (off-y 0)) (let ((texture (entity-texture entity)) (scale (entity-scale entity))) (let ((w (round (* scale (sdl2:texture-w texture)))) (h (round (* scale (sdl2:texture-h texture))))) (sdl2:render-copy! ren texture #f (R (round (+ off-x (- (/ w 2)) (w->s (entity-pos-x entity)))) (round (+ off-y (- (/ h 2)) (w->s (entity-pos-y entity)))) w h)) (when +draw-entity-bboxes+ (sdl2:render-draw-color-set! ren (C 0 255 0)) (sdl2:render-draw-rect! ren (w->s/r (entity-bbox entity))))))) (define (draw-entity! entity ren) (let ((bbox (w->s/r (entity-bbox entity)))) (sdl2:render-copy! ren (entity-texture entity) #f bbox) (when +draw-entity-bboxes+ (sdl2:render-draw-color-set! ren (C 0 255 0)) (sdl2:render-draw-rect! ren bbox))))
 ... ... @@ -27,7 +27,7 @@ (make-laser owner: owner color: (entity-prop owner 'color) pos: (sdl2:point-copy (entity-pos owner)) pos: (entity-pos owner) vel: (P 0 (- +player-laser-speed+))))) (scene-add-entity! scene laser) laser)) ... ...
 ... ... @@ -31,7 +31,7 @@ (when (player-shooting? player) (player-try-shoot! player)) (update-entity-pos! player dt) (player-clamp-to-rect! player (scene-bounds (*scene*)))) (entity-clamp-to-rect! player (scene-bounds (*scene*)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ... ... @@ -66,20 +66,6 @@ (player-update-vel! player)) ;;; Move the player so its bbox is completely inside rect. (define (player-clamp-to-rect! player rect) (let ((px (entity-pos-x player)) (py (entity-pos-y player)) (bbw/2 (/ (sdl2:rect-w (entity-bbox player)) 2)) (bbh/2 (/ (sdl2:rect-h (entity-bbox player)) 2))) (receive (rx ry rw rh) (sdl2:rect->values rect) (let ((new-px (clamp px (+ rx bbw/2) (- (+ rx rw) bbw/2))) (new-py (clamp py (+ ry bbh/2) (- (+ ry rh) bbh/2)))) (unless (and (= px new-px) (= py new-py)) (set! (entity-pos-x player) new-px) (set! (entity-pos-y player) new-py) (update-entity-bbox! player)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; SHOOTING ... ...
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!