46 lines
1.5 KiB
Common Lisp
46 lines
1.5 KiB
Common Lisp
#|
|
|
This file is a part of stoe project.
|
|
Copyright (c) 2014 Renaud Casenave-Péré (renaud@casenave-pere.fr)
|
|
|#
|
|
|
|
(uiop:define-package :stoe/core/time
|
|
(:use :cl)
|
|
(:export #:clock #:make-clock #:update-clock #:clock-delta))
|
|
(in-package :stoe/core/time)
|
|
|
|
(defun get-current-time ()
|
|
"Return the current time in seconds and microseconds."
|
|
#+sbcl
|
|
(multiple-value-bind (sec usec) (sb-ext:get-time-of-day)
|
|
(+ (* sec 1000000) usec))
|
|
#-sbcl
|
|
(let* ((time (get-internal-real-time))
|
|
(sec (/ time internal-time-units-per-second))
|
|
(usec (* time (/ 1000000 internal-time-units-per-second))))
|
|
(+ (* sec 1000000) usec)))
|
|
|
|
(defclass clock ()
|
|
((current-time :initarg :time)
|
|
(last-time :initarg :last-time)
|
|
(delta-time :initform nil)
|
|
(scale :initarg :scale)
|
|
(pausep :initarg :pause)))
|
|
|
|
(defun make-clock (&optional (time 0 timep) (scale 1.0) pause)
|
|
(unless timep
|
|
(setf time (get-current-time)))
|
|
(make-instance 'clock :time time :last-time time :scale scale :pause pause))
|
|
|
|
(defun update-clock (clock &optional (delta 0 deltap))
|
|
(with-slots (current-time last-time delta-time scale pausep) clock
|
|
(setf delta-time nil)
|
|
(unless pausep
|
|
(setf last-time current-time)
|
|
(if deltap
|
|
(incf current-time (* delta scale))
|
|
(setf current-time (get-current-time))))))
|
|
|
|
(defun clock-delta (clock)
|
|
(with-slots (current-time last-time delta-time) clock
|
|
(or delta-time
|
|
(setf delta-time (- current-time last-time)))))
|