115 lines
3.5 KiB
Common Lisp
115 lines
3.5 KiB
Common Lisp
#|
|
|
This file is a part of stoe project.
|
|
Copyright (c) 2014 Renaud Casenave-Péré (renaud@casenave-pere.fr)
|
|
|#
|
|
|
|
(in-package :cl-user)
|
|
(defpackage stoe.utils
|
|
(:use :cl)
|
|
(:nicknames :utils)
|
|
(:export :it
|
|
:aif
|
|
:awhen
|
|
:restartable
|
|
:eval-repl
|
|
:add-hook :remove-hook :run-hook
|
|
:update-current-time :get-delta-time
|
|
:make-clock :clock-time :clock-delta
|
|
:update-clock :compare-clocks))
|
|
(in-package :stoe.utils)
|
|
|
|
(defmacro aif (test then else)
|
|
"Bind the result of evaluating `test' to a variable named `it', as per Paul Graham's On Lisp."
|
|
`(let ((it ,test))
|
|
(if it
|
|
,then
|
|
,else)))
|
|
|
|
(defmacro awhen (test &body body)
|
|
"Bind the result of evaluating `test' to a variable named `it', as per Paul Graham's On Lisp."
|
|
`(let ((it ,test))
|
|
(when it
|
|
,@body)))
|
|
|
|
(defmacro restartable (unprotected &body body)
|
|
"Provide a Continue restart unless unprotected is t."
|
|
`(if ,unprotected
|
|
(progn
|
|
,@body)
|
|
(restart-case
|
|
(progn
|
|
,@body)
|
|
(continue () :report "Continue"))))
|
|
|
|
(defun eval-repl ()
|
|
"Eval the repl if the main-loop is run through it."
|
|
#+swank
|
|
(let ((conn (or swank::*emacs-connection*
|
|
(swank::default-connection))))
|
|
(when conn
|
|
(swank::handle-requests conn t))))
|
|
|
|
(defmacro add-hook (hook fun)
|
|
"Setup `fun' to be called within specified `hook'."
|
|
`(unless (member ,fun ,hook)
|
|
(setf ,hook (append ,hook (list ,fun)))))
|
|
|
|
(defmacro remove-hook (hook fun)
|
|
"Remove `fun' from `hook'."
|
|
`(delete ,fun ,hook))
|
|
|
|
(defun run-hook (hook &rest args)
|
|
"Apply all functions attached to `hook' with specified `args' if any."
|
|
(let (result)
|
|
(mapc (lambda (fun)
|
|
(setf result (apply fun args)))
|
|
hook)
|
|
result))
|
|
|
|
(defun get-current-time ()
|
|
"Return the current time in seconds and microseconds."
|
|
#+sbcl (sb-ext:get-time-of-day)
|
|
#-sbcl
|
|
(let* ((time (get-internal-real-time))
|
|
(sec (/ time internal-time-units-per-second))
|
|
(usec (* time (/ 1000000 internal-time-units-per-second))))
|
|
(values sec usec)))
|
|
|
|
(let ((last-time (cons 0 0))
|
|
(current-time (cons 0 0)))
|
|
|
|
(defun update-current-time ()
|
|
"Update the cached time in seconds and microseconds."
|
|
(setf (car last-time) (car current-time))
|
|
(setf (cdr last-time) (cdr current-time))
|
|
(multiple-value-bind (sec usec) (get-current-time)
|
|
(setf (car current-time) sec)
|
|
(setf (cdr current-time) usec)))
|
|
|
|
(defun get-delta-time ()
|
|
"Return the difference between the last two cached timers."
|
|
(+ (* (- (car current-time) (car last-time)) 1000000)
|
|
(- (cdr current-time) (cdr last-time)))))
|
|
|
|
(defstruct (clock (:constructor %make-clock))
|
|
(time 0)
|
|
(last-time 0)
|
|
(scale 1.0)
|
|
(paused nil))
|
|
|
|
(defun make-clock (&optional (time 0) (scale 1.0) (paused nil))
|
|
"Create a new clock instance with specified parameters or using reasonable defaults."
|
|
(%make-clock :time time :last-time time :scale scale :paused paused))
|
|
|
|
(defun update-clock (clock &optional delta-time)
|
|
"Update clock using `sec' and `usec' values passed as parameter."
|
|
(unless (clock-paused clock)
|
|
(setf (clock-last-time clock) (clock-time clock))
|
|
(setf (clock-time clock) (* (or delta-time (get-delta-time)) (clock-scale clock)))))
|
|
|
|
(defun clock-delta (clock)
|
|
(- (clock-time clock) (clock-last-time clock)))
|
|
|
|
(defun compare-clocks (clock1 clock2)
|
|
"Return the difference between `clock1' and `clock2'."
|
|
(- (clock-time clock1) (clock-time clock2)))
|