diff options
Diffstat (limited to 'lisparuga.scm')
| -rw-r--r-- | lisparuga.scm | 93 |
1 files changed, 87 insertions, 6 deletions
diff --git a/lisparuga.scm b/lisparuga.scm index 2a700a2..828ba58 100644 --- a/lisparuga.scm +++ b/lisparuga.scm @@ -1,18 +1,99 @@ +;;; Lisparuga +;;; Copyright © 2020 David Thompson <dthompson2@worcester.edu> +;;; +;;; Lisparuga is free software: you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published +;;; by the Free Software Foundation, either version 3 of the License, +;;; or (at your option) any later version. +;;; +;;; Lisparuga is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Lisparuga. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Main scene. +;; +;;; Code: + (define-module (lisparuga) + #:use-module ((chickadee) #:select (key-pressed?)) + #:use-module (chickadee math rect) + #:use-module (chickadee math vector) + #:use-module (chickadee render color) + #:use-module (chickadee render texture) + #:use-module (ice-9 match) + #:use-module (lisparuga asset) + #:use-module (lisparuga config) + #:use-module (lisparuga game) #:use-module (lisparuga kernel) + #:use-module (lisparuga node) + #:use-module (lisparuga node-2d) #:use-module (lisparuga scene) #:use-module (oop goops) #:export (launch-lisparuga)) -(define %window-width 640) -(define %window-height 480) +(define %framebuffer-width 320) +(define %framebuffer-height 240) + +(define-asset background (load-image (scope-asset "images/background.png"))) + +(define-class <lisparuga> (<scene-2d>)) + +(define-method (on-boot (lisparuga <lisparuga>)) + ;; Scale a small framebuffer up to the window size. + (set! (views lisparuga) + (list (make <view-2d> + #:camera (make <camera-2d> + #:width %framebuffer-width + #: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 + #: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 + #:texture background) + actor-canvas))) + +(define-method (update (lisparuga <lisparuga>) dt) + (steer-player (& lisparuga actor-canvas game) + (key-pressed? 'up) + (key-pressed? 'down) + (key-pressed? 'left) + (key-pressed? 'right))) + +(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)))) -(define-class <lisparuga> (<scene>)) +(define-method (on-key-release (lisparuga <lisparuga>) key scancode modifiers) + (match key + ('z (stop-player-shooting (& lisparuga actor-canvas game))) + (_ #t))) -(define (launch-lisparuga) +(define* (launch-lisparuga #:key (window-width 640) (window-height 480)) (boot-kernel (make <kernel> #:window-config (make <window-config> #:title "Lisparuga" - #:width %window-width - #:height %window-height)) + #:width window-width + #:height window-height)) (lambda () (make <lisparuga>)))) |