;;;
;;; Margaret M. Fleck and Daniel E. Stevenson
;;; Copyright 1997
;;;

;;; This file contains a simple system for helping the
;;;   user manage his sheet storage:  get descriptions of
;;;   what he has allocated and selectively deallocate disused 
;;;   sheets.

;;; When we have better display utilities, one might extend this
;;;   to allow the user to display each sheet (e.g. image planes)
;;;   on a window.

;;; =================================================
;;; Managing storage
;;; =================================================

;;; Describe all the storage groups I have allocated
(define (describe-my-storage)
   (let ((storage-groups (list-storage-groups)))
      (for-each (lambda (group)
		  (describe-sheet (storage-group-representative group)))
          storage-groups)))


;;; Flush them all
(define (clear-all-storage)
   (let ((storage-groups (list-storage-groups)))
      (for-each (lambda (group)
                  (remove-sheet (storage-group-representative group)))
          storage-groups)))

;;; Ask me one by one, which ones to flush
(define (query-clear-storage)
   (let ((storage-groups (list-storage-groups)))
      (for-each (lambda (group)
		  (describe-sheet (storage-group-representative group))
		  (if (y-or-n? "Remove this group?")
		      (remove-sheet (storage-group-representative group))))
          storage-groups)))
   

;;; ================================================================
;;; Describe individual storage groups
;;; ================================================================

;;; Literate description of domain or codomain
;;;   (auxiliary function for describe-sheet, below)
(define (describe-a-space ctns? descriptor)
  (let* ((bounds (cddr descriptor))
	 (dimension (length bounds)))
    (format #f "~a ~s ~s with precision ~s and bounds ~s"
	    (cond ((= 1 dimension) "1D")
		  ((= 2 dimension) "2D")
		  ((= 3 dimension) "3D")
		  (#t "broken"))
	    (car descriptor)
	    (cond (ctns? 'manifold)
		  (#t 'grid))
	    (cadr descriptor)
	    bounds)))


;;; Literate description of a sheet
(define (describe-sheet sheet)
        (format #t "Sheet labelled ~s~%" (sheet-label sheet)) 
        (format #t "   from a ~a~%" 
		(describe-a-space 
		 (manifold? sheet)
		 (sheet-domain sheet)))
        (format #t "   to a ~a~%" 
		(describe-a-space
		 (not (integer-grid? sheet)) 
		 (sheet-codomain sheet))))