;;; -*- Mode: LISP; Syntax: Common-lisp; Package: LOOM; Base: 10. -*-

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;                                                                             ;
;  Copyright (c) 1988, 1995, 1999 by the University of Southern California    ;
;  All rights reserved.                                                       ;
;                                                                             ;
;  Permission to use, copy, modify, and distribute this software and its      ;
;  documentation in source and binary forms for non-commercial purposes       ;
;  and without fee is hereby granted, provided that this notice               ;
;  be reproduced in any copy or modification thereof, and that                ;
;  any documentation, advertising materials, and other materials related      ;
;  to such distribution and use acknowledge that the software was             ;
;  developed by the University of Southern California, Information            ;
;  Sciences Institute.  The name of the University may not be used to         ;
;  endorse or promote products derived from this software without             ;
;  specific prior written permission.                                         ;
;                                                                             ;
;  THE UNIVERSITY OF SOUTHERN CALIFORNIA MAKES NO REPRESENTATIONS ABOUT THE   ;
;  SUITABILITY OF THIS SOFTWARE FOR ANY PURPOSE.  THIS SOFTWARE IS PROVIDED   ;
;  "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING,          ;
;  WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND          ;
;  FITNESS FOR A PARTICULAR PURPOSE.                                          ;
;                                                                             ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; TIME-SUPPORT.LISP (ABOX)

(in-package "LOOM")

(export '(TIME-P TIME= TIME< TIME> TIME<= TIME>=
	  TIME-MAX TIME-MIN TIME-ADD TIME-SUB))


  ;;
;;;;;; General Time Interface for non-temporal routines.
  ;;

(defmethod add-time-value (instance slotType value change worldTime)
  (declare (ignore slotType value change worldTime))
  (grumble "Can't make a temporal assertion about instance ~A.~%~
Maybe you need the INSTANCE-WITH-TIME mixin?" instance) )

(defmethod delete-time-value (instance slotType value change worldTime)
  (declare (ignore slotType value change worldTime))
  (grumble "Can't make a temporal assertion about instance ~A.~%~
Maybe you need the INSTANCE-WITH-TIME mixin?" instance) )

  ;;
;;;;;; General Time functions
  ;;

(defun time-p (x)
  (or (numberp x)
      (member x '(INFINITY -INFINITY))))

  ;;
;;;;;; Time comparison functions
  ;;

(defun time= (x y) (eql x y))

(defun time< (x y)
  (cond ((and (numberp y) (numberp x)) (< x y))
	((eql x y) nil)
	((eq x '-INFINITY) t)
	((eq y '+INFINITY)  t)
	((eq x '+INFINITY) nil)
	((eq y '-INFINITY) nil)) )

(defun time> (x y)
  (cond ((and (numberp y) (numberp x)) (> x y))
	((eql x y) nil)
	((eq x '-INFINITY) nil)
	((eq y '+INFINITY) nil)
	((eq x '+INFINITY) t)
	((eq y '-INFINITY) t)) )

(defun time<= (x y)
  (declare (inline time<))
  (or (eql x y)
      (time< x y)) )

(defun time>= (x y)
  (declare (inline time>))
  (or (eql x y)
      (time> x y)) )

(defun time-max (x y)
  (declare (inline time>))
  (if (time> x y) x y))

(defun time-min (x y)
  (declare (inline time<))
  (if (time< x y) x y))

  ;;
;;;;;; Time arithmetic
  ;;

(defun time-sub (x y)
  (cond ((and (numberp x) (numberp y)) (- x y))
	((eq x '-INFINITY) '-INFINITY)
	((eq x '+INFINITY) '+INFINITY)
	((eq y '-INFINITY) '+INFINITY)
	((eq y '+INFINITY) '-INFINITY)
	(t (- x y))) )

(defun time-add (x y)
  (cond ((and (numberp x) (numberp y)) (- x y))
	((eq x '-INFINITY) '-INFINITY)
	((eq x '+INFINITY) '+INFINITY)
	((eq y '-INFINITY) '-INFINITY)
	((eq y '+INFINITY) '+INFINITY)
	(t (+ x y))) )


;; SHOULD THIS BE IN A MORE GENERAL UTILITY FILE?

  ;;
;;;;;; Multiple Choice CError Signaler & Handlers
  ;;


(defun break-into-lines (string)
  ;; Breaks "string" into a list of lines.  Lines are delimited in the
  ;;   string by either "~%" or #\Return;
  (let ((start 0)
	(end nil)
	(delta nil)
	(length (length string)))
    (loop for tildePercentPosition = (search "~%" (subseq string start))
	  as returnPosition = (position #\Return (subseq string start))
	  do (cond ((and tildePercentPosition returnPosition)
		    (if (< tildePercentPosition returnPosition)
			(setq end tildePercentPosition
			      delta 2)
			(setq end returnPosition
			      delta 1)))
		   (tildePercentPosition
		    (setq end tildePercentPosition
			  delta 2))
		   (returnPosition
		    (setq end returnPosition
			  delta 1))
		   (t (setq end nil)))
	  collect (subseq string start (and end (+ start end)))
	  until (null end)
	  do (incf start (+ end delta))
	  until (>= start length))))

(defun pad-return-characters-in-format-string (string padLength)
  ;; Adds "padLength" space characters after every return (~%) string
  ;;   in "string".  Also handles the #\Return character;
  (format nil (format nil "~~{~~A~~^~~~~%~v@T~~}" padLength) (break-into-lines string)))

(defun multiple-choice-read (choiceList)
  (let ((n (length choiceList))
	(choice nil))
    (loop do (format *debug-io* "~%Choose an item from this list (by number):")
	     (format *debug-io* "~% 0: Enter the Debugger")
	     (loop for i upfrom 1
		   for item in choiceList
		   do (format *debug-io* "~%~2D: " i)
		      (if (consp item)
			  (apply #'format *debug-io*
				 (if (stringp (car item))
				     (pad-return-characters-in-format-string (car item) 4)
				     (car item))
				 (cdr item))
			  (format *debug-io* "~A" (if (stringp item)
						      (pad-return-characters-in-format-string item 4)
						      item))))
	     (format *debug-io* "~%==> ")
	     (setf choice (read *debug-io*))
       until (and (integerp choice) (<= 0 choice n))
	  do (format *debug-io* "~2&~D is not between 0 and ~D.  Pick again."
		     choice n))
    choice))

(defun multiple-choice-cerror (choiceList errorMessage &rest formatArgs)
  (let ((choice 0))
    (loop while (zerop choice)
	  do (format *debug-io* "~%Error: ~?" errorMessage formatArgs)
	     (setf choice (multiple-choice-read choiceList))
	     (when (zerop choice)
	       (apply #'cerror "Choose a repair action from the list of options."
		      errorMessage formatArgs))
	     )
    choice))



