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

(defvar *basic-box-flavor* 'box-network-frame)

;Alist of menu item alists; CAR of each alist element is a mode

(setq *box-mode-item-alist*
	'((:main ("Add" :eval (box-add))
		 ("Delete" :eval (box-delete))
		 ("Display" :eval (box-display))
		 ("Modify" :eval (box-modify))
		 ("Quit" :eval (box-quit))
		 ("Redraw" :eval (box-redraw)))
	  (:add ("Copy" :eval (box-add :copy))
		("New" :eval (box-add :new))
		("Return" :eval (box-return))
		("Redraw" :eval (box-redraw)))
	  (:delete ("Select" :eval (box-delete :select))
		   ("Return" :eval (box-return))
		   ("Redraw" :eval (box-redraw)))
	  (:display ("Select" :eval (box-display :select))
		   ("Return" :eval (box-return))
		   ("Redraw" :eval (box-redraw)))
	  (:modify ("Select" :eval (box-modify :select))
		   ("Return" :eval (box-return))
		   ("Redraw" :eval (box-redraw)))
	  ))

(defvar d-window)
(defvar d-comms)
(defvar d-io)
(defvar d-banner)
(defvar box-debug t)

(defun box-top()
  (box-start (make-instance *basic-box-flavor*)))

(defun box-start (window)
  (declare(special window))
  (send window :activate)
  (let* ((comms (send window :get-pane 'box-commands))
	 (query-io (send window :get-pane 'box-text-area))
	 (standard-output query-io)
	 (error-output query-io)
	 (banner (send window :get-pane 'box-banner)))
    (declare(special query-io standard-output error-output))
    (when box-debug
      (setq d-window window)
      (setq d-comms comms)
      (setq d-io query-io)
      (setq d-banner banner))
    (send window :select)
    (send window :expose)
    (send window :big-message "Initialized.")
;;; Listen to for input from the command menu.
    (loop for input = (send query-io ':any-tyi) do
	  (cond ((atom input) (print input))
		((listp input)
		 (selectq (car input)
		   (:menu (send (fourth input)  ':execute (second input)))
		   (t (beep))))
		(t (pprint input query-io)
		   (beep))))))

(defun box-add(&optional new-mode)
  (declare(special window))
  (with-network-panes window
    (print 'adding)
    (case new-mode
      (nil (send window :set-mode :add))
      (:copy (print 'copying))
      (:new (print 'new-one)))))

(defun box-delete(&optional new-mode)
  (declare(special window))
  (with-network-panes window
    (print 'deleting)
    (case new-mode
      (nil (send window :set-mode :delete))
      (:select (print 'selecting)))))

(defun box-display(&optional new-mode)
  (declare(special window))
  (with-network-panes window
    (print 'displaying)
    (case new-mode
      (nil (send window :set-mode :display))
      (:select (print 'selecting)))))

(defun box-modify(&optional new-mode)
  (declare(special window))
  (with-network-panes window
    (print 'modifying)
    (case new-mode
      (nil (send window :set-mode :modify))
      (:select (print 'selecting)))))

(defun box-quit()
  (declare(special window))
  (print 'quit query-io)
  (send window :kill))

(defun box-return()
  (declare(special window))
  (send window :set-mode :main))

(defun box-redraw()
  (declare(special window))
  (dolist (pane (send window :inferiors))
    (send pane :redraw)))

(tv:add-system-key #\N *basic-box-flavor* "Find//Make a Box Network")

(setq *box-window-list* nil)