;;; -*- Mode: Lisp; Package: DESIGN; Syntax: Ansi-common-lisp -*-

(defun noop (&rest x)
  x)

(defun flatten (list)
  (let ((result nil))
    (labels ((flatten-1 (elt)
	       (if (listp elt)
		   (dolist (sub-elt elt) (flatten-1 sub-elt))
		   (unless (member elt result)
		     (push elt result)))))
      (flatten-1 list)
      result)))

(defun push-onto-end (thing list &aux (copy (copy-list list)))
  ;; not destructive
  (do ((list copy (cdr list)))
      ((null (cdr list)) (setf (cdr list) `(,thing)) copy))
  list)

(defun push-onto-end* (thing list)
  ;; destructive
  (when list
    (setf (cdr (last list)) `(,thing)))
  list)

(defun set-equal (list1 list2)
  (and (null (set-difference list1 list2))
       (null (set-difference list2 list1))))

(defvar *small-font-for-describe* '(nil nil :tiny))

(defun small-string (string)
  ;; loses [ ]
  (with-output-to-string (str)
    (scl:with-character-style (*small-font-for-describe* str)
      (format str "~a" string))))

(defun apply-to-cross-product (function set-of-sets)
  (labels ((a-t-c-p (c-p-so-far remaining-sets)
	     (if remaining-sets
		 (let ((set (first remaining-sets))
		       (remaining-sets (rest remaining-sets))
		       (last-cons (when c-p-so-far (last c-p-so-far))))
		   (scl:stack-let ((new-cons (cons nil nil)))
		     (if last-cons
			 (setf (cdr last-cons) new-cons)
			 (setq c-p-so-far new-cons))
		     (dolist (new-elt set)
		       (setf (car new-cons) new-elt)
		       (a-t-c-p c-p-so-far remaining-sets))
		     (if last-cons
			 (setf (cdr last-cons) nil))))
		 (funcall function c-p-so-far))))
    (a-t-c-p nil set-of-sets)))

(defun design-symbol (symbol)
  (intern (string symbol) 'design))

(defun keyword-symbol (symbol)
  (intern (string symbol) 'keyword))

(defun dehyphenate (string)
  (substitute #\space #\- string))


(defun remove-item (plist item)
  ;; this won't work for values that can look like items
  (do* ((plist (copy-list plist))
	(previous nil current)
	(current plist (cddr current)))
       ((null current) plist)
    (when (eq item (car current))
      (if previous (setf (cddr previous) (cddr current)) (setq plist (cddr plist)))
      (return plist))))

(defun avg (x y)
  (/ (+ x y) 2.0))

(defun avg+ (x &rest numbers)
  (/ (apply #'+ x numbers) (1+ (length numbers))))

(defun avg-list (numbers)
  (/ (apply #'+ numbers) (1+ (length numbers))))


(defun mapappend (fcn list)
  (remove-duplicates (loop for x in list
			   append (funcall fcn x))))

(defun mapappend+ (fcn list)
   (loop for x in list
	 append (funcall fcn x)))

(defun compress-list (list)
  (loop for x in list
	    with new-list
	    unless (eq x (car new-list))
	      do (push x new-list)
	    finally (return (reverse new-list))))


(defun show-2d-array (a)
  (terpri)
  (loop for i from 0 to (1- (array-dimension a 0))
	do (loop for j from 0 to (1- (array-dimension a 1))
		 do (format t "~a " (aref a i j))
		 finally (terpri))))

(defun position* (item sequence)
  ;; find item that may be in a list in the sequence
  (loop for x in sequence
	when (or (eql item x)
		 (and (listp x) (member item x)))
	 do (return (position x sequence))))