;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; This file is part of "NOVA":  NOVA = search + COCOMO tools
; Copyright, 2008, Tim Menzies tim@menzies.us
;
; NOVA is free software: you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation, either version 3 of the License, or
; (at your option) any later version.
;
; NOVA is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU General Public License for more details.
; You should have received a copy of the GNU General Public License
; a long with NOVA.  If not, see <http://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :wvu-lib.tricks)

(defparameter *white-space*
  '(#\Space #\Newline #\Tab #\Linefeed #\Backspace #\Page #\Return #\Rubout)
  "list of characters that are considered white space")

(defun string-trim-whitespace (str)
  (string-trim *white-space* str))

;;; misc stuff

(defun numlimit (num lower upper)
  (cond ((< num lower) lower)
        ((> num upper) upper)
        (t num)))

;;TODO needs cleaned up
(defun date-stamp (&key (time (get-universal-time)) (format '(yyyy mm dd)) (seperator "-"))
  (multiple-value-bind
        (second minute hour day month year day-of-the-week)
      (decode-universal-time time)
    (let ((format-pattern-list nil) ;format patterns list
          (value-list nil)) ;values list
      (macrolet ((add-fp-v (fp v) `(progn (push ,fp format-pattern-list) (push ,v  value-list))))
        (dolist (fsym format)
          (ecase (intern (string-upcase fsym) (find-package :wvu-lib.tricks))
            ;;date
            (yyyy (add-fp-v "~4,'0d" year))
            (yy   (add-fp-v "~2,'0d" (mod year 100)))
            (mm   (add-fp-v "~2,'0d" month))
            (m    (add-fp-v "~d" month))
            (dd   (add-fp-v "~2,'0d" day))
            (d    (add-fp-v "~d" day))
            (dow  (add-fp-v "~d" day-of-the-week))
            ;;time
            (hh   (add-fp-v "~2,'0d" hour))
            (h    (add-fp-v "~d" hour))
            (mmi  (add-fp-v "~2,'0d" minute))
            (mi   (add-fp-v "~d" minute))
            (ss   (add-fp-v "~2,'0d" second))
            (s    (add-fp-v "~d" second))))
        (let* ((format-string (apply #'concatenate 'string (insert-delim (nreverse format-pattern-list) seperator)))
               (looping-format-string (concatenate 'string "~{" format-string "~}"))
               (values (nreverse value-list)))
          (format nil looping-format-string values))))))

(defun noop (&rest arguments)
  "do nothing"
  (declare (ignore arguments))
  (values))


(defun my-getenv (name &optional default)
  "Returns a variable value from the environment outside of Lisp."
  #+CMU
  (let ((x (assoc name ext:*environment-list* :test #'string=)))
    (if x (cdr x) default))
  #-CMU
  (or #+Allegro   (sys:getenv name)
      #+CLISP     (ext:getenv name)
      #+ECL       (si:getenv name)
      #+LISPWORKS (lispworks:environment-variable name)
      #+SBCL      (sb-unix::posix-getenv name)
      default))

(defun euclidean (&rest coordinates)
  "Returns the distance of a point in n-dimensional space from the origin."
  (let ((sum-sq 0))
    (dolist (x coordinates (sqrt sum-sq))
      (incf sum-sq (* x x)))))

(defun chars (n &optional (c "*") (str t str-p))
  "Prints a string of n identical characters to the given stream."
  (dotimes (i n) (princ c (when str-p str))))


(defun sym-prim (l)
  (when l
    (intern (format nil "~a~{-~a~}" (car l) (cdr l)))))

(defmacro sym (&rest args) `(sym-prim ',args))

(defun precision-digits (num)
  "FIXME: DOESN'T WORK"
  (declare (number num))
  (let* ((as-str (string-right-trim "0d" (format nil "~a" (coerce num 'double-float))))
         (point-pos (search "." as-str)))
    (if point-pos
        (length (subseq as-str (1+ point-pos)))
        0)))

(defun expand-range (min-val max-val &optional (interval 1.0) (decimals 0 decimals-p))
  "Returns a list starting from min-val and increasing by interval.
List may or may not contain max-val based on interval.
Values returned will be round to 'decimal' number of decimals"
  (unless (< min-val max-val)
    (error "~%min-val must be less than max-val"))
  (let* ((effective-decimals decimals )
         (precision
          (cond ((<= effective-decimals (precision-digits single-float-epsilon))
                 'single-float)
                ((<= effective-decimals (precision-digits double-float-epsilon))
                 'double-float)
                (t (error "can't be precise to that many decimals: ~a" decimals))))
         (scale-factor (expt 10 effective-decimals)))
    (labels ((scale-up (x) (* x scale-factor))
             (scale-down (x) (coerce (/ (floor x) scale-factor) precision)))
      (let (range
            (smin-val (scale-up min-val))
            (smax-val (scale-up max-val))
            (sinterval (scale-up interval)))
        (do ((i 1 (1+ i))
             (x smin-val (+ smin-val (* i sinterval))))
            ((> x smax-val)
             (nreverse (mapcar #'scale-down range)))
          (push x range))))))

(defmacro unless-timeout (timeout &body body)
  (let ((timeout-var (gensym "TIMEOUT")))
    `(let ((,timeout-var ,timeout))
       (handler-case
           (sb-ext:with-timeout ,timeout-var
             ,@body)
         (sb-ext:timeout ()
           nil)))))