;;; -*- Mode:LISP; Package:USER; Base:10; Readtable:ZL -*-

(defvar *box-window-list* nil "List of created box networks.")

(defconst *box-mode-item-alist* :unbound)

(defconst *box-frame-configuration-alist*
	  '((box-test-window
	      (tblack control-panes mblack display-panes)
	      ((tblack :blank :black 0.02))
	      ((control-panes :horizontal
			    (0.08s0)
			    (hblack1 box-banner hblack2 box-commands hblack3)
			    ((hblack1 :blank :black 0.05s0))
			    ((box-banner 0.1s0))
			    ((hblack2 :blank :black 0.05))
			    ((box-commands 0.8s0))
			    ((hblack3 :blank :black :even)))
	       )
	      ((mblack :blank :black 0.02s0))
	      ((display-panes :horizontal
			    (:even)
			    (aux-displays box-network-display)
			    ((aux-displays :vertical
					   (:even)
					   (box-text-area box-scroll-area)
					   ((box-text-area 0.5s0))
					   ((box-scroll-area :even)))
			     (box-network-display :even)))
	       ))))

(defconstant *box-default-mode* :main)

;;; Main window definition
;;;
;;;

(defflavor box-network-frame
	 (commands banner text-area)
	   (tv:process-mixin
	    tv:alias-for-inferiors-mixin
	    tv:inferiors-not-in-select-menu-mixin
	    tv:bordered-constraint-frame-with-shared-io-buffer
	    tv:top-box-label-mixin)
  (:default-init-plist
    :process '(box-start)
    :borders 1
    :label '(:string "Setting up Box Network..." :font fonts:metsi :centered)
    :panes
    '(
      ;;; Main command menu
      (box-commands simple-menu-pane
		    :label (:string "Box Commands" :font fonts:hl12i :centered :top)
		    :save-bits t
		    :mode-item :main)
      ;;; Program Banner 
      (box-banner simple-banner-pane
		  :label (:string "Box Mode" :centered))
      ;;; Box drawing area
      (box-network-display simple-text-area
			   :label "Box Network Display")
      ;;; Box global view
      (box-scroll-area simple-scroll-area
 			:label (:string "Box Items"))
      ;;; Accompanying text
      (box-text-area simple-text-area
		     :label (:string "Messages and Queries")))
    :constraints *box-frame-configuration-alist*)
 :gettable-instance-variables
 :settable-instance-variables
 :inittable-instance-variables)

(defmethod (box-network-frame :after :init) (&rest ignore)
  (send self :set-selection-substitute
	(send self :get-pane 'box-text-area))
  (send self :set-label
	'(:string "Experimental Box Network"
	   :font fonts:metsi :centered))
  (setq commands (send self :get-pane 'box-commands))
  (setq banner   (send self :get-pane 'box-banner))
  (send banner :draw-banner (send commands :mode-item))
  (setq text-area (send self :get-pane 'box-text-area))
  (push self *box-window-list*))

(defmethod (box-network-frame :before :expose) (&rest ignore)
    (send commands :update-mode-item-alist *box-mode-item-alist*)
    (send commands :update-item-list))

;(defmethod (box-network-frame :after :expose) (&rest ignore)
;  (let((banner (send self :get-pane 'box-banner))
;       (comms  (send self :get-pane 'box-commands)))
;    (send banner :string-out-centered-explicit (send comms :mode-item))))

(defmethod (box-network-frame :after :kill) (&rest ignore)
  (setq *box-window-list*
	(loop for wind in *box-window-list*
	      when (not (equal wind self))
	      collect wind)))

(defmethod (box-network-frame :set-mode) (&optional new-mode)
  (setq new-mode (or new-mode *box-default-mode*))
  (send commands :set-mode new-mode)
  (send banner :draw-banner new-mode))

(defmethod (box-network-frame :big-message) (message)
  (let*((fontmap (send text-area :font-map)))
    (send text-area :set-font-map '(medfnb))
    (format text-area "~&~a~2&" message)
    (send text-area :set-font-map fontmap)))

(compile-flavor-methods box-network-frame)

;;;

(defmacro with-network-panes(box-window &body body)
  `(let*((window ,box-window)
	 (banner (send window :get-pane 'box-banner))
	 (commands (send window :get-pane 'box-commands))
	 (text-area (send window :get-pane 'box-text-area)))
     (declare(special window banner commands text-area))
     (list window banner commands text-area)
     . ,body))