;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10.; Package: XIT -*-
;;;_____________________________________________________________________________
;;;
;;;                       System: XIT
;;;                       Module: Switch Examples
;;;                       (Version 1.0)
;;;
;;; Copyright (c): Forschungsgruppe DRUID, Juergen Herczeg
;;;                Universitaet Stuttgart
;;;
;;; File: /usr/local/lisp/xit/examples/switch-examples.lisp
;;; File Creation Date: 09/14/90 10:33:57
;;; Last Modification Time: 07/24/92 13:07:36
;;; Last Modification By: Juergen Herczeg
;;;
;;;
;;; Changes (worth to be mentioned):
;;; ================================
;;;
;;;_____________________________________________________________________________

(in-package :xit)

;_______________________________________________________________________________
(proclaim '(special demo-window icon-menu switch-window
	            switch-1 switch-2 switch-3
		    *display*))


(setq switch-window
      (make-window 'intel-example-window
		   :name :switch-examples
		   :x 200 :y 80 :width 300 :height 200
		   :window-icon `(intel-example-icon :parent ,icon-menu
						     :text "Switches")
		   :title "Switches"))

(setq switch-1 (make-window 'text-switch
			    :parent switch-window
			    :x 20 :y 40
			    :border-width 2
			    :inside-border 15
			    :part-font '(:face :bold :size :huge)
			    :view-of demo-window
			    :reactivity-entries
			    '((:single-left-button
			 "Change border width of Test Window (switch forward)"
			       (call :self switch-forward))
			      (:single-right-button
			 "Change border width of Test Window (switch backward)"
			       (call :self switch-backward))
			      (:write-event
			       (call :view-of
				     change-window-border-width
				     (value *self*)))
			      (:read-event
			       (call :eval
				     (setf (value *self*)
				       (contact-border-width
					(view-of *self*)))))
			      (:shift-left-button "Update selection"
			       (call :read)))
			    :selection 1
			    :parts '((:view-of 0 :text "0")
				     (:view-of 1 :text "1")
				     (:view-of 2 :text "2")
				     (:view-of 3 :text "3")
				     (:view-of 4 :text "4")
				     (:view-of 5 :text "5")
				     (:view-of 6 :text "6")
				     (:view-of 7 :text "7")
				     (:view-of 8 :text "8")
				     (:view-of 9 :text "9")
				     (:view-of 10 :text "10"))))
				     

(setq switch-2 (make-window 'bitmap-switch
			    :parent switch-window
			    :x 100 :y 40
			    :border-width 1
			    :inside-border 0
			    :selection "nomail"
			    :reactivity-entries
			    '((:write-event
			       (call :eval
				 (when (string= (value *self*)
						"mail")
				    (format t "~%You have new mail.~%")))))
			    :parts '((:view-of "nomail" :bitmap "nomail"
				      :mouse-documentation "there's no mail"
				      :compute-mouse-documentation? :never)
				     (:view-of "mail" :bitmap "mail"
				      :mouse-documentation "there's new mail"
				      :compute-mouse-documentation? :never))))
				     

(setq switch-3
  (make-window 'switch
	       :parent switch-window
	       :view-of demo-window
	       :x 200 :y 40
	       :inside-border 0
	       :action-mode :down
	       :mouse-feedback :none
	       :part-mouse-feedback :border
	       :reactivity-entries
	       '((:select
		  "Change background of Test Window"
		  (call :self switch))
		 (:write-event
		  (call :view-of change-window-background
		                 (value *self*))))
	       :selection "white"
	       :parts '((:class soft-button
			 :name :white
			 :view-of "white"
			 :text-part (:text "Paint it white")
			 :bitmap-part :none)
			(:class soft-button
			 :name :black
			 :view-of "black"
			 :text-part (:text "Paint it black")
			 :bitmap-part :none))))    
				   
(update-state *display*)
(process-all-events *display*)

(shrink switch-window)

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