Progress

1 files changed, 133 insertions, 0 deletions

diff --git a/demo/shmup.scm b/demo/shmup.scm
new file mode 100644
index 0000000..ae7748d
--- /dev/null
+++ b/demo/shmup.scm
@@ -0,0 +1,133 @@
+(import scheme
+        (chicken base)
+        (chicken random)
+        (only srfi-1 filter)
+        (prefix sdl2 "sdl2:")
+        (prefix sdl2-ttf "ttf:")
+        (prefix sdl2-image "img:")
+        downstroke/engine
+        downstroke/world
+        downstroke/physics
+        downstroke/input
+        downstroke/entity
+        downstroke/assets
+        downstroke/sound)
+
+(define *frame-count* 0)
+
+(define (make-bullet px py)
+  (list #:type 'bullet #:x px #:y py #:width 4 #:height 8 #:vx 0 #:vy -6))
+
+(define (make-enemy rx)
+  (list #:type 'enemy #:x rx #:y 0 #:width 16 #:height 16 #:vx 0 #:vy 2))
+
+(define (make-player)
+  (list #:type 'player #:x 280 #:y 360 #:width 16 #:height 16 #:vx 0 #:vy 0))
+
+(define (entities-overlap? a b)
+  (aabb-overlap?
+    (entity-ref a #:x 0) (entity-ref a #:y 0)
+    (entity-ref a #:width 0) (entity-ref a #:height 0)
+    (entity-ref b #:x 0) (entity-ref b #:y 0)
+    (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))
+
+(define *game*
+  (make-game
+    title: "Demo: Shoot-em-up" width: 600 height: 400
+
+    preload: (lambda (game)
+      (init-audio!)
+      (load-sounds! '((shoot . "demo/assets/jump.wav"))))
+
+    create: (lambda (game)
+      (game-scene-set! game
+        (make-scene
+          entities:        (list (make-player))
+          tilemap:         #f
+          camera:          (make-camera x: 0 y: 0)
+          tileset-texture: #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
+        (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
+        (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)
+            (let ((y (entity-ref e #:y 0)))
+              (or (eq? (entity-ref e #:type) 'player)
+                  (and (> y -20) (< y 420))))))))
+
+    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)))))
+
+(game-run! *game*)