From ebc1c54b8f184ff485561b7c039be368b6a9d2c9 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson@vistahigherlearning.com>
Date: Fri, 10 Apr 2020 22:42:26 -0400
Subject: Day 1 progress.

---
 lisparuga.scm | 93 +++++++++++++++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 87 insertions(+), 6 deletions(-)

(limited to 'lisparuga.scm')

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>))))
-- 
cgit v1.2.3