Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
87 lines (72 sloc) 3.29 KB
This file is a part of trial
(c) 2017 Shirakumo (
Author: Nicolas Hafner <>
(in-package #:org.shirakumo.fraf.trial)
;;; Sprite sheets define an animation for every row
;;; and a frame in the animation for every column.
(define-shader-entity sprite-entity (vertex-entity textured-entity)
((tile :initarg :tile :accessor tile)
(size :initarg :size :accessor size))
:size (vec2 32 32)
:tile (vec2 0 0))
(textured-entity :vertex-shader)))
(defmethod paint :before ((entity sprite-entity) (pass shader-pass))
(let ((shader (shader-program-for-pass pass entity)))
(setf (uniform shader "size") (size entity))
(setf (uniform shader "tile") (tile entity))))
(define-class-shader (sprite-entity :vertex-shader)
"layout (location = 1) in vec2 in_texcoord;
out vec2 texcoord;
uniform sampler2D texture_image;
uniform vec2 tile = vec2(0, 0);
uniform vec2 size = vec2(32, 32);
void main(){
// Determine size of a single sprite in the sheet.
vec2 sprite_size = size / textureSize(texture_image, 0);
// Determine position of the \"start\" coordinates for this frame.
vec2 frame_start = sprite_size * tile;
// Maybe add 1 if we're at the other edges.
texcoord = frame_start + in_texcoord * sprite_size;
(define-shader-subject animated-sprite-subject (sprite-entity)
((animations :initform NIL :accessor animations)
(clock :initform 0.0d0 :accessor clock)))
(defmethod shared-initialize :after ((subject animated-sprite-subject) slots &key animation frame animations)
(when animations (setf (animations subject) animations))
(when animation (setf (animation subject) animation))
(when frame (setf (frame subject) frame)))
(defmethod frame ((subject animated-sprite-subject))
(vx (tile subject)))
(defmethod (setf frame) (value (subject animated-sprite-subject))
(setf (vx (tile subject)) value))
(defmethod animation ((subject animated-sprite-subject))
(vy (tile subject)))
(defmethod (setf animation) (value (subject animated-sprite-subject))
(when (/= value (animation subject))
(setf (vy (tile subject)) value)
(setf (vx (tile subject)) (first (nth value (animations subject))))))
(defmethod (setf animations) (value (subject animated-sprite-subject))
(setf (slot-value subject 'animations)
(loop for spec in value
for i from 0
collect (destructuring-bind (duration frames &key (start 0) (next i) (loop-to start))
(list start duration frames next loop-to)))))
(define-handler (animated-sprite-subject update-sprite-animation tick) (ev dt)
(let ((tile (tile animated-sprite-subject)))
(destructuring-bind (duration frames next-anim loop-to)
(rest (nth (round (vy tile)) (animations animated-sprite-subject)))
(let ((per-frame-duration (/ duration frames)))
(incf (clock animated-sprite-subject) dt)
(when (<= per-frame-duration (clock animated-sprite-subject))
(decf (clock animated-sprite-subject) per-frame-duration)
(incf (vx tile)))
(when (<= frames (frame animated-sprite-subject))
(cond ((= (vy tile) next-anim)
(setf (vx tile) loop-to))
(setf (vy tile) next-anim))))))))