aboutsummaryrefslogtreecommitdiff
path: root/demo/platformer.scm
diff options
context:
space:
mode:
Diffstat (limited to 'demo/platformer.scm')
-rw-r--r--demo/platformer.scm62
1 files changed, 33 insertions, 29 deletions
diff --git a/demo/platformer.scm b/demo/platformer.scm
index 7d289f6..ff5caf7 100644
--- a/demo/platformer.scm
+++ b/demo/platformer.scm
@@ -1,6 +1,7 @@
(import scheme
(chicken base)
(chicken process-context)
+ (only srfi-197 chain)
(prefix sdl2 "sdl2:")
(prefix sdl2-ttf "ttf:")
(prefix sdl2-image "img:")
@@ -15,51 +16,54 @@
downstroke-sound
downstroke-scene-loader)
-(define +debug?+ (member "--debug" (command-line-arguments)))
+(define +debug?+ (and (member "--debug" (command-line-arguments)) #t))
+
+(define (make-player)
+ (list #:type 'player
+ #:x 100 #:y 50
+ #:width 16 #:height 16
+ #:vx 0 #:vy 0
+ #:gravity? #t #:on-ground? #f
+ #:tile-id 1 #:tags '(player)))
+
+(define (player-vx input)
+ (cond ((input-held? input 'left) -3)
+ ((input-held? input 'right) 3)
+ (else 0)))
+
+(define (update-player player input tm)
+ (let ((jump? (input-pressed? input 'a)))
+ (when (and jump? (entity-ref player #:on-ground? #f))
+ (play-sound 'jump))
+ (chain (entity-set player #:vx (player-vx input))
+ (apply-jump _ jump?)
+ (apply-acceleration _)
+ (apply-gravity _)
+ (apply-velocity-x _)
+ (resolve-tile-collisions-x _ tm)
+ (apply-velocity-y _)
+ (resolve-tile-collisions-y _ tm)
+ (detect-on-solid _ tm))))
(define *game*
(make-game
title: "Demo: Platformer" width: 600 height: 400
- debug?: (and +debug?+ #t)
+ debug?: +debug?+
preload: (lambda (game)
(init-audio!)
(load-sounds! '((jump . "demo/assets/jump.wav"))))
create: (lambda (game)
- (let* ((scene (game-load-scene! game "demo/assets/level-0.tmx"))
- (player (list #:type 'player
- #:x 100 #:y 50
- #:width 16 #:height 16
- #:vx 0 #:vy 0
- #:gravity? #t
- #:on-ground? #f
- #:tile-id 1
- #:tags '(player)))
- (_ (scene-add-entity scene player)))
+ (let ((scene (game-load-scene! game "demo/assets/level-0.tmx")))
+ (scene-add-entity scene (make-player))
(scene-camera-target-set! scene 'player)))
update: (lambda (game dt)
(let* ((input (game-input game))
(scene (game-scene game))
(tm (scene-tilemap scene))
- (player (car (scene-entities scene)))
- (player (entity-set player #:vx
- (cond
- ((input-held? input 'left) -3)
- ((input-held? input 'right) 3)
- (else 0))))
- (_ (when (and (input-pressed? input 'a)
- (entity-ref player #:on-ground? #f))
- (play-sound 'jump)))
- (player (apply-jump player (input-pressed? input 'a)))
- (player (apply-acceleration player))
- (player (apply-gravity player))
- (player (apply-velocity-x player))
- (player (resolve-tile-collisions-x player tm))
- (player (apply-velocity-y player))
- (player (resolve-tile-collisions-y player tm))
- (player (detect-on-solid player tm)))
+ (player (update-player (car (scene-entities scene)) input tm)))
(scene-entities-set! scene (list player))))))
(game-run! *game*)