;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: XIT; Base: 10; -*-
;;;_________________________________________________________________________________
;;;
;;;                       System: XIT
;;;                       Module: EXAMPLES
;;;                       (Version 1.0)
;;;
;;; Copyright (c): Forschungsgruppe DRUID, Hohl, Hubertus
;;;                Universitaet Stuttgart
;;;
;;; File: /usr/local/lisp/xit/examples/paned-window-examples.lisp
;;; File Creation Date: 9/05/90 13:15:09
;;; Last Modification Time: 07/30/92 10:00:22
;;; Last Modification By: Hubertus Hohl
;;;
;;;
;;; Changes (worth to be mentioned):
;;; ================================
;;;
;;;________________________________________________________________________________ 


(in-package :xit)

(proclaim '(special demo-window icon-menu paned-windows-window
		    paned-window-1
		    *display* *toplevel*))

;;;__________________________________
;;; 
;;; Demo Window for Paned-Windows
;;;__________________________________

(setq paned-windows-window
      (make-window 'intel-example-window
		   :x 60 :y 40 :width 600 :height 400
		   :window-icon `(intel-example-icon :parent ,icon-menu
						     :text "Paned Windows")
		   :title "Paned Windows"))



;;; 
;;; Some Pane contacts
;;;

(defcontact window-button (bitmap-dispel)
  ((mouse-feedback :initform :border)))

(defmethod initialize-instance :after ((self window-button) &rest initargs &key action-docu)
  (unless (reactivity-entry self :select)
    (let ((actions `((call :part-of ,(view-of self)))))
      (apply #'change-reactivity self :select
	     (if action-docu
		 (cons action-docu actions)
		 actions)))))

(defcontact titled-pane (title-window dispel)
  ())


;;;
;;; The Paned Window
;;;

(defcontact example-paned-window (window-icon-mixin popup-part-connection
				  paned-window)
  ((name :initform :example-paned-window)
   (popup-part :initform :default)
   (reactivity :initform '((:select) (:move) (:menu)))
   ))

(define-resources
  (* example-paned-window :header font)  '(:face :bold :size 12)
  (* example-paned-window :header foreground) "white"
  (* example-paned-window :header background) "black"
  
  (* example-paned-window * :margin-label font) '(:face :bold :size 12)

  (* example-paned-window :form part-label-font) '(:face :bold :size 12) 
  (* example-paned-window :form part-value-font) '(:face :normal :size 12)

  (* example-paned-window :bottom-pane title-font) '(:face :bold :size 12)
  )

(setq paned-window-1
      (make-window
       'example-paned-window
       :parent paned-windows-window
       :name :example-paned-window
       :view-of demo-window
       :window-icon-pos :window 
       :background "white"
       :border-width 2
       :inside-border 3
       :x 20
       :y 40
       :width 440
       :height 300
       :adjust-size? nil
       :parts
       `(;; the Header Pane
	 (:class text-dispel
	  :name :header
	  :text "Header Pane"
	  :adjust-size? nil
	  :inside-border 4
	  :border-width 1)
	 ;; window operation buttons 
	 (:class window-button
	  :name :button-refresh
	  :bitmap "button-refresh"
	  :view-of refresh-window
	  :action-docu "Refresh Window")
	 (:class window-button
          :name :button-move
	  :bitmap "button-move"
	  :view-of move-window
	  :action-docu "Move Window")
	 (:class window-button
          :name :button-resize
	  :bitmap "button-resize"
	  :view-of resize-window
	  :action-docu "Resize Window")
	 (:class window-button
          :name :button-totop
	  :bitmap "button-totop"
	  :view-of totop-window
	  :action-docu "Put Window on Top")
	 (:class window-button
	  :name :button-tobottom
	  :bitmap "button-tobottom"
	  :view-of tobottom-window
	  :action-docu "Put Window to Bottom")
	 (:class window-button
          :name :button-shrink
	  :bitmap "button-shrink"
	  :view-of shrink
	  :action-docu "Shrink Window to Icon")
         (:class window-button
	  :name :button-kill
	  :bitmap "button-kill"
	  :view-of destroy
          :action-docu "Remove Window")

         ;; configuration switch
	 (:class window-button
          :name :button-switch
	  :bitmap "button-switch"
	  :reactivity-entries
	  ((:select "Switch Configurations"
	    (call :eval
		  (switch-configuration (layouter (part-of *self*)))))))

	 (:class margined-window
	  :name :menu
	  :adjust-size? nil
	  :border-width 0
	  :margins
	  ((standard-margins-with-scroll-bars 
	    :label-options (:text "Menu Pane"
				  :display-position :left-center)		
	    :scroll-bar-options (:locations (:left))))
	  :client-window
	  (basic-menu
	   :adjust-size? nil
	   :border-width 0
	   :inside-border 0
	   :layouter (distance-layouter :orientation :down)
	   :reactivity-entries ((:part-event "Change toplevel background"
				      (call :eval
					    (change-window-background
					     (view-of *self*)
					     *part-value*))))
	   :part-class menu-example-dispel 
	   :part-mouse-feedback :border
	   :parts ((:background "white"
		     :view-of "white"
		   :action-docu
		   "Set background of test window to 0%gray")
		  (:background .12
		   :view-of .12
		   :action-docu
		   "Set background of test window to 12%gray")
		  (:background .25
		   :view-of .25
		   :action-docu
		   "Set background of test window to 25%gray")
		  (:background .37
		   :view-of .37
		   :action-docu
		   "Set background of test window to 37%gray")
		  (:background .50
		   :view-of .50
		   :action-docu
		   "Set background of test window to 50%gray")
		  (:background .75
		   :view-of .75
		   :action-docu
		   "Set background of test window to 75%gray")
		  (:background "black"
		   :view-of "black"
		   :action-docu
		   "Set background of test window to 100%gray"))
	   ))
	 (:class margined-window
	  :name :form
	  :adjust-size? nil
	  :border-width 0
	  :margins
	  ((standard-margins-with-scroll-bars 
	    :label-options (:text "Property Sheet Pane"
			    :display-position :left-center)
	    :scroll-bar-options (:locations (:right))))
	  :client-window
	  (text-property-sheet
	   :adjust-size? nil
	   :border-width 0
	   :inside-border 0
	   :part-label-width 100
	   :part-value-width 150
	   :reactivity-entries
	   ((:select
	     "Read Options."
	     (call :read)))
	   :parts (
		   (:label "x"
		    :value-part (:border-width 1)
		    :read-function contact-x
		    :write-function (lambda (view-of value)
				      (change-geometry view-of :x value)))
		   (:label "y"
		    :value-part (:border-width 1)
		    :read-function contact-y
		    :write-function (lambda (view-of value)
				      (change-geometry view-of :y value)))
		   (:label "width"
		    :value-part (:border-width 1)
		    :read-function contact-width
		    :write-function (lambda (view-of value)
				      (change-geometry view-of :width value)))
		   (:label "height"
		    :value-part (:border-width 1)
		    :read-function contact-height
		    :write-function (lambda (view-of value)
				      (change-geometry view-of :height value)))
		   (:label "border width"
		    :value-part (:border-width 1)
		    :read-function contact-border-width
		    :write-function (lambda (view-of value)
				      (change-geometry view-of :border-width value)))
		   )))
	 (:class titled-pane
	  :name :bottom-pane
	  :adjust-size? nil
	  :border-width 1
	  :title "Bottom Pane")
	 )
       :layouter
       '(pane-layouter
	 :configuration configuration-1
	 :configurations
	 ((configuration-1
	   ((:header :ask)
	    (empty 3)
	    (button-strip (:ask :button-move) :h
			 (empty 3)
			 (:button-switch :ask)
			 (empty :even)
			 (:button-refresh :ask)
			 (empty 3)
			 (:button-move :ask)
			 (empty 3)
			 (:button-resize :ask)
			 (empty 3)
			 (:button-totop :ask)
			 (empty 3)
			 (:button-tobottom :ask)
			 (empty 3)
			 (:button-shrink :ask)
			 (empty 3)
			 (:button-kill :ask)
			 (empty 3))
	    (empty 3) 
	    (middle-strip 0.66 :h
			  (:menu .25)
			  (empty 3)
			  (:form :rest))
	    (empty 3)
	    (:bottom-pane :rest)))
	  (configuration-2
	   ((:header :ask)
	    (empty 3)
	    (button-strip (:ask :button-move) :h
			 (empty 3)
			 (:button-switch :ask)
			 (empty :even)
			 (:button-refresh :ask)
			 (empty 3)
			 (:button-move :ask)
			 (empty 3)
			 (:button-resize :ask)
			 (empty 3)
			 (:button-totop :ask)
			 (empty 3)
			 (:button-tobottom :ask)
			 (empty 3)
			 (:button-shrink :ask)
			 (empty 3)
			 (:button-kill :ask)
			 (empty 3))
	    (empty 3) 
	    (middle-strip 0.3 :h
			  (:bottom-pane :rest)
			  (empty 3)
			  (:menu .3))
	    (empty 3)
	    (:form :rest)))))
       ))

(update-state *display*)
(process-all-events *display*)

(shrink paned-windows-window)

(update-state *display*)
(process-all-events *display*)
