; SIMPLE ICON  DECORATION
; =======================

;;Author: colas@mirsa.inria.fr (Colas NAHABOO) -- Bull Research FRANCE
;;Revision: 1.6 -- Mar. 1, 1990

; A simple icon "a la Mac", following fully the ICCCs

(declare-screen-dependent
  simple-icon.screen-data
  simple-icon.foreground
  simple-icon.background
  simple-icon.borderpixel
  simple-icon.context)

(defaults-to
  simple-icon.legend ()
  simple-icon.borderwidth 1
  simple-icon.plug-name ()
  simple-icon.no-center-plug ()
  simple-icon.label ()
  simple-icon.stretch ()
  simple-icon.font small-font
)

;; define here the screen-dependent resources
(if (not (boundp 'simple-icon))	;define only once
  (with (wob wob)

      ;; user-settable defaults
    (for screen (list-of-screens)
      (defaults-to
	simple-icon.foreground black
	simple-icon.background white
	simple-icon.borderpixel black)

      (setq simple-icon.context
            '(font simple-icon.font
              legend simple-icon.legend
              foreground simple-icon.foreground
              background simple-icon.background
              borderwidth simple-icon.borderwidth
              borderpixel simple-icon.borderpixel
              label simple-icon.label
              stretch simple-icon.stretch
      )))

))

(: simple-icon.title-fsm
  (fsm-make
    (state-make
      icon-behavior
      (on (user-event 'get-title) (update-plug-in-icon update-icon.title))
      (on (user-event 'get-icon) (update-plug-in-icon window-icon-name))
     ;; if icon pixmap set after creation, redecorate.
      (on (user-event 'icon-pixmap-change)
	(if (# 'no-center-plug window)
	  (re-decorate-window)))
      standard-behavior
)))

(de simple-icon.center-plug ()
  (if (not simple-icon.no-center-plug)
      (or (window-icon-window)
          (with (tmp (std-resource-get 'GwmIconPixmap))
            (if (not (= (type tmp) 'pixmap))
                (progn
                  (: tmp (eval tmp))
                  (if (and tmp (# (type tmp) string-types))
                      (: tmp (pixmap-make tmp)))))
            (if (and tmp (= (type tmp) 'pixmap))
                (plug-make tmp)))
          (with (tmp (window-icon-pixmap)
                 fsm icon-center-plug-with-pixmap-hint-fsm)
            (if tmp
                (plug-make tmp))))
    (window-icon-window)))

(: icon-center-plug-with-pixmap-hint-fsm (fsm-make
    (state-make
      (on (buttonrelease 2 any) (progn (iconify-window)(raise-window)))
      (on (user-event 'icon-pixmap-change)
	(with-eval (# 'context wob)
	  (wob-tile (window-icon-pixmap))
	  (update-placements)))
      icon-behavior
      standard-behavior
)))

(de update-plug-in-icon (string)
  (with-eval (# 'context wob)
    (wob-tile (label-make (simple-icon.process-label string)))
    (update-placements)
))

(de simple-icon.process-label (text)
  (with (new-label
      (if label
	(if 
	  (= (type label) 'string)
	  label
	  (eval (list label text))
	)
	text
    ))
    (if (and (= (type new-label) 'string) (not (= "" new-label)))
      new-label
      text
    )
))

(de simple-icon.label-plug ()
  (with (borderwidth 0
         fsm simple-icon.title-fsm)
    (plug-make 
      (label-make (if simple-icon.plug-name
                      simple-icon.plug-name
                      (simple-icon.process-label window-icon-name))))))


(de simple-icon args
  (with-eval
    (+ simple-icon.context
      (get-context (std-resource-get 'SimpleIcon 'simple-icon))
      args
    )
    (with (fsm icon-fsm
	   context (context-save simple-icon.context)
	   menu 'icon-pop
           grabs icon-grabs
           center-plug (simple-icon.center-plug)
           property (+ (list 'context context
                             'no-center-plug (not center-plug)) property)
           label-plug (if (or legend (not center-plug))
                          (simple-icon.label-plug))
           inner-borderwidth 0
           )
      (if (not center-plug)
            (window-make () () () () label-plug)
          (not legend)
            (window-make () () () () center-plug)
          (not stretch)
            (with (bar (with (borderwidth 0) (bar-make () label-plug ())))
              (if (= legend "top")
                    (window-make bar () () () center-plug)
                  (= legend "left")
                    (window-make () bar () () center-plug)
                  (= legend "right")
                    (window-make () () bar () center-plug)
                    (window-make () () () bar center-plug)))
          (or (= legend "left") (= legend "right"))
            (with (inner-borderwidth borderwidth 
                   borderwidth 0
                   plug-separator 0
                   tile t	;transparent background for stretch
                   lab (if (= stretch "down")
                           (bar-make label-plug ())
                         (= stretch "up")
                           (bar-make () label-plug)
                           (bar-make () label-plug ()))
                   cent (if (= stretch "down")
                           (bar-make center-plug ())
                         (= stretch "up")
                           (bar-make () center-plug)
                           (bar-make () center-plug ()))
                   bar (if (= legend "left")
                           (bar-make lab cent)
                         (bar-make cent lab)))
              (if (not (= (type center-plug) 'plug))
                  (window-make ()
                               (if (= legend "left") lab)
                               (if (= legend "right") lab)
                               ()
                               center-plug)
                (window-make bar () () () ())))
          t
            (with (inner-borderwidth borderwidth 
                   borderwidth 0
                   tile t	;transparent background for stretch
                   bar (if (= stretch "left")
                           (bar-make () label-plug)
                         (= stretch "right")
                           (bar-make label-plug ())
                           (bar-make () label-plug ())))
              (window-make (if (= legend "top") bar ())
                           (if (not (= stretch "right"))
                               (bar-make ())
                             ())
                           (if (not (= stretch "left"))
                               (bar-make ())
                             ())
                           (if (not (= legend "top")) bar ())
                           center-plug))))))