Browse files

Add support for rails (linear interpolation only for now)

  • Loading branch information...
Shinmera committed Oct 10, 2017
1 parent 88316d9 commit 0ee52529ea5282d72ef5948220e81839ac408099
Showing with 52 additions and 0 deletions.
  1. +51 −0 rails.lisp
  2. +1 −0 trial.asd
@@ -0,0 +1,51 @@
This file is a part of trial
(c) 2016 Shirakumo (
Author: Nicolas Hafner <>
(in-package #:org.shirakumo.fraf.trial)
(define-subject rail (clocked-subject)
((target :initarg :target :accessor target)
(rail-points :accessor rail-points)
(duration :initarg :duration :accessor duration))
:target NIL
:rail-points (error "RAIL-POINTS required.")))
(defmethod initialize-instance :after ((rail rail) &key rail-points)
(setf (rail-points rail) (coerce rail-points 'vector)))
(define-handler (rail tick) (ev)
(when (and (target rail) (running rail))
(setf (location (target rail))
(rail-location rail (min 1 (/ (clock rail) (duration rail)))))))
(defgeneric rail-location (rail x))
(define-subject linear-rail (rail)
((rail-times :accessor rail-times)))
(defmethod (setf rail-points) :after (points (rail linear-rail))
(let ((total (loop for i from 1 below (length points)
sum (vlength (v- (aref points i) (aref points (1- i))))))
(times (make-array (length points) :element-type 'single-float
:initial-element 0.0s0)))
(loop for i from 1 below (length points)
for v = (v- (aref points i) (aref points (1- i)))
for d = (vlength v) then (+ d (vlength v))
do (setf (aref times i) (/ d total)))
(setf (rail-times rail) times)))
(defmethod rail-location (rail x)
(let ((times (rail-times rail))
(points (rail-points rail)))
(loop for i from 1 below (length times)
for ptime = (aref times 0) then time
for time = (aref times i)
do (when (<= x time)
(let ((x (/ (- x ptime) (- time ptime))))
(return (nv+ (nv* (v- (aref points i) (aref points (1- i))) x)
(aref points (1- i))))))
finally (return (aref points (1- (length points)))))))
@@ -48,6 +48,7 @@
(:file "main" :depends-on ("package" "display" "window" "toolkit" "scene" "pipeline"))
(:file "mapping" :depends-on ("package" "event-loop" "toolkit"))
(:file "pipeline" :depends-on ("package" "event-loop" "toolkit"))
(:file "rails" :depends-on ("package" "subject" "helpers"))
(:file "render-texture" :depends-on ("package" "pipeline" "entity"))
(:file "renderable" :depends-on ("package" "toolkit"))
(:file "retention" :depends-on ("package" "event-loop"))

0 comments on commit 0ee5252

Please sign in to comment.