;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10.; Package: XIT -*-
;;;__________________________________________________________________________
;;;
;;;                       System: XIT
;;;                       Module: Icons
;;;                       (Version 1.0)
;;;
;;; Copyright (c): Forschungsgruppe DRUID, Juergen Herczeg
;;;                Universitaet Stuttgart
;;;
;;; File: /usr/local/lisp/xit/kernel/icons.lisp
;;; File Creation Date: 6/23/89 10:31:37
;;; Last Modification Time: 09/29/92 17:10:06
;;; Last Modification By: Juergen Herczeg
;;;
;;;
;;; Changes (worth to be mentioned):
;;; ================================
;;;
;;; 05/15/90 (Juergen)  the initialization list for buttons may have an 
;;;                     additional keyword parameter action-docu which 
;;;                     specifies the left-button mouse-documentation for 
;;;                     the button
;;; 01/25/1991 (Juergen) class icon specifies basic-layouter as default  
;;; 04/25/1991 (Matthias) New: action-button, mostly like soft-bar, but knows
;;;                       its size, very handy for paned-windows
;;; 05/02/1991 (Hubertus) for class text-icon: a text-part is always created
;;;                       unless the text-part init option is specified as :none.
;;; 04/07/1992 (Juergen) New class action-mixin which may be used to associate
;;;                      an interaction object with an action and an action
;;;                      docu.  The action is performed when the event
;;;                      specified by method action-event-type occurs, which
;;;                      defaults to :select.  It is used by
;;;                      the class soft-button.
;;;
;;; 04/07/1992 (Juergen) Class soft-button is now supposed to subsume
;;;                      behavior of soft-bar and action-button.  Its
;;;                      resources have been changed to those of action-button,
;;;                      e.g., the button now defaults to "button-m" the
;;;                      font to size 12.  This creates a slight 
;;;                      incompatibility for soft-button to previous versions.
;;;                      Note that class soft-bar has been removed, class
;;;                      action-button still exists but should be removed
;;;                      in future versions.  Both can be substituted
;;;                      by class soft-button, the one and only button class
;;;                      in the near future
;;;
;;; 04/07/1992 (Juergen) Code for adjusting the size of a button has been
;;;                      removed from the initialize-instance methods
;;;                      of class soft-button and action-button.  It
;;;                      seems to be obsolete now.
;;;
;;; 04/15/1992 (Juergen) The action specified for objects of type action-mixin
;;;                      may now be either a single action or a list of
;;;                      actions (which has already been the case for
;;;                      actions specified for menu entries).
;;;
;;; 07/16/1992 (Juergen) Added methods actions and (setf actions) for class
;;;                      action-mixin
;;;
;;; 09/29/1992 (Juergen) Resource default for cursor of soft-button changed
;;;                      to "hand2".
;;;__________________________________________________________________________

(in-package :xit)

;____________________________________________________________________________
;
;                                   Icons
;____________________________________________________________________________

(defcontact icon (intel)
  ((name :initform :icon)
   (layouter :initform 'basic-layouter))
  (:resources
   (inside-border :initform 0))
  (:documentation "icons are intels containing a bitmap-part
                   initialized by the initarg :bitmap-part"))

(defmethod initialize-instance :after ((self icon) &rest init-list
				       &key bitmap-part)
   (declare (ignore init-list))
   (unless (eq bitmap-part :none)
       (apply #'add-part self
	      :class (or (getf bitmap-part :class) 'bitmap-dispel)
	      bitmap-part)))

(defcontact text-icon (icon)
  ()
  (:documentation "text-icons are icons containing a text-part
                   initialized by the initarg :text-part"))

(defmethod initialize-instance :after ((self text-icon) &rest init-list
				       &key text-part)
   (declare (ignore init-list))
   (unless (eq text-part :none)
     (let ((part (apply #'add-part self
			:class (or (getf text-part :class) 'text-dispel)
			text-part)))
       (change-priority part :above))))

;____________________________________________________________________________
;
;                          Action Mixin
;____________________________________________________________________________

;; mixin class which can be used for interaction-windows to associate
;; an interaction object with an action and an actio-docu

(defclass action-mixin ()
  ())

(defmethod action-event-type ((self action-mixin))
  :select)

(defmethod initialize-instance :after ((self action-mixin) &rest init-list
				       &key action action-docu)
   (declare (ignore init-list))
   (when action
     (let* ((action-list (if (and (listp action) (listp (car action)))
			     action
			   (list action)))
	    (docu-and-actions (if action-docu
				  (cons action-docu action-list)
				action-list))
	    (event-key (action-event-type self)))
       (apply #'change-reactivity self event-key docu-and-actions))))

(defmethod actions ((self action-mixin))
  (let ((actions (reactivity-actions-for self (action-event-type self))))
    (when (consp actions)
      actions)))

(defmethod (setf actions) (new-actions (self action-mixin))
  (let* ((action-event (action-event-type self))
	 (documentation
	  (reactivity-documentation-for self action-event)))
    (apply #'change-reactivity self
	   action-event 
	   (if documentation  documentation "")
	   new-actions)))

;____________________________________________________________________________
;
;                               Buttons
;____________________________________________________________________________

(defcontact soft-button (action-mixin text-icon)
  ((name :initform :soft-button)
   (layouter :initform '(basic-layouter :alignment :center))
   (mouse-feedback-border-width :initform 2 :allocation :class))
  (:documentation "soft-buttons are text-icons which trigger an
                   an action when clicked on with the left mouse button.
                   They provide a default bitmap and cursor.
                   However, when there is no bitmap-part
                   (:bitmap-part :none), the button is presented as
                   a bordered text"))

(define-resources
  (* soft-button cursor) "hand2" ;; formerly "dot"
  (* soft-button bitmap-dispel bitmap) "button-m"
  (* soft-button :text background) "white"
  (* soft-button :text font) '(:face :normal :size 12)
  )

(defmethod initialize-instance :after ((self soft-button) &rest init-list
				       &key border-width)
   (declare (ignore init-list))
   (unless (part self :bitmap)
     (when (part self :text) ;; button contains only text, no bitmap
       (unless border-width (change-window-border-width self 2)))))

;; to be removed later
(defcontact action-button (soft-button)
  ())

(defmethod initialize-instance :after ((self action-button) &rest init-list)
  (warn "Use class soft-button instead of action-button"))

(define-resources
  (* action-button cursor) "dot"
  (* action-button bitmap-dispel bitmap) "button-m"
  (* action-button :text background) "white"
  (* action-button :text font) '(:face :normal :size 12)
  )

;_____________________________________________________________________________
;
;                        Special window icons
;_____________________________________________________________________________

(defmethod get-default-icon ((self window-icon-mixin) &rest init-list)
  (apply #'make-window 'soft-button
	 :background "white"
	 :inside-border 2
	 :text-part `(:text ,(string (contact-name self)))
	 :bitmap-part :none
	 :reactivity '((:move))
         init-list))

(defmethod get-default-icon ((self title-window) &rest init-list)
  (apply #'make-window 'soft-button
	 :background "white"
	 :inside-border 2
	 :text-part `(:text ,(title self))
	 :bitmap-part :none
	 :reactivity '((:move))
         init-list))


