#|
  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)))