forked from Shirakumo/trial
-
Notifications
You must be signed in to change notification settings - Fork 0
/
sprite.lisp
150 lines (126 loc) · 6.53 KB
/
sprite.lisp
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
#|
This file is a part of trial
(c) 2017 Shirakumo http://tymoon.eu (shinmera@tymoon.eu)
Author: Nicolas Hafner <shinmera@tymoon.eu>
|#
(in-package #:org.shirakumo.fraf.trial)
(defclass sprite-frame ()
((xy :initarg :xy :initform (error "XY required") :accessor xy)
(uv :initarg :uv :initform (error "UV required") :accessor uv)
(duration :initarg :duration :initform 0.1 :accessor duration)))
(defclass sprite-animation ()
((name :initarg :name :initform (error "NAME required") :reader name)
(start :initarg :start :initform (error "START required") :accessor start)
(end :initarg :end :initform (error "END required") :accessor end)
(next-animation :initarg :next-animation :initform NIL :accessor next-animation)
(loop-to :initarg :loop-to :initform NIL :accessor loop-to)))
(defmethod initialize-instance :after ((animation sprite-animation) &key)
(unless (next-animation animation)
(setf (next-animation animation) (name animation)))
(unless (loop-to animation)
(setf (loop-to animation) (start animation))))
(defmethod print-object ((animation sprite-animation) stream)
(print-unreadable-object (animation stream :type T)
(format stream "~s" (name animation))))
(define-shader-entity sprite-entity (vertex-entity textured-entity)
((frame-idx :initarg :frame-idx :initform 0 :accessor frame-idx)
(frames :initarg :frames :initform #() :accessor frames)
(vertex-array :initform NIL)))
(defun make-sprite-frame-mesh (frames &key mesh)
(with-vertex-filling ((or mesh (make-instance 'vertex-mesh :vertex-type 'textured-vertex)))
(loop for frame across frames
for xy = (xy frame)
for uv = (uv frame)
do (vertex :position (vec (- (vx xy) (vz xy)) (- (vy xy) (vw xy)) 0) :uv (vxy uv))
(vertex :position (vec (+ (vx xy) (vz xy)) (- (vy xy) (vw xy)) 0) :uv (vzy uv))
(vertex :position (vec (- (vx xy) (vz xy)) (+ (vy xy) (vw xy)) 0) :uv (vxw uv))
(vertex :position (vec (+ (vx xy) (vz xy)) (+ (vy xy) (vw xy)) 0) :uv (vzw uv)))))
(defmethod frame ((entity sprite-entity))
(aref (frames entity) (frame-idx entity)))
(defmethod (setf frame) ((idx integer) (entity sprite-entity))
(setf (frame-idx entity) idx))
(defmethod (setf frame) ((frame sprite-frame) (entity sprite-entity))
(setf (frame-idx entity) (or (position frame (frames entity))
(error "The frame~% ~a~%is not part of the sprite-entity." frame))))
(defmethod render ((entity sprite-entity) (program shader-program))
(setf (uniform program "model_matrix") (model-matrix))
(setf (uniform program "view_matrix") (view-matrix))
(setf (uniform program "projection_matrix") (projection-matrix))
(let ((vao (vertex-array entity)))
(gl:bind-vertex-array (gl-name vao))
(%gl:draw-arrays :triangle-strip (* 4 (frame-idx entity)) 4)
(gl:bind-vertex-array 0)))
(define-shader-entity animated-sprite (listener sprite-entity)
((clock :initform 0f0 :accessor clock)
(animations :initform #() :accessor animations)
(animation :initform NIL :accessor animation)
(playback-speed :initarg :playback-speed :initform 1.0 :accessor playback-speed)
(playback-direction :initarg :playback-direction :initform +1 :accessor playback-direction)
(sprite-data :initarg :sprite-data :initform NIL :accessor sprite-data)))
(defmethod initialize-instance :after ((sprite animated-sprite) &key)
(let ((sprite-data (sprite-data sprite)))
(when sprite-data
(setf (texture sprite) (resource sprite-data 'texture))
(setf (vertex-array sprite) (resource sprite-data 'vertex-array))
(register-generation-observer sprite sprite-data))))
(defmethod (setf sprite-data) :after ((data sprite-data) (sprite animated-sprite))
(setf (texture sprite) (resource data 'texture))
(setf (vertex-array sprite) (resource data 'vertex-array))
(setf (animations sprite) (animations data))
(setf (frames sprite) (frames data))
(unless (animation sprite)
(setf (animation sprite) 0)))
(defmethod observe-generation ((sprite animated-sprite) (data sprite-data) result)
(setf (animations sprite) (animations data))
(setf (frames sprite) (frames data))
(unless (animation sprite)
(setf (animation sprite) 0)))
(defmethod reset-animation ((sprite animated-sprite))
(setf (clock sprite) 0.0d0)
(ecase (playback-direction sprite)
(+1 (setf (frame sprite) (start (animation sprite))))
(-1 (setf (frame sprite) (1- (end (animation sprite)))))))
(defmethod find-animation (name (sprite animated-sprite) &optional (errorp T))
(or (find name (animations sprite) :key #'name)
(when errorp (error "No animation named ~s found." name))))
(defmethod (setf animation) ((animation sprite-animation) (sprite animated-sprite))
(unless (eql animation (animation sprite))
(call-next-method)
(reset-animation sprite))
animation)
(defmethod (setf animation) ((index integer) (sprite animated-sprite))
(setf (animation sprite) (aref (animations sprite) index)))
(defmethod (setf animation) ((name symbol) (sprite animated-sprite))
(let ((animation (animation sprite)))
(unless (and animation (eql name (name animation)))
(setf (animation sprite) (or (find name (animations sprite) :key #'name)
(error "No animation named ~s found." name))))))
(defmethod (setf animations) :after (animations (sprite animated-sprite))
(setf (animation sprite) 0))
(defmethod switch-animation ((sprite animated-sprite) animation)
(setf (playback-speed sprite) 1.0)
(setf (playback-direction sprite) +1)
(setf (clock sprite) 0.0d0)
(setf (animation sprite) animation))
(defmethod handle ((ev tick) (sprite animated-sprite))
(let* ((idx (frame-idx sprite))
(frame (aref (frames sprite) idx))
(animation (animation sprite)))
(incf (clock sprite) (* (playback-speed sprite) (dt ev)))
(when (<= (duration frame) (clock sprite))
(decf (clock sprite) (duration frame))
(incf idx (playback-direction sprite)))
(cond ((<= (end animation) idx)
(let ((next (next-animation animation)))
(cond ((eq next (name animation))
(setf (frame-idx sprite) (loop-to animation)))
(T
(switch-animation sprite next)))))
((< idx (start animation))
(let ((next (next-animation animation)))
(cond ((eq next (name animation))
(setf (frame-idx sprite) (1- (end animation))))
(T
(switch-animation sprite next)))))
(T
(setf (frame-idx sprite) idx)))))