blob: 390003b42ea5b98045dc01ff03c4c00cd2878a21 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
;;; Copyright 2023 David Thompson
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
(define-module (super-bloom main)
#:use-module (catbird)
#:use-module (catbird camera)
#:use-module (catbird kernel)
#:use-module (catbird mixins)
#:use-module (catbird region)
#:use-module (catbird scene)
#:use-module (chickadee)
#: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-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-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-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 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))
|
