;;; -*- Mode:LISP; Base:10 -*- (defvar *box-window-list* nil "List of created box networks.") (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.5s0)) ((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-subnets-area) ((box-text-area 0.5s0)) ((box-subnets-area :even))) (box-network-display :even))) )))) ;;; Main window definition ;;; ;;; (defflavor box-network-frame () (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 Banner" :centered)) ;;; Box drawing area (box-network-display simple-text-area :label "Box Network Display") ;;; Box global view (box-subnets-area simple-text-area :label (:string "Global View")) ;;; Accompanying text (box-text-area simple-text-area :label (:string "Text"))) :constraints *box-frame-configuration-alist*) :gettable-instance-variables :settable-instance-variables :inittable-instance-variables) (defmethod (box-network-frame :after :init) (&rest ignore) (declare(special *box-mode-item-alist*)) (send self :set-selection-substitute (send self :get-pane 'box-text-area)) (send self :set-label '(:string "Experimental Box Network" :font fonts:metsi :centered)) (push self *box-window-list*)) (defmethod (box-network-frame :before :expose) (&rest ignore) (let ((comms (send self :get-pane 'box-commands))) (send comms :update-mode-item-alist *box-mode-item-alist*) (send comms :update-item-list))) (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))) (compile-flavor-methods box-network-frame)