diff options
Diffstat (limited to 'lisparuga.scm')
| -rw-r--r-- | lisparuga.scm | 88 |
1 files changed, 49 insertions, 39 deletions
diff --git a/lisparuga.scm b/lisparuga.scm index b552a7a..dc611cd 100644 --- a/lisparuga.scm +++ b/lisparuga.scm @@ -44,10 +44,13 @@ (define-asset background (load-image (scope-asset "images/background.png"))) (define-class <lisparuga> (<scene-2d>) - (state #:accessor state #:init-value 'play)) + (state #:accessor state #:init-value 'init)) -(define (game-over? lisparuga) - (zero? (lives (& lisparuga actor-canvas game player)))) +(define-method (game-over? (lisparuga <lisparuga>)) + (game-over? (& lisparuga game))) + +(define-method (complete? (lisparuga <lisparuga>)) + (complete? (& lisparuga game))) (define-method (on-boot (lisparuga <lisparuga>)) ;; Scale a small framebuffer up to the window size. @@ -58,34 +61,27 @@ #:height %framebuffer-height) #:area (let ((wc (window-config (current-kernel)))) (make-rect 0 0 (window-width wc) (window-height wc)))))) - ;; This 160x240 canvas is where the actual game actors will get - ;; rendered. - (let ((actor-canvas (make <canvas> - #:name 'actor-canvas - #:rank 1 - #:views (list (make <view-2d> - #:camera (make <camera-2d> - #:width 160 - #:height 240) - #:area (make-rect 80 0 160 240) - #:clear-color (make-color 0.0 0.0 0.0 1.0)))))) - (attach-to lisparuga - (make <sprite> - #:name 'background - #:rank 0 - #:texture background) - actor-canvas) - (new-game-transition lisparuga))) + (attach-to lisparuga + (make <sprite> + #:name 'background + #:rank 0 + #:texture background)) + (new-game-transition lisparuga)) (define (new-game-transition lisparuga) (set! (state lisparuga) 'play) (let ((game-over (& lisparuga game-over))) (and game-over (detach game-over))) - (let ((old-game (& lisparuga actor-canvas game))) + (let ((old-game (& lisparuga game))) (and old-game (detach old-game))) - (attach-to (& lisparuga actor-canvas) (make <game> #:name 'game))) + (attach-to lisparuga + (make <game> + #:name 'game + #:rank 1 + #:position (vec2 80.0 0.0))) + (set! (state lisparuga) 'play)) -(define (game-over-transition lisparuga) +(define-method (game-over-transition (lisparuga <lisparuga>)) (set! (state lisparuga) 'game-over) (let ((game-over (make <node-2d> #:name 'game-over @@ -94,21 +90,33 @@ (make <label> #:name 'game-over #:text "GAME OVER" - #:position (vec2 (- 160.0 (/ (* 9.0 8.0) 2.0)) - 116.0) - #:rank 999)) + #:position (vec2 160.0 120.0) + #:align 'center + #:vertical-align 'center) + (make <label> + #:name 'instructions + #:text "press ENTER to play again" + #:position (vec2 160.0 90.0) + #:align 'center)) (attach-to lisparuga game-over))) +(define-method (win-transition (lisparuga <lisparuga>)) + (set! (state lisparuga) 'win)) + (define-method (update (lisparuga <lisparuga>) dt) (match (state lisparuga) ('play - (if (game-over? lisparuga) - (game-over-transition lisparuga) - (steer-player (& lisparuga actor-canvas game) - (key-pressed? 'up) - (key-pressed? 'down) - (key-pressed? 'left) - (key-pressed? 'right)))) + (cond + ((game-over? lisparuga) + (game-over-transition lisparuga)) + ((complete? lisparuga) + (win-transition lisparuga)) + (else + (steer-player (& lisparuga game) + (key-pressed? 'up) + (key-pressed? 'down) + (key-pressed? 'left) + (key-pressed? 'right))))) (_ #f))) (define-method (on-key-press (lisparuga <lisparuga>) key scancode modifiers repeat?) @@ -116,11 +124,13 @@ ('play (unless repeat? (match key - ('z (start-player-shooting (& lisparuga actor-canvas game))) - ('x (toggle-player-polarity (& lisparuga actor-canvas game))) - ('c (fire-player-homing-missiles (& lisparuga actor-canvas game))) + ('z (start-player-shooting (& lisparuga game))) + ('x (toggle-player-polarity (& lisparuga game))) + ('c (fire-player-homing-missiles (& lisparuga game))) + ('r (spawn-enemies (& lisparuga game))) + ('e (set! (energy (& lisparuga game player)) 120)) (_ #t)))) - ('game-over + ((or 'win 'game-over) (match key ('return (new-game-transition lisparuga)) (_ #f))) @@ -130,7 +140,7 @@ (match (state lisparuga) ('play (match key - ('z (stop-player-shooting (& lisparuga actor-canvas game))) + ('z (stop-player-shooting (& lisparuga game))) (_ #t))) (_ #f))) |