(in-package 'obvius)

#|
THE BUG:

When you call set-not-current on (eg) an image, it calls
set-not-current on its gray pictures, which calls
reinitialize-instance to reset the default scale and pedestal,
which computes the min and max of the image.  But this shouldn't
happen until display time.  Not only does it make the code
NOTICEABLY SLOWER, it introduces bugs.

Consider calling fft on an image, putting the result into an
existing image-pair that is currently displayed.  It calls zero!
on result, which will call set-not-current on the result
sub-images, and recompute min and max.  Then you modify the
sub-images (using array-fft) and return the result.  The
with-result macro will call set-not-current on the result
image-pair, but not on the sub-images.  If you then ask for, say,
(minimum (real-part result)) you get junk:

(load-image "/v/images/einstein")
(setq foo (make-complex-image (dimensions einstein)))
(fft einstein :-> foo)
(range (real-part foo))			;incorrect values returned here.
(set-not-current (real-part foo))
(range (real-part foo))

SOLUTIONS CONSIDERED:
1) have set-not-current on sequences call itself on sub-viewables
[ No good -- infinite loops! and incorrect conceptually ]

2) have set-result on sequences do this [ No good -- it is called
at the BEGINNING of the function and thus will compute the min/max then]

3) Make sure all methods on compound viewables call set-not-current
on sub-viewables before returning the result.  [ This is gross, and will
certainly cause problems for us later ]

4) set-not-current on gray shouldn't actually cause recompution.  It
should mark the slots for re-computation at display time  (eg, add a
slot called reinit-args, and call reinitialize-instance on the contents
of this slot at display time).  This solution is given below.  

-- EPS
|#
;;;; NEW CODE:

;;;; In picture.lisp:
;;; Add new slot reinit-args
(def-simple-class picture ()
  (viewable
   system-dependent-frob
   pane-of
   (current :initform nil)
   (reinit-args :initform nil)
   (index :initform (incf *picture-index*))
   (zoom :initform 1 :type (or number (eql :auto) cons)
	 :documentation "Enlargement factor, relative to the `natural' size of the
picture.  This can be set to :auto (zoom to size of pane), or a pair of numbers
 (zoom to those dimensions, in pixels)")
   (x-offset :initform 0 :type integer)
   (y-offset :initform 0 :type integer)))

;;; *** Should set reinit-args here, instead of calling
;;; reinitialize-instance, but doing this breaks overlays.
(defmethod initialize-instance :around ((pic picture)
					&rest initargs
					&key viewable pane-of)
  (unless viewable (error "Must provide a :viewable argument when creating a picture"))
  (unless pane-of  (error "Must provide a :pane-of argument when creating a picture"))
  (call-next-method pic :viewable viewable :pane-of pane-of) ;fill initform slots
  ;; *** SHould this be here:
  (remf initargs 'clos::initargs-validated)
  (remf initargs :viewable) (remf initargs :pane-of)
  ;;(setf (reinit-args pic) initargs)	;these to be reinitialized at display time
  (apply #'reinitialize-instance pic initargs)
  )

;;; If there are reinit-args, call reinitialize-instance on them
(defmethod compute-picture :around (pic vbl)
  (declare (ignore vbl))
  (with-slots (reinit-args) pic
    (when reinit-args
      (apply #'reinitialize-instance pic reinit-args)
      (setf reinit-args nil))
    (call-next-method)))

;;; Minor change: make this return nil
(defmethod set-not-current ((pic picture))
  (when (eq pic (car (picture-stack (pane-of pic))))
    (set-pane-title-bar (pane-of pic) 
			(format nil "**-~S" (name (viewable pic)))))
   nil)


;;;; gray.lisp: set reinit-args instead of calling reinitialize-instance
(defmethod set-not-current ((pic gray))
  (with-slots (reinit-args) pic
    (setf (getf reinit-args :scale) (get-default 'gray 'scale))
    (setf (getf reinit-args :pedestal) (get-default 'gray 'pedestal))
    (call-next-method)))

;;;; drawing.lisp: set reinit-args instead of calling reinitialize-instance
(defmethod set-not-current ((pic graph))
  (with-slots (reinit-args) pic
    (setf (getf reinit-args :y-range) (get-default 'graph 'y-range))
    (call-next-method)))