From 45791c1360c98957ebe27655d59a2ae9db6cd709 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sun, 4 Jun 2023 09:25:06 -0400
Subject: Giant code and assets drop.

---
 super-bloom/main.scm | 75 ++++++++++++++++++++++++++++++++++++++++------------
 1 file changed, 58 insertions(+), 17 deletions(-)

(limited to 'super-bloom/main.scm')

diff --git a/super-bloom/main.scm b/super-bloom/main.scm
index 2f49e9a..390003b 100644
--- a/super-bloom/main.scm
+++ b/super-bloom/main.scm
@@ -14,37 +14,78 @@
 
 (define-module (super-bloom main)
   #:use-module (catbird)
-  #:use-module (catbird asset)
   #:use-module (catbird camera)
   #:use-module (catbird kernel)
-  #:use-module (catbird node)
-  #:use-module (catbird node-2d)
+  #:use-module (catbird mixins)
   #:use-module (catbird region)
   #:use-module (catbird scene)
   #:use-module (chickadee)
-  #:use-module (chickadee math vector)
-  #:use-module (chickadee graphics sprite)
-  #:use-module (chickadee graphics texture)
+  #:use-module (chickadee graphics color)
+  #:use-module (chickadee math rect)
   #:use-module (oop goops)
+  #:use-module (super-bloom common)
+  #:use-module (super-bloom game)
   #:export (launch-game))
 
-(define %default-width 1366)
-(define %default-height 768)
+(define-class <upscaled-centered-region> (<region>)
+  (area #:getter area #:init-form (make-rect 0.0 0.0 1.0 1.0))
+  (unscaled-width #:getter unscaled-width #:init-keyword #:unscaled-width)
+  (unscaled-height #:getter unscaled-height #:init-keyword #:unscaled-height))
 
-(define-asset (chickadee-texture (file "assets/images/chickadee.png"))
-  (load-image file))
+(define-method (initialize (region <upscaled-centered-region>) initargs)
+  (next-method)
+  (refresh-area region
+                (window-width (current-window))
+                (window-height (current-window))))
+
+(define-method (on-window-resize (region <upscaled-centered-region>) width height)
+  (refresh-area region width height))
+
+(define-method (refresh-camera (region <upscaled-centered-region>))
+  (let ((c (camera region)))
+    (when c (resize c (unscaled-width region) (unscaled-height region)))))
+
+(define-method (refresh-area (region <upscaled-centered-region>) width height)
+  (let* ((w (unscaled-width region))
+         (h (unscaled-height region))
+         (scale (max (min (truncate-quotient width w)
+                          (truncate-quotient height h))
+                     1))
+         (new-w (* w scale))
+         (new-h (* h scale)))
+    (move region
+          (truncate-quotient (- width new-w) 2)
+          (truncate-quotient (- height new-h) 2))
+    (resize region new-w new-h)))
+
+(define* (create-upscaled-centered-region width height #:key (rank 0) (name #f))
+  (let ((region (make <upscaled-centered-region>
+                  #:name name
+                  #:rank rank
+                  #:unscaled-width width
+                  #:unscaled-height height)))
+    (add-region (current-kernel) region)
+    region))
+
+(define-class <game-scene> (<scene>))
+
+(define-method (width (scene <game-scene>))
+  %game-width:float)
+
+(define-method (height (scene <game-scene>))
+  %game-height:float)
 
 (define (init)
-  (let ((region (create-full-region #:name 'main))
-        (scene (make <scene> #:name 'super-bloom)))
+  (let ((region (create-upscaled-centered-region %game-width %game-height #:name 'main))
+        (scene (make <game-scene> #:name 'super-bloom))
+        (camera (make <camera-2d> #:width %game-width #:height %game-height)))
     (replace-scene region scene)
-    (set-camera region (make <camera-2d>))
-    (attach-to scene (make <sprite>
-                       #:name 'chickadee
-                       #:texture chickadee-texture))
-    (center-in-parent (& scene chickadee))))
+    (set-camera region camera)
+    (replace-major-mode scene (make <super-bloom-mode>))))
 
 (define (launch-game)
   (run-catbird init
+               #:title "SUPER BLOOM (Spring Lisp Game Jam 2023)"
+               #:clear-color black
                #:width %default-width
                #:height %default-height))
-- 
cgit v1.2.3