;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: GARNET-GADGETS; Base: 10 -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;         The Garnet User Interface Development Environment.      ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; This code was written as part of the Garnet project at          ;;;
;;; Carnegie Mellon University, and has been placed in the public   ;;;
;;; domain.  If you are using this code or any part of Garnet,      ;;;
;;; please contact garnet@cs.cmu.edu to be put on the mailing list. ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;  Radio-Button-Panel
;;;
;;;  Features and operation of Radio Buttons:
;;;     1)  Radio-button-panel is a set of circular buttons with text on one
;;;         side.  Only one button may be selected at a time.
;;;     2)  Click the left mouse button in a button to cause an inverse circle
;;;         to be superimposed on the button.
;;;     3)  The top level :value slot points to the string of the currently
;;;         selected button.
;;;     4)  The top level :value-obj slot points to the currently selected
;;;         button, and can be set directly with S-VALUE to select a button.  
;;;     5)  The :items slot may contain functions to be executed as each
;;;         button becomes selected, and :selection-function may contain a
;;;         function to be executed when any button becomes selected.
;;;
;;;  Customizable slots:
;;;     1)  All customizable slots of an aggrelist:
;;;            Direction -- :vertical or :horizontal
;;;            V-spacing -- distance between buttons, if vertical orientation
;;;            H-spacing -- same, if horizontal orientation
;;;            Fixed-width-p -- whether to put buttons in fields of constant
;;;                             width, specified in :fixed-width-size.
;;;            Fixed-height-p -- same, but with heights
;;;            Fixed-width-size -- width of all components (default is the
;;;                                width of the widest button)
;;;            Fixed-height-size -- same, but with heights 
;;;            H-align -- how to align buttons, if vertical orientation
;;;                       :left, :center, or :right
;;;            Rank-margin -- after this many components, a new row (or column)
;;;                           will be started
;;;            Pixel-margin -- absolute position in pixels after which a new
;;;                            row (or column) will be started
;;;            Indent -- amount to indent the new row (or column) in pixels
;;;     2)  Left, top, button-diameter
;;;     3)  Shadow-offset -- the amount of shadow that shows under the buttons
;;;     4)  Text-offset -- the distance from the text to the buttons
;;;     5)  Gray-width -- the width of the gray border on the buttons
;;;     6)  Text-on-left-p -- whether text will appear on left side of buttons
;;;                           (NIL implies text will appear to the right)
;;;     7)  Font  --  The font in which the button labels will appear
;;;     8)  Items -- This can be: 
;;;                  A list of strings, as in '("Large" ...), or
;;;                  a list of atoms, as in '(:center ...), or
;;;                  a list of string/function pairs, '(("Cut" Cut-FN) ...), or
;;;                  a list of atom/function pairs, '((:center Center-FN) ...).
;;;                  Each function will be executed when the associated button
;;;                  becomes selected.  The parameters are the top-level
;;;                  GADGET and the ITEM-STRING.
;;;     9)  Selection-function -- Global function to be executed when any
;;;                               button is selected.  Parameters are the
;;;                               top-level GADGET and the ITEM-STRING.
;;;
;;;  NOTE:  This module requires several schemata defined in GAD-button-parts.
;;;         Thus, GAD-button-parts.fasl must be loaded before this module.
;;;
;;;  Radio Buttons demo:
;;;     This module contains a function which creates a window and a panel of
;;;     Radio Buttons.  To run it, enter (GARNET-GADGETS:radio-buttons-go).
;;;     To stop, enter (GARNET-GADGETS:radio-buttons-stop).
;;;
;;;  Designed by Brad Myers
;;;  Written by Andrew Mickish

;;; CHANGE LOG:
;;; 05/13/93  Andrew Mickish - :prev-visible ---> :prev
;;; 02/23/93  Andrew Mickish - Added :string-set-func
;;; 02/10/93  Andrew Mickish - Made :items of type items-type
;;; 12/15/92  Andrew Mickish - Added type and parameter declarations
;;; 08/31/92  Andrew Mickish - Changed :fixed-height-size formula
;;; 06/16/92  Andrew Mickish - Added objects in :items list
;;; 06/05/92  Andrew Mickish - Changed :visible in final-feedback to consider
;;;              the :parent of obj-over
;;; 04/17/92  Andrew Mickish - Now final-feedback objs are invisible when the
;;;              parent gadget is invisible
;;; 02/17/92  Andrew Mickish - Added :maybe-constant lists
;;; 07/26/91  Andrew Mickish - Added :toggle-p slot to button and panel
;;; 05/14/91  Andrew Mickish - Fixed :selected formula in :radio-button-list
;;; 04/15/91  Andrew Mickish - Added :notice-items-changed, :add-item, and
;;;              :remove-item methods
;;; 11/28/90  Pavan Reddy - added formula to :value-obj slot of RADIO-BUTTON-
;;;              PANEL so :value and :value-obj slots remain consistent.
;;; 07/03/90  Andrew Mickish - Moved objects from GAD-button-parts.lisp into
;;;              :parts slot of RADIO-BUTTON; reimplemented RADIO-BUTTON so
;;;              that single instances can be created.
;;; 07/02/90  Andrew Mickish - Converted circularity between :value and
;;;              :selected slot;  Now the final-function sets :value-obj which
;;;              propagates to :value and :selected.
;;; 06/25/90  Andrew Mickish - Added :FINAL-FEEDBACK part to RADIO-BUTTON-PANEL
;;;              to utilize fast-redraw-p technology
;;; 01/30/90  Andrew Mickish - Added :selected slot to RADIO-BUTTON-LIST
;;;              so that :value of panel can be set directly.
;;;

(in-package "GARNET-GADGETS" :use '("LISP" "KR"))

(export '(Radio-Button Radio-Button-Panel))
#+garnet-debug
(export '(Radio-Buttons-Go Radio-Buttons-Stop Radio-Button-Obj
	  Radio-Buttons-Obj Radio-Buttons-Top-Agg Radio-Buttons-Win
	  Radio-Button-Obj2))

(create-instance 'RADIO-BUTTON opal:aggregadget
  :declare ((:parameters :left :top :button-diameter :shadow-offset
			 :text-offset :gray-width :string :text-on-left-p
			 :toggle-p :value :font :selection-function :visible)
	    (:type ((integer 0) :button-diameter)
		   (integer :shadow-offset :text-offset :gray-width)
		   ((or string keyword (satisfies schema-p)) :string)
		   ((or null string keyword (satisfies schema-p)) :value)
		   (kr-boolean :text-on-left-p :toggle-p)
		   ((or (is-a-p opal:font) (is-a-p opal:font-from-file)) :font)
		   ((or null function symbol) :selection-function))
	    (:maybe-constant :left :top :button-diameter :shadow-offset
			     :text-offset :gray-width :string :text-on-left-p
			     :toggle-p :font :visible))
   (:left 0) (:top 0)
   (:button-diameter 23)
   (:shadow-offset 5) (:text-offset 5) (:gray-width 3)
   (:string "Radio button")
   (:text-on-left-p T)
   (:toggle-p T)
   (:font opal:default-font)
   (:value (o-formula (if (gvl :selected) (gvl :string))))
   (:selection-function NIL)

   (:floating-left (o-formula (+ (gvl :button-left)
				 (if (gvl :interim-selected)
				     (gvl :shadow-offset)
				     0))))
   (:floating-top (o-formula (+ (gvl :button-top)
				 (if (gvl :interim-selected)
				     (gvl :shadow-offset)
				     0))))

   (:button-left (o-formula (if (gvl :text-on-left-p)
				(+ (gvl :left) (gvl :text-width)
				   (gvl :text-offset))
				(gvl :left))))
   (:button-top (o-formula (- (gvl :center-y)
			      (floor (gvl :button-unit-height) 2))))
   (:button-unit-width (o-formula (+ (gvl :button-diameter)
				     (gvl :shadow-offset))))
   (:button-unit-height (o-formula (gvl :button-unit-width)))
   (:text-left (o-formula (if (gvl :text-on-left-p)
			      (gvl :left)
			      (+ (gvl :left) (gvl :button-unit-width)
				 (gvl :text-offset)))))
   (:text-width (o-formula (gvl :text :width)))
   (:width (o-formula (+ (gvl :text-width) (gvl :text-offset)
			 (gvl :button-unit-width))))
   (:height (o-formula (MAX (gvl :button-unit-height)
			    (gvl :text :height))))
   (:center-y (o-formula (+ (gvl :top)
			    (floor (gvl :height) 2))))

   (:selected (o-formula (gvl :value)))  ; Set by interactor
   (:text-label-prototype (create-instance NIL BESIDE-BUTTON-TEXT))
   (:parts
    `((:shadow ,opal:circle
          (:left ,(o-formula (+ (gv (kr-path 0 :parent) :button-left)
				(gv (kr-path 0 :parent) :shadow-offset))))
	  (:top ,(o-formula (+ (gv (kr-path 0 :parent) :button-top)
			       (gv (kr-path 0 :parent) :shadow-offset))))
	  (:width ,(o-formula (gv (kr-path 0 :parent) :button-diameter)))
	  (:height ,(o-formula (gv (kr-path 0 :parent) :button-diameter)))
	  (:filling-style ,opal:black-fill))
      (:gray-outline ,opal:circle
          (:left ,(o-formula (gv (kr-path 0 :parent) :floating-left)))
	  (:top ,(o-formula (gv (kr-path 0 :parent) :floating-top)))
	  (:width ,(o-formula (gv (kr-path 0 :parent) :button-diameter)))
	  (:height ,(o-formula (gv (kr-path 0 :parent) :button-diameter)))
	  (:filling-style ,opal:gray-fill))
      (:white-field ,opal:circle
	  (:left ,(o-formula (+ (gv (kr-path 0 :parent) :floating-left)
				(gv (kr-path 0 :parent) :gray-width))))
	  (:top ,(o-formula (+ (gv (kr-path 0 :parent) :floating-top)
			       (gv (kr-path 0 :parent) :gray-width))))
	  (:width ,(o-formula (- (gv (kr-path 0 :parent) :button-diameter)
				 (* 2 (gv (kr-path 0 :parent) :gray-width)))))
	  (:height ,(o-formula (- (gv (kr-path 0 :parent) :button-diameter)
				  (* 2 (gv (kr-path 0 :parent) :gray-width)))))
	  (:filling-style ,opal:white-fill))
      (:text ,#'opal::Single-Button-Get-Label)
      (:feedback-obj ,opal:circle
	  (:left ,(o-formula (+ 3 (gv (kr-path 0 :parent) :floating-left)
				  (gv (kr-path 0 :parent) :gray-width))))
	  (:top ,(o-formula (+ 3 (gv (kr-path 0 :parent) :floating-top)
			         (gv (kr-path 0 :parent) :gray-width))))
	  (:width ,(o-formula (- (gv (kr-path 0 :parent) :button-diameter)
				 (* 2 (gv (kr-path 0 :parent) :gray-width)) 6)))
	  (:height ,(o-formula (- (gv (kr-path 0 :parent) :button-diameter)
				  (* 2 (gv (kr-path 0 :parent) :gray-width)) 6)))
	  (:visible ,(o-formula (let ((p (kr-path 0 :parent)))
				  (gv p :visible)
				  (gv p :selected))))
	  (:line-style NIL) (:filling-style ,opal:black-fill)
	  (:fast-redraw-p T)(:draw-function :xor))))
   (:interactors
    `((:radio-button-press ,inter:button-interactor
	(:window ,(o-formula (gv-local :self :operates-on :window)))
	(:start-where ,(o-formula (list :in-box (gvl :operates-on))))
	(:how-set ,(o-formula (if (gvl :operates-on :toggle-p) :toggle :set)))
	(:final-function
	 ,#'(lambda (interactor button)
	      (declare (ignore interactor))
	      (let ((string (when (g-value button :selected)
			      (g-value button :string))))
		; Execute the selection-function
		(kr-send button :selection-function button string))))))))




(create-instance 'RADIO-BUTTON-PANEL opal:aggregadget
  :declare ((:parameters :left :top :button-diameter :shadow-offset
			 :text-offset :gray-width :text-on-left-p :toggle-p
			 :font :items :value
			 :direction :v-spacing :h-spacing :fixed-width-p
			 :fixed-height-p :fixed-width-size :fixed-height-size
			 :h-align :rank-margin :pixel-margin :indent
			 :selection-function :visible)
	    (:type ((integer 0) :button-diameter)
		   ((or null (integer 0)) :fixed-width-size :fixed-height-size
		    :rank-margin :pixel-margin)
		   (integer :v-spacing :h-spacing :shadow-offset :text-offset
			    :gray-width)
		   (kr-boolean :text-on-left-p :toggle-p :fixed-width-p
		    :fixed-height-p)
		   ((or (is-a-p opal:font) (is-a-p opal:font-from-file)) :font)
		   (items-type :items)
		   ((or null string keyword (satisfies schema-p)) :value)
		   ((member :vertical :horizontal) :direction)
		   ((member :left :center :right) :h-align)
		   ((or null function symbol) :selection-function))
	    (:maybe-constant :left :top :direction :v-spacing :h-spacing
			     :h-align :fixed-width-p :fixed-width-size
			     :fixed-height-p :fixed-height-size :indent
			     :rank-margin :pixel-margin 
			     :button-diameter :shadow-offset :text-offset
			     :gray-width :text-on-left-p :toggle-p :font
			     :items :visible))
   ;; Customizable slots
   ;;
   (:left 0) (:top 0)
   (:direction :vertical)
   (:v-spacing 5) (:h-spacing 5)
   (:h-align (o-formula (if (gvl :text-on-left-p) :right :left)))
   (:fixed-width-p T)
   (:fixed-width-size (o-formula (+ (gvl :radio-button-list :tail
					 :max-text-width-thus-far)
				    (gvl :button-unit-width)
				    (gvl :text-offset))))
   (:fixed-height-p T)
   (:fixed-height-size (o-formula (MAX (gvl :button-unit-width)
				       (gvl :radio-button-list :tail
					    :max-text-height-thus-far))))
   (:indent 0) (:pixel-margin NIL) (:rank-margin NIL)
   (:button-diameter 23)
   (:shadow-offset 5) (:text-offset 5) (:gray-width 3)
   (:text-on-left-p T)
   (:toggle-p NIL)
   (:font opal:default-font)
   (:selection-function NIL)
   (:items '("Radio-text 1" "Radio-text 2" "Radio-text 3" "Radio-text 4"))

   (:value-obj (o-formula (gvl :radio-button-list :selected)))
   (:value (o-formula (let ((obj (gvl :value-obj)))
			(if obj (gv obj :string)))))

   (:actions-p (o-formula (listp (first (gvl :items)))))
   (:button-unit-width (o-formula (+ (gvl :button-diameter)
				     (gvl :shadow-offset))))
   (:width (o-formula (gvl :radio-button-list :width)))
   (:height (o-formula (gvl :radio-button-list :height)))
   (:text-label-prototype
    (create-instance NIL BESIDE-BUTTON-TEXT
      (:left (o-formula
	      (let ((base-left (+ (gvl :parent :left)
				  (if (gvl :parent :text-on-left-p) 0
				      (+ (gvl :parent :button-unit-width)
					 (gvl :parent :text-offset))))))
		(case (gv (gvl :parent :parent :parent) :h-align)
		  (:left base-left)
		  (:center (+ base-left
			      (floor (- (gvl :parent :text-width)
					(gvl  :width)) 2)))
		  (:right (+ base-left (- (gvl :parent :text-width)
					  (gvl :width))))))))))
   (:parts
    `((:radio-button-list ,ITEMS-AGGLIST
       (:selected
	,(o-formula
	  (let ((value (gv (kr-path 0 :parent) :value)))
	    (if value
		; Index is the position of the selected item in the :items slot
		(let ((index (if (gv (kr-path 0 :parent) :actions-p)
				 (position value (gvl :items) :test
					   #'(lambda (val item)
					       (equal val (car item))))
				 (position value (gvl :items) :test #'equal))))
		  (when index
		    (nth index (gvl :components))))))))
	 (:item-prototype
	  (,RADIO-BUTTON
	   (:selected ,(o-formula (equal (gvl :string)
					 (gvl :parent :parent :value))))
	   (:shadow-offset ,(o-formula (gv (kr-path 0 :parent :parent)
					   :shadow-offset)))
	   (:text-offset ,(o-formula (gv (kr-path 0 :parent :parent)
					 :text-offset)))
	   (:gray-width ,(o-formula (gv (kr-path 0 :parent :parent) :gray-width)))
	   (:button-diameter ,(o-formula (gv (kr-path 0 :parent :parent)
					     :button-diameter)))
	   (:text-on-left-p ,(o-formula (gv (kr-path 0 :parent :parent)
					    :text-on-left-p)))
	   (:max-text-width-thus-far
	    ,(o-formula (if (gvl :prev)
			    (MAX (gvl :prev :max-text-width-thus-far)
				 (gvl :text :width))
			    (gvl :text :width))))
	   (:max-text-height-thus-far
	    ,(o-formula (if (gvl :prev)
			    (MAX (gvl :prev :max-text-height-thus-far)
				 (gvl :text :height))
			    (gvl :text :height))))
	   (:text-width
	    ,(o-formula (if (gv (kr-path 0 :parent :parent) :fixed-width-p)
			    (- (gv (kr-path 0 :parent :parent) :fixed-width-size)
			       (gvl :button-unit-width) (gvl :text-offset))
			    (gvl :text :width))))
	   (:height
	    ,(o-formula (if (gv (kr-path 0 :parent :parent) :fixed-height-p)
			    (gv (kr-path 0 :parent :parent) :fixed-height-size)
			    (MAX (gvl :text :height)
				 (gvl :button-unit-height)))))

	   ;; Conditional formulas are required to allow either a list of
	   ;; strings or a list of string/function pairs in the :items slot.
	   (:string
	    ,(o-formula (if (gv (kr-path 0 :parent :parent) :actions-p)
			    (first (nth (gvl :rank)
					(gv (kr-path 1 :parent) :items)))
			    (nth (gvl :rank) (gv (kr-path 1 :parent) :items)))))
	   (:action ,(o-formula (when (gvl :parent :parent :actions-p)
				  (second (nth (gvl :rank)
					       (gvl :parent :items))))))
	   (:font ,(o-formula (gv (kr-path 0 :parent :parent) :font)))
	   (:parts
	    (:shadow :gray-outline :white-field
	     (:text :modify ,#'opal::Panel-Get-Label)
	     (:feedback-obj :omit)))
	   (:interactors
	    ((:radio-button-press :omit))))))
      (:FINAL-FEEDBACK ,opal:circle
          (:obj-over ,(o-formula (gvl :parent :radio-button-list :selected)))
	  (:left ,(o-formula (+ 3 (gvl :obj-over :white-field :left))))
	  (:top ,(o-formula (+ 3 (gvl :obj-over :white-field :top))))
	  (:width ,(o-formula (- (gvl :obj-over :white-field :width) 6)))
	  (:height ,(o-formula (- (gvl :obj-over :white-field :height) 6)))
	  (:visible ,(o-formula (let ((obj-over (gvl :obj-over)))
				  (and obj-over
				       (gv obj-over :parent)
				       (gv (kr-path 0 :parent) :visible)))))
	  (:fast-redraw-p T) (:draw-function :xor)
	  (:line-style NIL)
	  (:filling-style ,opal:black-fill))))

   (:interactors
    `((:RADIO-BUTTON-PRESS ,inter:button-interactor 
	(:start-where ,(o-formula (list :element-of
					(gvl :operates-on :radio-button-list))))
	(:window ,(o-formula (gv-local :self :operates-on :window)))
	(:how-set ,(o-formula (if (gvl :operates-on :toggle-p) :toggle :set)))
	(:final-function
	 ,#'(lambda (interactor final-obj-over)
	      (let* ((action (g-value final-obj-over :action))
		     (gadget (g-value interactor :operates-on))
		     (selected (g-value final-obj-over :selected))
		     (string (when selected
			       (g-value final-obj-over :string))))

		;; Propagate new selection toward :value slot
		(s-value gadget :value-obj (when selected final-obj-over))

		;; Global function for all items
		(kr-send gadget :selection-function gadget string)

		;; Local function assigned to item
		(when action
		  (funcall action gadget string)))))))))


(define-method :add-local-item RADIO-BUTTON-PANEL (gadget item &rest args)
  (opal::Gadget-Add-Local-Item gadget item :radio-button-list args))
(define-method :add-item RADIO-BUTTON-PANEL (gadget item &rest args)
  (opal::Gadget-Add-Item gadget item :radio-button-list args))
   
(define-method :remove-local-item RADIO-BUTTON-PANEL
               (gadget &optional item &key (key #'opal:no-func))
  (opal::Gadget-Remove-Local-Item gadget item :radio-button-list key))
(define-method :remove-item RADIO-BUTTON-PANEL
               (gadget &optional item &key (key #'opal:no-func))
  (opal::Gadget-Remove-Item gadget item :radio-button-list key))

(s-value RADIO-BUTTON-PANEL
	 :change-item
	 (g-value opal:aggrelist :change-item))
(s-value RADIO-BUTTON-PANEL
	 :remove-nth-item
	 (g-value opal:aggrelist :remove-nth-item))

(define-method :string-set-func RADIO-BUTTON-PANEL
    (gadget-obj str-obj final-event final-string)
  (let ((aggrel (g-value gadget-obj :RADIO-BUTTON-LIST)))
    (opal::Aggrelist-Edit-String-Func gadget-obj aggrel str-obj
				      final-event final-string :rank)))


;;;
;;;  DEMO FUNCTION
;;;

#+garnet-debug (defparameter Radio-Buttons-Win NIL)
#+garnet-debug (defparameter Radio-Buttons-Top-Agg NIL)
#+garnet-debug (defparameter Radio-Buttons-Obj NIL)

#+garnet-debug
(defun Radio-Buttons-Go ()
  (create-instance 'Radio-Buttons-Win inter:interactor-window
     (:height 360)(:width 350)(:top 5)(:left 650))
  (s-value Radio-Buttons-win
	   :aggregate
	   (create-instance 'Radio-Buttons-Top-Agg opal:aggregate))
  (create-instance 'Radio-Buttons-Obj Radio-Button-Panel
     (:left 30) (:top 20)
     (:selection-function #'Report-Selection)
     (:items `("Einstein" "Fermi" "Lorentz" "Maxwell" "Planck"
	       ,(create-instance NIL opal:line
		  (:x1 (o-formula (gvl :left)))
		  (:y1 (o-formula (gvl :top)))
		  (:x2 (o-formula (+ (gvl :x1) 40)))
		  (:y2 (o-formula (gvl :y1)))
		  (:width 40) (:height 1))
	       ,(create-instance NIL opal:rectangle
		  (:width 40) (:height 6)
		  (:filling-style opal:yellow-fill)))))
  (create-instance 'Radio-Button-Obj Radio-Button
     (:left 160) (:top 100)
     (:text-on-left-p T)
     (:toggle-p T)
     (:string (create-instance NIL opal:roundtangle
		(:width 40) (:height 20)
		(:filling-style opal:blue-fill)
		(:line-style opal:line-2)))
     (:selection-function #'(lambda (gadget value)
			      (format t "Button ~S " gadget)
			      (if value
				  (format t "selected.~%")
				  (format t "de-selected.~%")))))
  (create-instance 'Radio-Button-Obj2 Radio-Button
     (:left 160) (:top 200)
     (:text-on-left-p NIL)
     (:toggle-p T)
     (:selection-function #'(lambda (gadget value)
			      (format t "Button ~S " gadget)
			      (if value
				  (format t "selected.~%")
				  (format t "de-selected.~%")))))
  (opal:add-components Radio-Buttons-Top-Agg
		       Radio-Buttons-Obj Radio-Button-Obj
		       Radio-Button-Obj2)
  (format t "Leftdown on a radio button causes an inverse circle to be~%")
  (format t "superimposed on the button, executes the function locally~%")
  (format t "assigned to the button (if there is one), and executes the~%")
  (format t "function specified in :selection-function (if there is one).~%")
  (opal:update Radio-Buttons-Win))

#+garnet-debug 
(defun Radio-Buttons-Stop ()
  (opal:destroy Radio-Buttons-Win))
