(in-package :clim-user)

;; We want to test drawing to different mediums with different
;; MEDIUM-FOREGROUNDs. To do that we need a second medium and a pixmap
;; is nice for that. However, COPY-FROM-PIXMAP is not recorded, and
;; perhaps also isn't supposed to be recorded. Define a quick output
;; record class, so that we could actually draw to the medium with
;; recordin off.

(defclass some-output-record (standard-sequence-output-record)
  ((fun :initarg :fun)
   (bbox :initarg :bbox)))

(defmethod replay-output-record ((record some-output-record) stream &optional region (x-offset 0) (y-offset 0))
  (declare (ignore region))
  (with-translation (stream x-offset y-offset)
    (funcall (slot-value record 'fun) stream)))

(defmethod bounding-rectangle* ((record some-output-record))
  (values-list (slot-value record 'bbox)))

(defun indirect-ink-test-display (*application-frame* *standard-output*)
  (draw-rectangle* *standard-output* 20 20 40 40 :ink +foreground-ink+)
  (let ((record
         (make-instance
          'some-output-record
          :bbox '(0 0 100 100)
          :fun (lambda (stream)
                 (let ((pixmap
                        (with-output-to-pixmap (pixmap *standard-output* :width 100 :height 100)
                          ;; Just in case: clear. Shouldn't be needed, pixmaps should start filled
                          ;; transparent black.
                          (draw-design pixmap (pane-background *standard-output*))
                          (with-drawing-options (pixmap :foreground +black+ :ink +foreground-ink+)
                            (with-drawing-options (stream :foreground +yellow+)
                              (medium-draw-rectangle* pixmap 20 20 40 40 t)))
                          (setf (medium-foreground pixmap) +green+)
                          (draw-rectangle* pixmap 60 60 80 80 :ink +foreground-ink+))))
                   (copy-from-pixmap pixmap 0 0 100 100 stream 60 60)
                   (deallocate-pixmap pixmap))))))
    (add-output-record record (stream-current-output-record *standard-output*))
    (replay-output-record record *standard-output* +everywhere+ 0 0)
    (setf (stream-cursor-position *standard-output*) (values 0 200))
    (format t "From left to right: ~S, +BLACK+, +GREEN+" (pane-foreground *standard-output*))))

(define-application-frame indirect-ink-test ()
    ((pixmap :initform nil))
  (:panes
   (foo :application
        :foreground +red+
        :display-function 'indirect-ink-test-display
        :display-time :command-loop)
   (bar :application
        :foreground +blue+
        :display-function 'indirect-ink-test-display
        :display-time :command-loop))
  (:layouts
   (default
       (vertically () foo bar))))

(defun run ()
  (find-application-frame 'indirect-ink-test))