blob: c7caab29712a9e08e25dd8b8e13268da99a154ad (
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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
;;; 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:
;;
;; A class representing a scripted or player-controller object in the
;; game world. Actors can emit bullets and have many hitboxes.
;;
;;; Code:
(define-module (lisparuga actor)
#:use-module (chickadee math vector)
#:use-module (chickadee math rect)
#:use-module (lisparuga node)
#:use-module (lisparuga node-2d)
#:use-module (oop goops)
#:use-module (srfi srfi-9)
#:export (make-hitbox
hitbox?
hitbox-name
hitbox-rect
world-hitbox?
world-hitbox-collision?
world-hitbox-parent
<actor>
polarity
velocity
hitboxes
world-hitboxes
on-collision
bullet-field))
;;;
;;; Hitboxes
;;;
(define-record-type <hitbox>
(make-hitbox name rect)
hitbox?
(name hitbox-name)
(rect hitbox-rect))
(define-record-type <world-hitbox>
(%make-world-hitbox parent rect)
world-hitbox?
(parent world-hitbox-parent)
(rect world-hitbox-rect))
(define (make-world-hitbox parent)
(let ((r (hitbox-rect parent)))
(%make-world-hitbox parent
(make-rect 0.0 0.0 (rect-width r) (rect-height r)))))
(define (sync-world-hitbox world-hitbox position)
(rect-move-vec2! (world-hitbox-rect world-hitbox) position))
(define (world-hitbox-collision? a b)
(if (world-hitbox? b)
(rect-intersects? (world-hitbox-rect a) (world-hitbox-rect b))
(rect-intersects? (world-hitbox-rect a) b)))
;;;
;;; Actors
;;;
(define-class <actor> (<node-2d>)
(polarity #:accessor polarity #:init-form 'none #:init-keyword #:polarity)
(velocity #:getter velocity #:init-form (vec2 0.0 0.0))
(hitboxes #:accessor hitboxes #:init-form '() #:init-keyword #:hitboxes)
(world-hitboxes #:accessor world-hitboxes #:init-form '())
(bullet-field #:accessor bullet-field #:init-keyword #:bullet-field))
(define-method (initialize (actor <actor>) initargs)
(next-method)
(set! (world-hitboxes actor)
(map make-world-hitbox (hitboxes actor))))
(define-method (update (actor <actor>) dt)
(let ((v (velocity actor)))
(unless (and (= (vec2-x v) 0.0)
(= (vec2-y v) 0.0))
;; Move by current velocity.
(vec2-add! (position actor) v)
;; Sync hitboxes to world coordinates.
(let ((pos (position actor)))
(for-each (lambda (world-hitbox)
(sync-world-hitbox world-hitbox pos))
(world-hitboxes actor)))
;; Mark for matrix updates.
(dirty! actor))))
;; Actor-actor collision event.
(define-method (on-collision (actor <actor>) (other-actor <actor>)
hitbox other-hitbox)
#t)
|
