;; a tabbed-radio-layout-pane using presentations
;;
;; date: Sat, 17 Sep 2005 23:52:15 +0200
;; Max-Gerd Retzlaff <m.retzlaff@gmx.net>

(in-package :clim-user)

(defclass tabbed-layout-pane (vrack-pane)
  ((tab-name-to-pane-alist :initform nil :accessor tab-name-to-pane-alist :initarg :tab-name-to-pane-alist)
   (radio-layout-pane :initform nil :accessor radio-layout-pane-of-tabbed-layout :initarg :radio-layout-pane)))

(defclass tabbed-pane ()
  ((name :initform nil :accessor tabbed-pane-name :initarg :name)
   (pane :initform nil :accessor tabbed-pane-pane :initarg :pane)))

;; (define-presentation-type tabbed-pane ())

(define-command (com-switch-to-tab :command-table clim:global-command-table)
    ((tabbed-pane 'tabbed-pane :prompt "Tabbed pane"))
  (let ((pane (tabbed-pane-pane tabbed-pane)))
    (switch-to-pane pane (sheet-parent pane))))

;; a test command
(define-command (com-narf :command-table clim:global-command-table)
    ((pane 'pane :prompt "Tabbed pane"))
  (print (pane-name pane))
  (break))

(define-presentation-to-command-translator switch-via-tab-button
    (tabbed-pane com-switch-to-tab clim:global-command-table
                 :gesture :select
                 :documentation "Switch to this pane")
    (object)
  (list object))

(defclass tab-bar-view (gadget-view)
  ())

(defparameter +tab-bar-view+ (make-instance 'tab-bar-view))

(define-presentation-method present (tabbed-pane (type tabbed-pane) stream
                                                (view tab-bar-view) &key)
  (stream-increment-cursor-position stream 5 0)
  (multiple-value-bind (x y) (stream-cursor-position stream)
    (let* ((length-top-line (+ x 6 (text-size stream (tabbed-pane-name tabbed-pane)) 3))
           (tab-button-polygon (list x (+ y 14)   (+ x 6) y
                                    (+ x 6) y   length-top-line y
                                    length-top-line y   (+ length-top-line 6) (+ y 14))))
      
      ;; grey-filled polygone for the disabled panes
      (unless (sheet-enabled-p (tabbed-pane-pane tabbed-pane))
        (draw-polygon* stream tab-button-polygon :ink +grey+))
      
      ;; black non-filled polygon
      (draw-polygon* stream tab-button-polygon  :filled nil)
      
      ;; "breach" the underline for the enabled pane
      (when (sheet-enabled-p (tabbed-pane-pane tabbed-pane))
        ;; (draw-line* stream x (+ y 14) (+ length-top-line 6) (+ y 14) :ink +white+)
        (draw-line stream (apply #'make-point (subseq tab-button-polygon 0 2))
                          (apply #'make-point (subseq tab-button-polygon (- (length tab-button-polygon) 2)))
                          :ink +background-ink+))))
  
  (stream-increment-cursor-position stream 8 0)
  (write-string (tabbed-pane-name tabbed-pane) stream)
  (stream-increment-cursor-position stream 10 0))


(defmacro with-tabbed-layout ((default-ptype &key id)
                              &body body)
  (let* ((radio-layout-pane (gensym "radio-layout-pane-"))
         (tabbed-layout-id-gensym (gensym "tabbed-layout-"))
         (tabbed-layout-id (or id tabbed-layout-id-gensym)))
    `(let ((,radio-layout-pane (make-pane 'radio-layout-pane
                                          :contents (list ,@(mapcar #'second body)))))
       (make-pane 'tabbed-layout-pane
                  :id ',tabbed-layout-id
                  :tab-name-to-pane-alist (list ,@(mapcar (lambda (list)
                                                            `(list ,@list)) ;; evaluate list elements
                                                          body))
                  :radio-layout-pane ,radio-layout-pane
                  :contents (list (make-clim-stream-pane
                                   :default-view +tab-bar-view+
                                   :display-time :command-loop
                                   :scroll-bars nil
                                   :borders nil
                                   :height 22
                                   :display-function
                                   (lambda (frame pane)
                                     (declare (ignore frame))
                                     (stream-increment-cursor-position pane 0 3)
                                     (draw-line* pane 0 17 (slot-value pane 'climi::current-width) 17)
                                     ,@(mapcar (lambda (tab-spec)
                                                 `(destructuring-bind (name tabbed-pane &optional ptype)
                                                      (list ,@tab-spec) ;; evaluate list elements
                                                    (with-output-as-presentation (pane tabbed-pane (or ptype ',default-ptype))
                                                      (present (make-instance 'tabbed-pane
                                                                              :name name
                                                                              :pane tabbed-pane)
                                                               'tabbed-pane :stream pane))))
                                               body)))
                                  `(+fill+ ,,radio-layout-pane))))))

;;; example code

(define-application-frame ozo ()
  ()
  (:panes
   (editor :text-editor :value "Text Editor")
   (foo :text-editor :value "Foo")
   (bar (make-pane 'push-button :label "Bar" :name "bar pane"))
   (baz (make-pane 'push-button :label "Baz"))
   (io :interactor :height 20))
  (:layouts
   (default
      (vertically ()
        (with-tabbed-layout (pane)
           ("Text Editor" editor)
           ("foo pane" foo 'integer)
           ("bar pane" bar)
           ("baz pane" baz))
        io))))

(defun ozo ()
  (run-frame-top-level (make-application-frame 'ozo)))