syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Progress

This commit is contained in:
Tony Garnock-Jones 2015-10-23 19:51:00 -04:00
parent 9da90088b6
commit 8bb1b36073
1 changed files with 92 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

164
examples/platformer/game.rkt
View File

@ -4,8 +4,10 @@
(require racket/match) (require racket/match)
(require prospect/drivers/timer) (require prospect/drivers/timer)
(require plot/utils) ;; for vector utilities (require plot/utils) ;; for vector utilities
(require 2htdp/image)
(require prospect-gl/2d) (require prospect-gl/2d)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Layers: ;; Layers:
;; ;;
;; - External I/O ;; - External I/O
@ -28,25 +30,32 @@
;; actors represent entities in the world, mostly ;; actors represent entities in the world, mostly
;; misc actors do physicsish things ;; misc actors do physicsish things
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ## Common Data Definitions ;; ## Common Data Definitions
;; ;;
;; A Vec is a (vector Number Number) ;; A Vec is a (vector Number Number)
;; A Point is a (vector Number Number) ;; A Point is a (vector Number Number)
;; (See vector functions in plot/utils) ;; (See vector functions in plot/utils)
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ## Ground Layer Protocols ;; ## Ground Layer Protocols
;;
;; - Scene Management ;;-------------------------------------------------------------------------
;; ### Scene Management
;; - assertion: ScrollOffset ;; - assertion: ScrollOffset
;; - role: SceneManager ;; - role: SceneManager
;; Displays the scene backdrop and adjusts display coordinates via ScrollOffset. ;; Displays the scene backdrop and adjusts display coordinates via ScrollOffset.
;; ;;
;; A ScrollOffset is a (scroll-offset Vec), indicating the vector to *subtract* ;; A ScrollOffset is a (scroll-offset Vec), indicating the vector to *subtract*
;; from world coordinates to get device coordinates. ;; from world coordinates to get device coordinates.
;; (struct scroll-offset (vec) #:transparent)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ## Game Layer Protocols ;; ## Game Layer Protocols
;;
;; - Scoring ;;-------------------------------------------------------------------------
;; ### Scoring
;; - message: AddToScore ;; - message: AddToScore
;; - assertion: CurrentScore ;; - assertion: CurrentScore
;; - role: ScoreKeeper ;; - role: ScoreKeeper
@ -54,7 +63,17 @@
;; Publishes the score using a CurrentScore. ;; Publishes the score using a CurrentScore.
;; Responds to AddToScore by updating the score. ;; Responds to AddToScore by updating the score.
;; ;;
;; - Level Spawning ;; An AddToScore is an (add-to-score Number), a message
;; which signals a need to add the given number to the player's
;; current score.
(struct add-to-score (delta) #:transparent)
;;
;; A CurrentScore is a (current-score Number), an assertion
;; indicating the player's current score.
(struct current-score (value) #:transparent)
;;-------------------------------------------------------------------------
;; ### Level Spawning
;; - assertion: LevelRunning ;; - assertion: LevelRunning
;; - message: LevelCompleted ;; - message: LevelCompleted
;; - role: LevelSpawner ;; - role: LevelSpawner
@ -71,22 +90,18 @@
;; going. Sends LevelCompleted if the player successfully completed ;; going. Sends LevelCompleted if the player successfully completed
;; the level. ;; the level.
;; ;;
;; An AddToScore is an (add-to-score Number), a message
;; which signals a need to add the given number to the player's
;; current score.
;;
;; A CurrentScore is a (current-score Number), an assertion
;; indicating the player's current score.
;;
;; A LevelRunning is a (level-running), an assertion indicating that the ;; A LevelRunning is a (level-running), an assertion indicating that the
;; current level is still in progress. ;; current level is still in progress.
;; ;;
;; A LevelCompleted is a (level-completed), a message indicating that ;; A LevelCompleted is a (level-completed), a message indicating that
;; the current level was *successfully* completed before it terminated. ;; the current level was *successfully* completed before it terminated.
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ## Level Layer Protocols ;; ## Level Layer Protocols
;; ;;
;; - Movement and Physics ;;-------------------------------------------------------------------------
;; ### Movement and Physics
;; - message: JumpRequest ;; - message: JumpRequest
;; - assertion: Impulse ;; - assertion: Impulse
;; - assertion: Velocity ;; - assertion: Velocity
@ -118,7 +133,8 @@
;; enemies, the goal(s), and platforms and blocks in the environment. ;; enemies, the goal(s), and platforms and blocks in the environment.
;; Asserts a Sprite two layers out to render itself. ;; Asserts a Sprite two layers out to render itself.
;; ;;
;; - Player State ;;-------------------------------------------------------------------------
;; ### Player State
;; - message: Damage ;; - message: Damage
;; - assertion: Health ;; - assertion: Health
;; - role: Player ;; - role: Player
@ -126,7 +142,8 @@
;; Responds to Damage. ;; Responds to Damage.
;; When hitpoints drop low enough, removes the player from the board. ;; When hitpoints drop low enough, removes the player from the board.
;; ;;
;; - World State ;;-------------------------------------------------------------------------
;; ### World State
;; - assertion: LevelSize ;; - assertion: LevelSize
;; - role: DisplayControl ;; - role: DisplayControl
;; Maintains a LevelSize assertion. ;; Maintains a LevelSize assertion.
@ -230,67 +247,70 @@
;; Keyboard -> Player: (press space) ;; Keyboard -> Player: (press space)
;; Player -> Physics: (jump) ;; Player -> Physics: (jump)
;;--------------------------------------------------------------------------- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Keyboard and Display ;; SceneManager
;; A KeyStateChangeEvent is either (define window-projection (compile-projection (at-meta (?! (window ? ?)))))
;; - (key-press KeyEvent) ;; from 2htdp (define scroll-offset-projection (compile-projection (scroll-offset (?!))))
;; - (key-release KeyEvent)
;; signalling a key state change.
(struct key-press (key) #:prefab)
(struct key-release (key) #:prefab)
;; A ScreenSize is a (screen-size Vec), indicating the size of the device. (define (spawn-scene-manager)
(struct screen-size (vec) #:prefab) (struct scene-manager-state (size offset) #:prefab)
;; The canvas here both delivers keyboard events and serves as a (define (update-window-size s p)
;; display medium. (define-values (added removed) (patch-project/set/single p window-projection))
(define game-canvas% (for/fold [(s s)] [(w added)]
(class canvas% (match-define (window width height) w)
(init-field key-handler) (struct-copy scene-manager-state s [size (vector width height)])))
(super-new)
(define/override (on-char event)
(match (send event get-key-code)
['release (key-handler (key-release (send event get-key-release-code)))]
[other (key-handler (key-press other))]))))
;; Construct, show and return a game-canvas%. (define (update-scroll-offset s p)
;; Keypresses will result in ground-messages. (define-values (added removed) (patch-project/set/single p scroll-offset-projection))
(define (make-frame width height) (for/fold [(s s)] [(o added)]
(parameterize ((current-eventspace (make-eventspace))) (match-define (scroll-offset vec) o)
(define frame (new frame% (struct-copy scene-manager-state s [offset vec])))
[label "Prospect Platformer"]
[width width]
[height height]))
(define canvas
(new game-canvas%
[parent frame]
[key-handler send-ground-message]))
(send canvas focus)
(send frame show #t)
canvas))
;; -> KeyboardIntegrator
(define (spawn-keyboard-driver)
(spawn (lambda (e s) (spawn (lambda (e s)
...) (match e
(void) [(? patch? p)
(sub ( (let* ((s (update-window-size s p))
)) (s (update-scroll-offset s p)))
(match-define (vector width height) (scene-manager-state-size s))
(match-define (vector ofs-x ofs-y) (scene-manager-state-offset s))
(transition s
(update-scene `((push-matrix (scale ,width ,height)
(texture ,(rectangle 1 1 "solid" "white"))
)
(translate ,ofs-x ,ofs-y))
`())))]
[_ #f]))
(scene-manager-state (vector 0 0) (vector 0 0))
(sub (window ? ?) #:meta-level 1)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ScoreKeeper
(define (spawn-score-keeper)
(spawn (lambda (e s)
(match e
[(message (add-to-score delta))
(transition (+ s delta)
(retract (current-score ?))
(assert (current-score delta)))]
[_ #f]))
0
(sub (add-to-score ?))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; LevelSpawner
(define (spawn-level-spawner)
(void))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(spawn-timer-driver) (2d-world #:width 600 #:height 400
(spawn-keyboard-driver) (spawn-keyboard-integrator)
;;(spawn-display-driver) (spawn-scene-manager)
(spawn-world (spawn-score-keeper)
(let ((canvas (make-frame 600 400))) (spawn-level-spawner)
;; Retrieve the actual displayed size of the canvas, which differs )
;; from the requested frame size because of window chrome etc. )
(define the-screen-size
(let-values (((x-max y-max) (send canvas get-client-size)))
(screen-size (vector x-max y-max))))
(define the-dc (send canvas get-dc))
;;
;; So equipped, we may spawn the renderer.
(spawn-renderer the-screen-size the-dc))