diff options
Diffstat (limited to 'demo/shmup.scm')
| -rw-r--r-- | demo/shmup.scm | 186 |
1 files changed, 104 insertions, 82 deletions
diff --git a/demo/shmup.scm b/demo/shmup.scm index 8610d4d..e9fec5e 100644 --- a/demo/shmup.scm +++ b/demo/shmup.scm @@ -1,7 +1,8 @@ (import scheme (chicken base) (chicken random) - (only srfi-1 filter) + (only srfi-1 filter any) + (only srfi-197 chain) (prefix sdl2 "sdl2:") (prefix sdl2-ttf "ttf:") (prefix sdl2-image "img:") @@ -13,16 +14,31 @@ downstroke-assets downstroke-sound) -(define *frame-count* 0) +;; ── Constants ──────────────────────────────────────────────────────────────── + +(define +screen-width+ 600) +(define +screen-height+ 400) +(define +spawn-interval+ 60) -(define (make-bullet px py) - (list #:type 'bullet #:x px #:y py #:width 4 #:height 8 #:vx 0 #:vy -6)) +;; ── State ──────────────────────────────────────────────────────────────────── -(define (make-enemy rx) - (list #:type 'enemy #:x rx #:y 0 #:width 16 #:height 16 #:vx 0 #:vy 2)) +(define *frame-count* 0) + +;; ── Entity factories ───────────────────────────────────────────────────────── (define (make-player) - (list #:type 'player #:x 280 #:y 360 #:width 16 #:height 16 #:vx 0 #:vy 0)) + (list #:type 'player #:x 280 #:y 360 + #:width 16 #:height 16 #:vx 0 #:vy 0)) + +(define (make-bullet x y) + (list #:type 'bullet #:x x #:y y + #:width 4 #:height 8 #:vx 0 #:vy -6)) + +(define (make-enemy x) + (list #:type 'enemy #:x x #:y 0 + #:width 16 #:height 16 #:vx 0 #:vy 2)) + +;; ── Collision ──────────────────────────────────────────────────────────────── (define (entities-overlap? a b) (aabb-overlap? @@ -32,22 +48,74 @@ (entity-ref b #:width 0) (entity-ref b #:height 0))) (define (find-dead entities) - (let ((bullets (filter (lambda (e) (eq? (entity-ref e #:type) 'bullet)) entities)) - (enemies (filter (lambda (e) (eq? (entity-ref e #:type) 'enemy)) entities)) - (dead '())) - (for-each - (lambda (b) - (for-each - (lambda (en) - (when (entities-overlap? b en) - (set! dead (cons b (cons en dead))))) - enemies)) - bullets) - dead)) + (let ((bullets (filter (lambda (e) (eq? (entity-type e) 'bullet)) entities)) + (enemies (filter (lambda (e) (eq? (entity-type e) 'enemy)) entities))) + (filter (lambda (e) + (case (entity-type e) + ((bullet) (any (lambda (en) (entities-overlap? e en)) enemies)) + ((enemy) (any (lambda (b) (entities-overlap? e b)) bullets)) + (else #f))) + entities))) + +(define (in-bounds? e) + (let ((y (entity-ref e #:y 0))) + (and (> y -20) (< y (+ +screen-height+ 20))))) + +;; ── Update helpers ─────────────────────────────────────────────────────────── + +(define (player-vx input) + (cond ((input-held? input 'left) -4) + ((input-held? input 'right) 4) + (else 0))) + +(define (clamp-player-x player) + (entity-set player #:x + (max 0 (min (- +screen-width+ 16) (entity-ref player #:x 0))))) + +(define (update-player player input scene) + (let ((updated (chain player + (entity-set _ #:vx (player-vx input)) + (apply-velocity-x _) + (clamp-player-x _)))) + (when (input-pressed? input 'a) + (play-sound 'shoot) + (scene-add-entity scene + (make-bullet (+ (entity-ref updated #:x 0) 6) 340))) + updated)) + +(define (move-projectile e) + (chain e + (entity-set _ #:x (+ (entity-ref e #:x 0) (entity-ref e #:vx 0))) + (entity-set _ #:y (+ (entity-ref e #:y 0) (entity-ref e #:vy 0))))) + +(define (maybe-spawn-enemy! scene) + (when (zero? (modulo *frame-count* +spawn-interval+)) + (scene-add-entity scene + (make-enemy (+ 20 (* (pseudo-random-integer 28) 20)))))) + +;; ── Render ─────────────────────────────────────────────────────────────────── + +(define (entity-color type) + (case type + ((player) (sdl2:make-color 255 255 255 255)) + ((bullet) (sdl2:make-color 255 255 0 255)) + ((enemy) (sdl2:make-color 255 50 50 255)) + (else (sdl2:make-color 100 100 100 255)))) + +(define (draw-shmup-entity renderer e) + (let ((x (inexact->exact (floor (entity-ref e #:x 0)))) + (y (inexact->exact (floor (entity-ref e #:y 0)))) + (w (entity-ref e #:width 16)) + (h (entity-ref e #:height 16))) + (set! (sdl2:render-draw-color renderer) (entity-color (entity-type e))) + (sdl2:render-fill-rect! renderer (sdl2:make-rect x y w h)))) + +;; ── Game ───────────────────────────────────────────────────────────────────── (define *game* (make-game - title: "Demo: Shoot-em-up" width: 600 height: 400 + title: "Demo: Shoot-em-up" + width: +screen-width+ height: +screen-height+ preload: (lambda (game) (init-audio!) @@ -63,72 +131,26 @@ camera-target: #f))) update: (lambda (game dt) - (let* ((input (game-input game)) - (scene (game-scene game)) - (entities (scene-entities scene)) - (player (car (filter (lambda (e) (eq? (entity-ref e #:type) 'player)) - entities)))) - (set! *frame-count* (+ *frame-count* 1)) - ;; Move player - (let* ((player (entity-set player #:vx - (cond ((input-held? input 'left) -4) - ((input-held? input 'right) 4) - (else 0)))) - (player (apply-velocity-x player)) - (player (entity-set player #:x - (max 0 (min 584 (entity-ref player #:x 0)))))) - ;; Fire bullet - (when (input-pressed? input 'a) - (play-sound 'shoot) - (scene-add-entity scene - (make-bullet (+ (entity-ref player #:x 0) 6) 340))) - ;; Spawn enemy every 60 frames - (when (zero? (modulo *frame-count* 60)) - (scene-add-entity scene - (make-enemy (+ 20 (* (pseudo-random-integer 28) 20))))) - ;; Update player in scene - (scene-entities-set! scene - (cons player - (filter (lambda (e) (not (eq? (entity-ref e #:type) 'player))) - (scene-entities scene))))) - ;; Move non-player entities + (set! *frame-count* (+ *frame-count* 1)) + (let* ((input (game-input game)) + (scene (game-scene game)) + (player (car (scene-entities scene))) + (player (update-player player input scene))) + (maybe-spawn-enemy! scene) + ;; Replace player, then move all projectiles + (scene-entities-set! scene + (cons player (filter (lambda (e) (not (eq? (entity-type e) 'player))) + (scene-entities scene)))) (scene-update-entities scene - (lambda (e) - (if (eq? (entity-ref e #:type) 'player) - e - (entity-set - (entity-set e #:x (+ (entity-ref e #:x 0) (entity-ref e #:vx 0))) - #:y (+ (entity-ref e #:y 0) (entity-ref e #:vy 0)))))) - ;; Remove collisions + (lambda (e) (if (eq? (entity-type e) 'player) e (move-projectile e)))) + ;; Remove bullet/enemy collisions, then out-of-bounds (let ((dead (find-dead (scene-entities scene)))) - (scene-filter-entities scene - (lambda (e) (not (memq e dead))))) - ;; Remove out-of-bounds + (scene-filter-entities scene (lambda (e) (not (memq e dead))))) (scene-filter-entities scene - (lambda (e) - (let ((y (entity-ref e #:y 0))) - (or (eq? (entity-ref e #:type) 'player) - (and (> y -20) (< y 420)))))))) + (lambda (e) (or (eq? (entity-type e) 'player) (in-bounds? e)))))) render: (lambda (game) - (let* ((renderer (game-renderer game)) - (scene (game-scene game)) - (entities (scene-entities scene))) - (for-each - (lambda (e) - (let ((type (entity-ref e #:type 'unknown)) - (x (inexact->exact (floor (entity-ref e #:x 0)))) - (y (inexact->exact (floor (entity-ref e #:y 0)))) - (w (entity-ref e #:width 16)) - (h (entity-ref e #:height 16))) - (set! (sdl2:render-draw-color renderer) - (case type - ((player) (sdl2:make-color 255 255 255 255)) - ((bullet) (sdl2:make-color 255 255 0 255)) - ((enemy) (sdl2:make-color 255 50 50 255)) - (else (sdl2:make-color 100 100 100 255)))) - (sdl2:render-fill-rect! renderer - (sdl2:make-rect x y w h)))) - entities))))) + (for-each (lambda (e) (draw-shmup-entity (game-renderer game) e)) + (scene-entities (game-scene game)))))) (game-run! *game*) |