diff options
Diffstat (limited to 'lisparuga.scm')
| -rw-r--r-- | lisparuga.scm | 78 |
1 files changed, 61 insertions, 17 deletions
diff --git a/lisparuga.scm b/lisparuga.scm index 828ba58..b552a7a 100644 --- a/lisparuga.scm +++ b/lisparuga.scm @@ -33,6 +33,7 @@ #:use-module (lisparuga kernel) #:use-module (lisparuga node) #:use-module (lisparuga node-2d) + #:use-module (lisparuga player) #:use-module (lisparuga scene) #:use-module (oop goops) #:export (launch-lisparuga)) @@ -42,7 +43,11 @@ (define-asset background (load-image (scope-asset "images/background.png"))) -(define-class <lisparuga> (<scene-2d>)) +(define-class <lisparuga> (<scene-2d>) + (state #:accessor state #:init-value 'play)) + +(define (game-over? lisparuga) + (zero? (lives (& lisparuga actor-canvas game player)))) (define-method (on-boot (lisparuga <lisparuga>)) ;; Scale a small framebuffer up to the window size. @@ -57,38 +62,77 @@ ;; 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 actor-canvas (make <game> #:name 'game)) (attach-to lisparuga (make <sprite> #:name 'background + #:rank 0 #:texture background) - actor-canvas))) + actor-canvas) + (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))) + (and old-game (detach old-game))) + (attach-to (& lisparuga actor-canvas) (make <game> #:name 'game))) + +(define (game-over-transition lisparuga) + (set! (state lisparuga) 'game-over) + (let ((game-over (make <node-2d> + #:name 'game-over + #:rank 999))) + (attach-to game-over + (make <label> + #:name 'game-over + #:text "GAME OVER" + #:position (vec2 (- 160.0 (/ (* 9.0 8.0) 2.0)) + 116.0) + #:rank 999)) + (attach-to lisparuga game-over))) (define-method (update (lisparuga <lisparuga>) dt) - (steer-player (& lisparuga actor-canvas game) - (key-pressed? 'up) - (key-pressed? 'down) - (key-pressed? 'left) - (key-pressed? 'right))) + (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)))) + (_ #f))) (define-method (on-key-press (lisparuga <lisparuga>) key scancode modifiers repeat?) - (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))) - (_ #t)))) + (match (state lisparuga) + ('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))) + (_ #t)))) + ('game-over + (match key + ('return (new-game-transition lisparuga)) + (_ #f))) + (_ #f))) (define-method (on-key-release (lisparuga <lisparuga>) key scancode modifiers) - (match key - ('z (stop-player-shooting (& lisparuga actor-canvas game))) - (_ #t))) + (match (state lisparuga) + ('play + (match key + ('z (stop-player-shooting (& lisparuga actor-canvas game))) + (_ #t))) + (_ #f))) (define* (launch-lisparuga #:key (window-width 640) (window-height 480)) (boot-kernel (make <kernel> |