blob: e7c0259217ddea3e18a52011079b8cb86255d0ee (
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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
;;; guile-2d
;;; Copyright (C) 2013 David Thompson <dthompson2@worcester.edu>
;;;
;;; Guile-2d is free software: you can redistribute it and/or modify it
;;; under the terms of the GNU Lesser General Public License as
;;; published by the Free Software Foundation, either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; Guile-2d 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
;;; Lesser General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with this program. If not, see
;;; <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; 2D sprite procedures.
;;
;;; Code:
(define-module (2d sprite)
#:use-module (srfi srfi-9)
#:use-module (figl gl)
#:use-module (figl contrib packed-struct)
#:use-module (2d texture)
#:use-module (2d vector)
#:export (make-sprite
sprite?
sprite-texture
sprite-position
set-sprite-position!
sprite-scale
set-sprite-scale!
sprite-rotation
set-sprite-rotation!
sprite-color
set-sprite-color!
sprite-anchor
set-sprite-anchor!
sprite-vertices
set-sprite-vertices!
load-sprite
draw-sprite))
;; Used to build OpenGL vertex array for a sprite.
(define-packed-struct sprite-vertex
(x float)
(y float)
(r float)
(g float)
(b float)
(a float)
(s float)
(t float))
;; The <sprite> object represents a texture with a given position, scale,
;; rotation, and color.
(define-record-type <sprite>
(%make-sprite texture position scale rotation color anchor vertices)
sprite?
(texture sprite-texture)
(position sprite-position set-sprite-position!)
(scale sprite-scale set-sprite-scale!)
(rotation sprite-rotation set-sprite-rotation!)
(color sprite-color set-sprite-color!)
(anchor sprite-anchor set-sprite-anchor!)
(vertices sprite-vertices set-sprite-vertices!))
(define* (make-sprite texture #:optional #:key (position #(0 0)) (scale #(1 1))
(rotation 0) (color '(1 1 1)) (anchor 'center))
"Makes a new sprite object."
(let ((vertices (make-packed-array sprite-vertex 4)))
(%make-sprite texture position scale rotation color anchor vertices)))
(define* (load-sprite filename #:optional #:key (position #(0 0)) (scale #(1 1))
(rotation 0) (color '(1 1 1)) (anchor 'center))
"Loads a sprite from file."
(make-sprite (load-texture filename) #:position position #:scale scale
#:rotation rotation #:color color #:anchor anchor))
(define (sprite-anchor-vector sprite)
(let ((anchor (sprite-anchor sprite)))
(cond
((eq? anchor 'center)
(let ((texture (sprite-texture sprite)))
(vector (/ (texture-width texture) 2)
(/ (texture-height texture) 2))))
(else anchor))))
(define (update-sprite-vertices sprite)
(let* ((vertices (sprite-vertices sprite))
(texture (sprite-texture sprite))
(anchor (sprite-anchor-vector sprite))
(x (- (vx anchor)))
(y (- (vy anchor)))
(x2 (+ x (texture-width texture)))
(y2 (+ y (texture-width texture))))
(pack vertices 0 sprite-vertex
x y
1 1 1 1
0 0)
(pack vertices 1 sprite-vertex
x2 y
1 1 1 1
1 0)
(pack vertices 2 sprite-vertex
x2 y2
1 1 1 1
1 1)
(pack vertices 3 sprite-vertex
x y2
1 1 1 1
0 1)))
(define (draw-sprite sprite)
"Renders a sprite."
(update-sprite-vertices sprite)
(let* ((texture (sprite-texture sprite))
(width (texture-width texture))
(height (texture-height texture))
(pos (sprite-position sprite))
(scale (sprite-scale sprite))
(vertices (sprite-vertices sprite)))
(with-gl-push-matrix
(gl-translate (vx pos) (vy pos) 0)
(gl-rotate (sprite-rotation sprite) 0 0 1)
(gl-scale (vx scale) (vy scale) 0)
;; Draw vertex array
(gl-enable-client-state (enable-cap vertex-array))
(gl-enable-client-state (enable-cap color-array))
(gl-enable-client-state (enable-cap texture-coord-array))
(with-gl-bind-texture (texture-target texture-2d) (texture-id texture)
(set-gl-vertex-array (vertex-pointer-type float)
vertices
2
#:stride (packed-struct-size sprite-vertex)
#:offset (packed-struct-offset sprite-vertex x))
(set-gl-color-array (color-pointer-type float)
vertices
4
#:stride (packed-struct-size sprite-vertex)
#:offset (packed-struct-offset sprite-vertex r))
(set-gl-texture-coordinates-array (tex-coord-pointer-type float)
vertices
#:stride (packed-struct-size sprite-vertex)
#:offset (packed-struct-offset sprite-vertex s))
(gl-draw-arrays (begin-mode quads) 0 (packed-array-length vertices sprite-vertex)))
(gl-disable-client-state (enable-cap texture-coord-array))
(gl-disable-client-state (enable-cap color-array))
(gl-disable-client-state (enable-cap vertex-array)))))
|
