blob: 828ba586c4b8cdaf9e647dfe82fcf37ffe552afe (
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
92
93
94
95
96
97
98
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 %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-method (on-key-release (lisparuga <lisparuga>) key scancode modifiers)
(match key
('z (stop-player-shooting (& lisparuga actor-canvas game)))
(_ #t)))
(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))
(lambda () (make <lisparuga>))))
|
