blob: f271d43dbd306dafb5656ff67c9bf53530b75321 (
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
|
(library (strigoform bullets)
(export make-bullet-pool
bullet-pool?
bullet-pool-add!
bullet-pool-remove!
bullet-pool-reset!
bullet-pool-update!
draw-bullets)
(import (scheme base)
(hoot match)
(strigoform canvas)
(strigoform game-area)
(strigoform math)
(strigoform particles)
(strigoform type))
(define-type bullet-pool
%make-bullet-pool
bullet-pool?
(length bullet-pool-length set-bullet-pool-length!)
(capacity bullet-pool-capacity set-bullet-pool-capacity!)
(image bullet-pool-image set-bullet-pool-image!)
(bullets bullet-pool-bullets set-bullet-pool-bullets!))
(define bullet-tile-width 16.0)
(define bullet-tile-height 16.0)
;; per bullet: type, tile-x, x, y, w, h, dx, dy
(define %bullet-size (+ 4 8 8 8 8 8 8 8))
(define (make-bullet-pool capacity image)
(let ((bullets (make-bytevector (* capacity %bullet-size))))
(%make-bullet-pool 0 capacity image bullets)))
(define (bullet-pool-offset i)
(* i %bullet-size))
(define (bullet-pool-add! pool type x y w h dx dy)
(match pool
(#('bullet-pool length capacity image bullets)
(let ((offset (bullet-pool-offset length)))
(s32-set! bullets offset type)
(f64-set! bullets (+ offset 4) (* type bullet-tile-width))
(f64-set! bullets (+ offset 12) x)
(f64-set! bullets (+ offset 20) y)
(f64-set! bullets (+ offset 28) w)
(f64-set! bullets (+ offset 36) h)
(f64-set! bullets (+ offset 44) dx)
(f64-set! bullets (+ offset 52) dy)
(set-bullet-pool-length! pool (+ length 1))))))
(define (bullet-pool-remove! pool i)
(match pool
(#('bullet-pool length capacity image bullets)
(when (and (>= i 0) (< i length))
(let ((at (bullet-pool-offset i))
(start (bullet-pool-offset (- length 1))))
(bytevector-copy! bullets at bullets start (+ start %bullet-size))
(set-bullet-pool-length! pool (- length 1)))))))
(define (bullet-pool-reset! pool)
(set-bullet-pool-length! pool 0))
(define (bullet-pool-update! pool collide dscroll on-collide)
(match pool
(#('bullet-pool length capacity image bullets)
(let loop ((i 0) (k length))
(when (< i k)
(let* ((offset (bullet-pool-offset i))
(type (s32-ref bullets offset))
(x (f64-ref bullets (+ offset 12)))
(y (f64-ref bullets (+ offset 20)))
(w (f64-ref bullets (+ offset 28)))
(h (f64-ref bullets (+ offset 36)))
(dx (f64-ref bullets (+ offset 44)))
(dy (f64-ref bullets (+ offset 52)))
(x* (+ x dx))
(y* (+ y dy dscroll)))
(cond
((out-of-bounds? x* y* w h)
(bullet-pool-remove! pool i)
(loop i (- k 1)))
((collide type x* y* w h)
(on-collide type x* y*)
(bullet-pool-remove! pool i)
(loop i (- k 1)))
(else
(f64-set! bullets (+ offset 12) x*)
(f64-set! bullets (+ offset 20) y*)
(loop (+ i 1) k)))))))))
(define (draw-bullets context pool)
(match pool
(#('bullet-pool length capacity image bullets)
(do ((i 0 (+ i 1)))
((= i length))
(let* ((offset (bullet-pool-offset i))
(tx (f64-ref bullets (+ offset 4)))
(x (f64-ref bullets (+ offset 12)))
(y (f64-ref bullets (+ offset 20)))
(w (f64-ref bullets (+ offset 28)))
(h (f64-ref bullets (+ offset 36))))
(draw-image context image tx 0.0
bullet-tile-width bullet-tile-height
(- x (/ bullet-tile-width 2.0))
(- y (/ bullet-tile-height 2.0))
bullet-tile-width bullet-tile-height)))))))
|
