;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10.; Package: XIT -*-
;;;_____________________________________________________________________________
;;;
;;;                       System: XIT
;;;                       Module: Menu Examples
;;;                       (Version 1.0)
;;;
;;; Copyright (c): Forschungsgruppe DRUID, Juergen Herczeg
;;;                Universitaet Stuttgart
;;;
;;; File: /usr/local/lisp/xit/examples/menu-examples.lisp
;;; File Creation Date: 6/23/89 10:31:37
;;; Last Modification Time: 07/24/92 13:07:41
;;; Last Modification By: Juergen Herczeg
;;;
;;; Changes (worth to be mentioned):
;;; ================================
;;; 
;;; [Juergen  Thu Nov 15 10:04:51 1990] (call :eval (*part-value ...))
;;;    substituted by (call :eval (funcall *part-value* ...)), which
;;;    was absolutely neccessary!
;;;_____________________________________________________________________________

(in-package :xit)

;_______________________________________________________________________________

(proclaim '(special demo-window icon-menu menu-window
	    menu-1 menu-2 menu-3 menu-4 menu-5 menu-6 menu-7
	    menu-8 *display* *toplevel*))


(setq menu-window
      (make-window 'intel-example-window
		   :name :menu-examples
		   :x 170 :y 20 :width 500 :height 650
		   :window-icon `(intel-example-icon :parent ,icon-menu
						     :text "Menus")
		   :title "Menus"))


(setq menu-1 (make-window 'text-menu
			  :parent menu-window
			  :x 20 :y 40
			  :border-width 1
			  :inside-border 10
			  :view-of demo-window
			  :reactivity-entries
			  '((:part-event
			     (call :eval (funcall *part-value*
						  (view-of *self*)))))
			  :parts '((:view-of refresh-window
				    :text "refresh"
				    :action-docu "Refresh Demo Window")
				   (:view-of move-window
				    :text "move"
				    :action-docu "Move Demo Window")
				   (:view-of resize-window
				    :text "resize"
				    :action-docu "Resize Demo Window")
				   (:view-of totop-window
				    :text "totop"
				    :action-docu "Put Demo Window on top")
				   (:view-of tobottom-window
				    :text "tobottom"
				    :action-docu "Put Demo Window to bottom")
				   (:view-of shrink
				    :text "shrink"
				    :action-docu "Shrink Demo Window to icon")
				   (:text "close"
				    :sensitive :off))))

(setq menu-2 (make-window 'bitmap-menu
			  :parent menu-window
			  :x 150 :y 40
			  :border-width 1
			  :inside-border 5
			  :view-of demo-window
			  :layouter '(distance-layouter :orientation :down)
			  :reactivity-entries
			  '((:part-event
			     (call :eval (funcall *part-value*
						  (view-of *self*)))))
			  :part-mouse-feedback :inverse
			  :parts '((:view-of refresh-window
				    :bitmap "refresh"
				    :action-docu "Refresh Demo Window")
				   (:view-of move-window
				    :bitmap "move"
				    :action-docu "Move Demo Window")
				   (:view-of resize-window
				    :bitmap "newsize"
				    :action-docu "Resize Demo Window")
				   (:view-of shrink-or-expand
				    :bitmap "shrink"
				    :action-docu
				    "Shrink or expand Demo Window")
				   (:view-of close
				    :bitmap "close"
				    :action (progn)
				    :sensitive :off
				    :state :withdrawn))))

(setq menu-3 (make-window 'basic-menu
			  :parent menu-window
			  :name :background-menu
			  :x 20 :y 240
			  :border-width 1
			  :inside-border 5
			  :view-of (toplevel-window menu-window)
			  :part-class 'menu-example-dispel
			  :layouter '(distance-layouter :orientation :right)
			  :reactivity-entries
			  '((:part-event (call :eval
					       (change-window-background
						(view-of *self*)
						*part-value*))))
			  :part-mouse-feedback :border
			  :parts `((:background "white"
				    :view-of "white"
				    :action-docu
				    "Set background of toplevel window to 0%gray")
				   (:background .12
				    :view-of .12
				    :action-docu
				    "Set background of toplevel window to 12%gray")
				   (:background .25
				    :view-of .25
				    :action-docu
				    "Set background of toplevel window to 25%gray")
				   (:background .37
				    :view-of .37
				    :action-docu
				    "Set background of toplevel window to 37%gray")
				   (:background .50
				    :view-of .50
				    :action-docu
				    "Set background of toplevel window to 50%gray")
				   (:background .75
				    :view-of .75
				    :action-docu
				    "Set background of toplevel window to 75%gray")
				   (:background "black"
				    :view-of "black"
				    :action-docu
				    "Set background of toplevel window to 100%gray"))))

(setq menu-4 (make-window 'single-choice-text-menu
			  :parent menu-window
			  :x 300 :y 25
			  :border-width 1
			  :inside-border 10
			  :view-of demo-window
			  :reactivity-entries
			  `((:shift-left-button "Update selection"
			     (call :read))
			    (:write-event
			     (call :eval
				   (setf (title-font (view-of *self*))
				     (value *self*))))
			    (:read-event
			     (call :eval
				   (setf (value *self*)
				     (multiple-value-bind (fam face size)
					 (get-font-family-face-size
					  (title-font (view-of *self*)))
				       (declare (ignore fam))
				       `(:face ,face :size ,size))))))
			  :parts '((:view-of (:face :normal :size 10)
				    :text "10"
				    :font (:face :normal :size 10)
				    :action-docu
				    "Set title-font of Demo Window to Helvetica-10")
				   (:view-of (:face :bold :size 10)
				    :text "10 bold"
				    :font (:face :bold :size 10)
				    :action-docu
				    "Set title-font of Demo Window to Helvetica-10-bold")
				   (:view-of (:face :italic :size 10)
				    :text "10 italics"
				    :font (:face :italic :size 10)
				    :action-docu
				    "Set title-font of Demo Window to Helvetica-10-italics")
				   (:view-of (:face :bolditalic :size 10)
				    :text "10 bold italics"
				    :font (:face :bolditalic :size 10)
				    :action-docu
				"Set title-font of Demo Window to Helvetica-10-bold-italics")
				   
				   (:view-of (:face :normal :size 12)
				    :text "12"
				    :font (:face :normal :size 12)
				    :action-docu
				    "Set title-font of Demo Window to Helvetica-12")
				   (:view-of (:face :bold :size 12)
				    :text "12 bold"
				    :font (:face :bold :size 12)
				    :action-docu
				    "Set title-font of Demo Window to Helvetica-12-bold")
				   (:view-of (:face :italic :size 12)
				    :text "12 italics"
				    :font (:face :italic :size 12)
				    :action-docu
				"Set title-font of Demo Window to Helvetica-12-italics")
				   (:view-of (:face :bolditalic :size 12)
				    :text "12 bold italics"
				    :font (:face :bolditalic :size 12)
				    :action-docu
				"Set title-font of Demo Window to Helvetica-12-bold-italics")
				   
				   (:view-of (:face :normal :size 14)
				    :text "14"
				    :font (:face :normal :size 14)
				    :action-docu
				    "Set title-font of Demo Window to Helvetica-14")
				   (:view-of (:face :bold :size 14)
				    :text "14 bold"
				    :font (:face :bold :size 14)
				    :action-docu
				    "Set title-font of Demo Window to Helvetica-14-bold")
				   (:view-of (:face :italic :size 14)
				    :text "14 italics"
				    :font (:face :italic :size 14)
				    :action-docu
				"Set title-font of Demo Window to Helvetica-14-italics")
				   (:view-of (:face :bolditalic :size 14)
				    :text "14 bold italics"
				    :font (:face :bolditalic :size 14)
				    :action-docu
				"Set title-font of Demo Window to Helvetica-14-bold-italics")
				   
				   (:view-of (:face :normal :size 18)
				    :text "18"
				    :font (:face :normal :size 18)
				    :action-docu
				    "Set title-font of Demo Window to Helvetica-18")
				   (:view-of (:face :bold :size 18)
				    :text "18 bold"
				    :font (:face :bold :size 18)
				    :action-docu
				    "Set title-font of Demo Window to Helvetica-18-bold")
				   (:view-of (:face :italic :size 18)
				    :text "18 italics"
				    :font (:face :italic :size 18)
				    :action-docu
				"Set title-font of Demo Window to Helvetica-18-italics")
				   (:view-of (:face :bolditalic :size 18)
				    :text "18 bold italics"
				    :font (:face :bolditalic :size 18)
				    :action-docu
				"Set title-font of Demo Window to Helvetica-18-bold-italics")
				   
				   (:view-of (:face :normal :size 24)
				    :text "24"
				    :font (:face :normal :size 24)
				    :action-docu
				    "Set title-font of Demo Window to Helvetica-24")
				   (:view-of (:face :bold :size 24)
				    :text "24 bold"
				    :font (:face :bold :size 24)
				    :action-docu
				    "Set title-font of Demo Window to Helvetica-24-bold")
				   (:view-of (:face :italic :size 24)
				    :text "24 italics"
				    :font (:face :italic :size 24)
				    :action-docu
				"Set title-font of Demo Window to Helvetica-24-italics")
				   (:view-of (:face :bolditalic :size 24)
				    :text "24 bold italics"
				    :font (:face :bolditalic :size 24)
				    :action-docu
				"Set title-font of Demo Window to Helvetica-24-bold-italics")
				   )))

(setq menu-5 (make-window 'multiple-choice-text-menu
			  :parent menu-window
			  :x 25 :y 310
			  :border-width 1
			  :inside-border 10
			  :part-font '(:face :bold)
			  :view-of menu-2
			  :reactivity-entries
			  `((:part-event
			      (call :eval
				(setf
				    (contact-state
				     (part-viewing (view-of *self*)
						   *part-value*))
				  (if (selected? *part*)
				      :mapped
				    :withdrawn)))))
			  :selection `(refresh-window move-window
				       resize-window shrink-or-expand)
			  :parts '((:view-of refresh-window
				    :text "refresh"
				    :action-docu "Toggle refresh-window")
				   (:view-of move-window
				    :text "move"
				    :action-docu "Toggle move-window")
				   (:view-of resize-window
				    :text "resize"
				    :action-docu "Toggle resize-window")
				   (:view-of shrink-or-expand
				    :text "shrink/expand"
				    :action-docu "Toggle shrink/expand-window")
				   (:view-of close
				    :text "close"
				    :action-docu "Toggle close-window"))))

(setq menu-6
  (make-window 'intel
	       :parent menu-window
	       :x 170 :y 310
	       :border-width 1
	       :inside-border 10
	       :layouter '(distance-layouter :distance 10)
	       :selection nil
	       :parts '((:class multiple-choice-text-menu
			 :name :selection
			 :inside-border 12
			 :border-width 1
			 :reactivity-entries
			 ((:part-event)
			  (:write-event
			   (call :eval
				 (dolist
				     (item (parts *self*))
				   (if (selected? item)
				       (expand (symbol-value (view-of item)))
				       (shrink (symbol-value (view-of item)))))))
			  (:read-event
			   (call :eval
				 (dolist
				    (item (parts *self*))
				   (if (expanded? (symbol-value (view-of item)))
				       (setf (selected? item) t)
				       (setf (selected? item) nil))))))
			 :part-font (:face :bolditalic)
	                 :selection nil
			 :parts ((:text "Dispels"
				  :view-of dispel-window
				  :action-docu "Dispel examples")
				 (:text "Virtuals"
				  :view-of frame-for-virtuals
				  :action-docu "Virtual dispel examples")
				 (:text "Layouters"
				  :view-of layouter-window
				  :action-docu "Layouter examples")
				 (:text "Icons"
				  :view-of icon-window
				  :action-docu "Icon examples")
				 (:text "Menus"
				  :view-of menu-window
				  :action-docu "Menu examples")
				 (:text "Switches"
				  :view-of switch-window
				  :action-docu "Switch examples")
				 (:text "Sheets"
				  :view-of property-sheet-window
				  :action-docu "Property sheet examples")
				 (:text "Sliders"
				  :view-of slider-window
				  :action-docu "Slider examples")
				 (:text "Margins"
				  :view-of margined-windows-window
				  :action-docu "Margin examples")
				 (:text "Panes"
				  :view-of paned-windows-window
				  :action-docu "Paned window examples")))
			(:class text-menu
			 :inside-border 0
			 :layouter (distance-layouter :orientation :right
				                      :distance 10)
			 :parts ((:text "Cancel"
				  :border-width 1
				  :action
				  (call :eval
				    (read-from-application
				     (part (part-of (part-of *self*))
					       :selection)))
				  :action-docu "Cancel selection")
				 (:text "Do it"
				  :border-width 1
				  :action
				  (call :eval
					(write-to-application
					 (part (part-of (part-of *self*))
					       :selection)))
				  :action-docu "Put selected examples totop"))))))
				   


(setq menu-7
  (make-window 'intel
	       :parent menu-window
	       :x 15 :y 460
	       :border-width 1
	       :inside-border 10
	       :layouter '(distance-layouter :distance 10)
	       :selection nil
	       :parts '((:class multiple-choice-box-menu
			 :name :selection
			 :inside-border 12
			 :border-width 1
			 :layouter (distance-layouter :distance 0)
			 :reactivity-entries
			 ((:part-event))
			 :selection (:earl-grey)
			 :parts ((:text-part (:text "Maracuja") 
				  :view-of :maracuja
				  :action-docu "Choose Maracuja")
				 (:text-part (:text "Earl Grey") 
				  :view-of :earl-grey
				  :action-docu "Choose Earl Grey")
				 (:text-part (:text "Assam")
				  :view-of :assam
				  :action-docu "Choose Assam")
				 (:text-part (:text "Darjeeling") 
				  :view-of :darjeeling
				  :action-docu "Choose Darjeeling"))) 
			(:class single-choice-text-menu
			 :inside-border 0
			 :border-width 1
			 :layouter (distance-layouter :orientation :right
				                      :distance 0)
			 :selection :cross
			 :parts ((:text "Cross"
				  :view-of :cross
				  :action
				  (call :eval
					(setf (selected-choice-box-bitmap
					       (part (part-of (part-of *self*))
						     :selection))
					    "choice-box-set"))
				  :action-docu "Use an X")
				 (:text "CheckMark"
				  :view-of :checkmark
				  :action
				  (call :eval
					(setf (selected-choice-box-bitmap
					       (part (part-of (part-of *self*))
						     :selection))
					      "choice-box-checked"))
				  :action-docu "Use a checkmark"))))))
				   
				   
(setq menu-9
  (make-window 'single-choice-box-menu
	       :parent menu-window
	       :x 350 :y 570
	       :border-width 1
	       :inside-border 10
	       :view-of (make-instance 'sound-dispel :sound "bond-fm")
	       :selection "bond-fm"
	       :reactivity-entries
	       '((:part-event
		  (call :eval (setf (sound (view-of *self*)) *part-value*))
		  (call :view-of play)))
	       :parts '((:text-part (:text "AM" :font (:face :bold))
			 :view-of "bond-am"
			 :action-docu "Choose AM")
			(:text-part (:text "FM" :font (:face :bold)) 
			 :view-of "bond-fm"
			 :action-docu "FM"))))
				   
				   
(update-state *display*)
(process-all-events *display*)

(shrink menu-window)

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