;;;; This file is part of P36-lib
;;;; Copyright (C) 2016-2021 Alexa Jones-Gonzales <alexa@partition36.com>
;;;;
;;;; This program 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.
;;;;
;;;; This program 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
;;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(in-package :p36-lib/time)
(defgeneric ts-seconds (ts))
(defgeneric ts-minutes (ts))
(defgeneric ts-hours (ts))
(defgeneric ts-days (ts))
(defgeneric (setf ts-seconds) (new-value ts))
(defgeneric (setf ts-minutes) (new-value ts))
(defgeneric (setf ts-hours) (new-value ts))
(defgeneric (setf ts-days) (new-value ts))
(defgeneric ts+ (ts1 ts2))
(defgeneric ts- (ts1 ts2))
(defstruct (timespan (:conc-name %ts-)
(:constructor %make-timespan))
(seconds 0 :type integer)
(minutes 0 :type integer)
(hours 0 :type integer)
(days 0 :type integer))
;;;
;;; Constructors
;;;
(defun make-timespan (&key (days 0) (hours 0) (minutes 0) (seconds 0))
(declare (type integer days hours minutes seconds))
(assert (typep seconds '(integer 0 59)) (seconds) "Seconds must be between 0 and 59, inclusive.")
(assert (typep minutes '(integer 0 59)) (minutes) "Minutes must be between 0 and 59, inclusive.")
(assert (typep hours '(integer 0 23)) (hours) "Hours must be between 0 and 23, inclusive.")
(%make-timespan :seconds seconds :minutes minutes :hours hours :days days))
(defun make-timespan-from-total-seconds (value)
(declare (type integer value))
(let* ((secs (mod value 60))
(tot-mins (floor (/ value 60)))
(mins (mod tot-mins 60))
(tot-hours (floor (/ tot-mins 60)))
(hours (mod tot-hours 24))
(days (floor (/ tot-hours 24))))
(%make-timespan :days days :hours hours :minutes mins :seconds secs)))
;;;
;;; Accessors
;;;
(defmethod ts-seconds ((ts timespan))
(%ts-seconds ts))
(defmethod ts-minutes ((ts timespan))
(%ts-minutes ts))
(defmethod ts-hours ((ts timespan))
(%ts-hours ts))
(defmethod ts-days ((ts timespan))
(%ts-days ts))
(defmethod (setf ts-seconds) ((new-value integer) (ts timespan))
(assert (typep new-value '(integer 0 59)) (new-value) "Seconds must be between 0 and 59, inclusive.")
(setf (%ts-seconds ts) new-value))
(defmethod (setf ts-minutes) ((new-value integer) (ts timespan))
(assert (typep new-value '(integer 0 59)) (new-value) "Minutes must be between 0 and 59, inclusive.")
(setf (%ts-minutes ts) new-value))
(defmethod (setf ts-hours) ((new-value integer) (ts timespan))
(assert (typep new-value '(integer 0 23)) (new-value) "Hours must be between 0 and 23, inclusive.")
(setf (%ts-hours ts) new-value))
(defmethod (setf ts-days) ((new-value integer) (ts timespan))
(setf (%ts-days ts) new-value))
;;;
;;; Utility Functions
;;;
(defun ts-total-seconds (span)
"Returns the total number of seconds represented by SPAN."
(declare (type timespan span))
(+ (ts-seconds span)
(* (ts-minutes span) 60)
(* (ts-hours span) (* 60 60))
(* (ts-days span) (* 60 60 24))))
(defun ts-total-minutes (span)
"Returns the total number of whole minutes represented by SPAN. The number of
seconds in SPAN is ignored."
(declare (type timespan span))
(+ (* (ts-minutes span) 60)
(* (ts-hours span) (* 60 60))
(* (ts-days span) (* 60 60 24))))
(defun ts-total-hours (span)
"Returns the total number of whole hours represented by SPAN. The number of
seconds and minutes in SPAN is ignored."
(declare (type timespan span))
(+ (* (ts-hours span) (* 60 60))
(* (ts-days span) (* 60 60 24))))
;;;
;;; Comparison and Addition/Subtraction Functions
;;;
(defmethod ts+ ((span1 timespan) (span2 timespan))
"Adds the span of time in SPAN2 to SPAN1, returning a new TIMESPAN instance."
(let ((span1-secs (ts-total-seconds span1))
(span2-secs (ts-total-seconds span2)))
(make-timespan-from-total-seconds (+ span1-secs span2-secs))))
(defmethod ts- ((span1 timespan) (span2 timespan))
"Subtracts the span of time in SPAN2 from SPAN1, returning a new TIMESPAN
instance."
(let ((span1-secs (ts-total-seconds span1))
(span2-secs (ts-total-seconds span2)))
(make-timespan-from-total-seconds (- span1-secs span2-secs))))
(defmethod ts+ ((span timespan) (amount integer))
"Adds AMOUNT seconds to SPAN, returning a new TIMESPAN instance."
(setf span (make-timespan-from-total-seconds (+ (ts-total-seconds span) amount))))
(defmethod ts- ((span timespan) (amount integer))
"Subtracts AMOUNT seconds to SPAN, returning a new TIMESPAN instance."
(setf span (make-timespan-from-total-seconds (- (ts-total-seconds span) amount))))
(defun ts+/minutes (span value)
"Adds VALUE minutes to SPAN, returning a new TIMESPAN instance."
(make-timespan-from-total-seconds (+ (ts-total-seconds span) (* value 60))))
(defun ts+/hours (span value)
"Adds VALUE hours to SPAN, returning a new TIMESPAN instance."
(make-timespan-from-total-seconds (+ (ts-total-seconds span) (* value 60 60))))
(defun ts+/days (span value)
"Adds VALUE days to SPAN, returning a new TIMESPAN instance."
(make-timespan-from-total-seconds (+ (ts-total-seconds span) (* value 24 60 60))))
(defun ts-/minutes (span value)
"Subtracts VALUE minutes from SPAN, returning a new TIMESPAN instance."
(make-timespan-from-total-seconds (- (ts-total-seconds span) (* value 60))))
(defun ts-/hours (span value)
"Subtracts VALUE hours from SPAN, returning a new TIMESPAN instance."
(make-timespan-from-total-seconds (- (ts-total-seconds span) (* value 60 60))))
(defun ts-/days (span value)
"Subtracts VALUE days from SPAN, returning a new TIMESPAN instance."
(make-timespan-from-total-seconds (- (ts-total-seconds span) (* value 24 60 60))))
(defun ts= (ts1 ts2)
"Returns T if TS1 and TS2 both represent the same span of time, or NIL
otherwise."
(declare (type timespan ts1 ts2))
(= (ts-total-seconds ts1)
(ts-total-seconds ts2)))
(defun ts< (ts1 ts2)
"Returns T if TS1 represents a strictly smaller amount of time than TS2, or
NIL otherwise."
(declare (type timespan ts1 ts2))
(< (ts-total-seconds ts1)
(ts-total-seconds ts2)))
(defun ts<= (ts1 ts2)
"Returns T if TS1 represents a smaller or equal amount of time than TS2, or
NIL otherwise."
(declare (type timespan ts1 ts2))
(< (ts-total-seconds ts1)
(ts-total-seconds ts2)))
(defun ts> (ts1 ts2)
"Returns T if TS1 represents a strictly larger amount of time than TS2, or NIL
otherwise."
(declare (type timespan ts1 ts2))
(> (ts-total-seconds ts1)
(ts-total-seconds ts2)))
(defun ts>= (ts1 ts2)
"Returns T if TS1 represents a larger or equal amount of time than TS2, or NIL
otherwise."
(declare (type timespan ts1 ts2))
(> (ts-total-seconds ts1)
(ts-total-seconds ts2)))