; ICON with window name embedded into 8 XPM pixmaps
; =================================================

;;File: term-icon-xpm.gwm
;; usage:
;;     (term-icon-xpm name-radix font text-background-color text-color)
;; builds an icon by adding 8 xpm files around the name of the icon
;; xpm files are built by appending to "name-radix" the strings
;; "-nw.xpm", "-n.xpm", "-ne.xpm", "-e.xpm" "-se.xpm", "-s.xpm", "-sw.xpm",
;; "-w.xpm" in clockwise order from top left.
;; the global variable  term-icon:background can be set to a color that would 
;; override the symbolic color "background" in the xpm files if present
;; text-background-color and text-color are used to create the text colors, 
;; but override also the symbolic color names "fore" and "back" in the
;; pixmaps


;;=============================================================================
;;                    define the screen-dependent resources
;;=============================================================================


;; fsm
;;====

(: term-icon-xpm:plug-fsm
  (fsm-make
    (state-make
      icon-behavior
      (on (user-event 'get-title)
	(term-icon-xpm:update-plug update-icon.title))
      (on (user-event 'get-icon)
	(term-icon-xpm:update-plug window-icon-name))
      standard-behavior
)))

(de term-icon-xpm:update-plug (string)
  (with-eval (wob-property)
    (wob-tile (label-make string))
    (update-placements)
))

(if (not (boundp 'term-icon:background))
  (setq term-icon:background black)
)

;;=============================================================================
;;                    The deco
;;=============================================================================

(defun term-icon-xpm (term-icon:name term-icon:font term-icon:back
    term-icon:fore
  )
  (with-eval
    (get-context (std-resource-get 'TermIconXpm 'term-icon-xpm))
    (with (fsm icon-fsm
	grabs icon-grabs menu 'icon-pop
	bar-min-width 0 bar-max-width 100
	borderwidth 0
      )
      (window-make 
	(with (tile (term-icon:tile "n"))
	  (bar-make   
	    (plug-make (term-icon:tile "nw"))
	    ()
	    (plug-make (term-icon:tile "ne"))
	))
	(with (tile (term-icon:tile "w")) (bar-make  ))
	(with (tile (term-icon:tile "e")) (bar-make  ))
	(with (tile (term-icon:tile "s"))
	  (bar-make   
	    (plug-make (term-icon:tile "sw"))
	    ()
	    (plug-make (term-icon:tile "se"))
	))
	(with (fsm term-icon-xpm:plug-fsm
	    property (list 'font term-icon:font 'foreground term-icon:fore
	      'background term-icon:back
	      'label-horizontal-margin 0
	      'label-vertical-margin 0)
	    font term-icon:font
	    foreground term-icon:fore
	    background term-icon:back
	    label-horizontal-margin 0
	    label-vertical-margin 0
	  )
	  (plug-make 
	    (label-make window-icon-name))))
)))

(defun term-icon:tile (name)
  (pixmap-load (+ term-icon:name "-" name ".xpm")
    'back term-icon:back
    'fore term-icon:fore
    'background term-icon:background
))