;; Empire 
;; Copyright (C) 2001 Matt Chisholm
;; large parts of this code based on the "Crux" theme.jl file, by John Harper <jsh@eazel.com>
;; http://www.theory.org/~matt/sawfish/
#|
   This program is free software; you can redistribute it and/or
   modify it under the terms of the GNU General Public License as
   published by the Free Software Foundation; either version 2 of the
   License, or (at your option) any later version.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program; if not, write to the Free Software
   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|#

(require 'sawfish.wm.util.recolor-image)

(defgroup Empire "Empire Theme"
  :group appearance)

(defcustom Empire:active-decor-color nil
  "Color of focused window decorations (if unset uses the GTK+ selection color)."
  :type (optional color)
  :group (appearance Empire)
  :user-level novice
  :after-set (lambda () (color-changed)))

(defcustom Empire:active-bgrd-color nil
  "Color of focused window backgrounds (if unset uses the GTK+ selection color)."
  :type (optional color)
  :group (appearance Empire)
  :user-level novice
  :after-set (lambda () (color-changed)))

(defcustom Empire:inactive-decor-color nil
  "Color of unfocused window decorations (if unset uses the GTK+ selection color)."
  :type (optional color)
  :group (appearance Empire)
  :user-level novice
  :after-set (lambda () (color-changed)))

(defcustom Empire:inactive-bgrd-color nil
  "Color of unfocused window backgrounds (if unset uses the GTK+ selection color)."
  :type (optional color)
  :group (appearance Empire)
  :user-level novice
  :after-set (lambda () (color-changed)))


        (define topleft1 (list
         (make-image "top-left-1-a.png")
         (make-image "top-left-1-a.png")))
        (define topleft2 (list 
         (make-image "top-left-2-a.png")
         (make-image "top-left-2-a.png")))
        (define topleft3 (list 
         (make-image "top-left-3-a.png")
         (make-image "top-left-3-a.png")))
        (define topleftresize (list 
         (make-image "top-left-resize-i.png")
         (make-image "top-left-resize-a.png")
         (make-image "top-left-resize-h.png")
         (make-image "top-left-resize-p.png")))

	(define title-r (list
	 (make-image "title-r-a.png")
	 (make-image "title-r-a.png")))
	(define title-l (list
	 (make-image "title-l-a.png")
	 (make-image "title-l-a.png")))
	(define title (list
	 (make-image "title-a.png")
	 (make-image "title-a.png")))
        (define top (list 
         (make-image "top-a.png")
         (make-image "top-a.png")))

        (define topright1 (list 
         (make-image "top-right-1-a.png")
         (make-image "top-right-1-a.png")))
        (define topright2 (list 
         (make-image "top-right-2-a.png")
         (make-image "top-right-2-a.png")))
        (define topright3 (list 
         (make-image "top-right-3-a.png")
         (make-image "top-right-3-a.png")))
        (define toprightresize (list 
         (make-image "top-right-resize-i.png")
         (make-image "top-right-resize-a.png")
         (make-image "top-right-resize-h.png")
         (make-image "top-right-resize-p.png")))

        (define right1 (list 
         (make-image "right-1-a.png")
         (make-image "right-1-a.png")))
        (define right2 (list 
         (make-image "right-2-a.png")
         (make-image "right-2-a.png")))

        (define bottomright (list 
         (make-image "bottom-right-a.png")
         (make-image "bottom-right-a.png")
         (make-image "bottom-right-h.png")
         (make-image "bottom-right-p.png")))
        (define bottom (list 
         (make-image "bottom-a.png")
         (make-image "bottom-a.png")))
        (define bottomleft (list 
         (make-image "bottom-left-a.png")
         (make-image "bottom-left-a.png")
         (make-image "bottom-left-h.png")
         (make-image "bottom-left-p.png")))

        (define left1 (list 
         (make-image "left-1-a.png")
         (make-image "left-1-a.png"))) 
        (define left2 (list 
         (make-image "left-2-a.png")
         (make-image "left-2-a.png"))) 

	(define button-1 (list
	  (make-image "big-i.png")
	  (make-image "big-a.png")
	  (make-image "big-h.png")
	  (make-image "big-p.png")))
	(define button-4 (list
	  (make-image "small-i.png")
	  (make-image "small-a.png")
	  (make-image "small-h.png")
	  (make-image "small-p.png")))
	(define button-3 (list
 	  (make-image "big-i.png")
	  (make-image "big-a.png")
	  (make-image "big-h.png")
	  (make-image "big-p.png")))
	(define button-2 (list
	  (make-image "small-i.png")
	  (make-image "small-a.png")
	  (make-image "small-h.png")
	  (make-image "small-p.png")))

	(define bottom-d (list
	  (make-image "bottom-d-a.png")
	  (make-image "bottom-d-a.png")
	  (make-image "bottom-d-h.png")
	  (make-image "bottom-d-p.png")))
	(define bottom-s (list
	  (make-image "bottom-s.png")
	  (make-image "bottom-s.png")))
	(define title-r-s (list
	 (make-image "title-r-a-s.png")
	 (make-image "title-r-a-s.png")))
	(define title-l-s (list
	 (make-image "title-l-a-s.png")
	 (make-image "title-l-a-s.png")))
	(define title-b-s (list
	 (make-image "title-b-s.png")
	 (make-image "title-b-s.png")))

        (define topright2s (list 
         (make-image "top-right-2-a-s.png")
         (make-image "top-right-2-a-s.png")))
        (define topleft2s (list 
         (make-image "top-left-2-a-s.png")
         (make-image "top-left-2-a-s.png")))


   (define title-width
      (lambda (w)
        (let
          ((w-width (car (window-dimensions w))))
          (max 0 (min (- w-width 100) (text-width (window-name w) 
          ))))))

     (define thumb-half-width
      (lambda (w)
        (/ (- (car (window-dimensions w)) (title-width w)) 2)))

     (define half-width 
      (lambda (w)
        (/ (car (window-dimensions w)) 2)))

    (define title-pad 10)

;; initialization
(define initialize-gtkrc
  (let ((done nil))
    (lambda ()
      (unless done
        (require 'gtkrc)
        ;; recolour everything when the GTK theme changes
        (gtkrc-call-after-changed color-changed)
        (setq done t)))))

;; get colors from config, fall back to gtk colors otherwise
(define (a-d-col)
  (if (colorp Empire:active-decor-color)
      Empire:active-decor-color
    (initialize-gtkrc)
    (if (colorp (nth 3 gtkrc-background))
        (nth 3 gtkrc-background)
      (get-color "steelblue"))))

(define (a-b-col)
  (if (colorp Empire:active-bgrd-color)
      Empire:active-bgrd-color
    (initialize-gtkrc)
    (if (colorp (nth 3 gtkrc-background))
        (nth 3 gtkrc-background)
      (get-color "steelblue"))))

(define (i-d-col)
  (if (colorp Empire:inactive-decor-color)
      Empire:inactive-decor-color
    (initialize-gtkrc)
    (if (colorp (nth 3 gtkrc-background))
        (nth 3 gtkrc-background)
      (get-color "steelblue"))))

(define (i-b-col)
  (if (colorp Empire:inactive-bgrd-color)
      Empire:inactive-bgrd-color
    (initialize-gtkrc)
    (if (colorp (nth 3 gtkrc-background))
        (nth 3 gtkrc-background)
      (get-color "steelblue"))))

;; font colors
;;(define font-colors ( list "#bfbfbf" "#efefef" ))
;;(define font-colors ( list i-d-col a-d-col ))
;;(define font-colors ( list Empire:inactive-decor-color Empire:active-decor-color))
;; why doesn't this change the font colors when the images are recolored?
(define (font-colors)
	(list 
  (if (colorp Empire:inactive-decor-color)
      Empire:inactive-decor-color
    (initialize-gtkrc)
    (if (colorp (nth 3 gtkrc-background))
        (nth 3 gtkrc-background)
      (get-color "steelblue")))
  (if (colorp Empire:active-decor-color)
      Empire:active-decor-color
    (initialize-gtkrc)
    (if (colorp (nth 3 gtkrc-background))
        (nth 3 gtkrc-background)
      (get-color "steelblue")))
	)
)

;; frames
       (define frame `(
	;;top edge
         ((left-edge . 8)
          (right-edge . 8)
          (top-edge . -24)
          (background . ,top)
          (class . top-border))
	;;bottom edge
         ((left-edge . -1)
          (right-edge . -1)
          (bottom-edge . -6)
          (background . ,bottom)
          (class . bottom-border))

	;; top left corner
         ((class . top-left-corner)
	  (top-edge . -13)
          (left-edge . -43)
          (background . ,topleft1))
         ((class . top-left-corner)
	  (top-edge . 52)
          (left-edge . -21)
          (background . ,topleft3))
         ((class . top-left-corner)
	  (top-edge . -24)
          (left-edge . -8)
          (background . ,topleft2))
         ((class . top-left-corner)
	  (top-edge . -22)
          (left-edge . -20)
          (background . ,topleftresize))

	;; bottom left corner
         ((bottom-edge . -12)
          (left-edge . -27)
          (background . ,bottomleft)
          (class . bottom-left-corner))

	;; top right corner
         ((top-edge . -13)
          (background . ,topright1)
          (right-edge . -43)
          (class . top-right-corner))
         ((top-edge . 52)
          (background . ,topright3)
          (right-edge . -21)
          (class . top-right-corner))
         ((top-edge . -24)
          (background . ,topright2)
          (right-edge . -8)
          (class . top-right-corner))
         ((class . top-right-corner)
	  (top-edge . -22)
          (right-edge . -20)
          (background . ,toprightresize))

	;; bottom right corner
         ((right-edge . -27)
          (background . ,bottomright)
          (bottom-edge . -12)
          (class . bottom-right-corner))

	;; left edge
         ((top-edge . 76)
          (bottom-edge . 54)
          (left-edge . -8)
          (background . ,left1)
          (class . left-border))
         ((top-edge . 76)
          (bottom-edge . 54)
          (left-edge . -12)
          (background . ,left2)
          (class . left-border))

	;; right edge
         ((top-edge . 76)
          (right-edge . -8)
          (bottom-edge . 54)
          (background . ,right1)
          (class . right-border))
         ((top-edge . 76)
          (right-edge . -12)
          (bottom-edge . 54)
          (background . ,right2)
          (class . right-border))

	;; bottom decoration
	 ((class . bottom-border)
	  (background . ,bottom-d)
	  (bottom-edge . -15)
	  (left-edge . ,(lambda (w) (- (half-width w) 23)))
	  (right-edge . ,(lambda (w) (- (half-width w) 23))))

	;; title bookends
	 ((class . title)
	  (right-edge . ,(lambda (w) (- (thumb-half-width w) title-pad 13)))
	  (top-edge . -33)
	  (background . ,title-r))
	 ((class . title)
	  (left-edge . ,(lambda (w) (- (thumb-half-width w) title-pad 13)))
	  (top-edge . -33)
	  (background . ,title-l))

	;; title
         ((left-edge . ,(lambda (w) (- (thumb-half-width w) title-pad)))
	  (right-edge . ,(lambda (w) (- (thumb-half-width w) title-pad)))
          (top-edge . -33)
          (width . ,(lambda (w) (+ (title-width w) title-pad title-pad )))
          (y-justify . center)
          (x-justify . center)
          (text . ,window-name)
	  (foreground . ,font-colors)
;;	  (font . ,font)
          (background . ,title)
          (class . title))

	;; big buttons
	 ((class . close-button)
	  (left-edge . -32)
	  (top-edge . -6)
	  (background . ,button-1))
	 ((class . maximize-button)
	  (right-edge . -31)
	  (top-edge . -6)
	  (background . ,button-3))

	;; small buttons
	 ((class . iconify-button)
	  (right-edge . -29)
	  (top-edge . 25)
	  (background . ,button-2))
	 ((class . menu-button)
	  (left-edge . -30)
	  (top-edge . 25)
	  (background . ,button-4))
    ))

(define shaped-frame `( 
	;; top edge
         ((left-edge . 8)
          (right-edge . 8)
          (top-edge . -24)
          (background . ,top)
          (class . title))
	;;shaded bottom
	 ((top-edge . -1)
	  (left-edge . 8)
	  (right-edge . 8)
	  (background . ,bottom-s)
	  (class . title))

	;; top right corner
         ((top-edge . -24)
          (background . ,topright2s)
          (right-edge . -8)
          (class . title))
	;; top left corner
         ((class . title)
	  (top-edge . -24)
          (left-edge . -8)
          (background . ,topleft2s))

	;; title bookends
	 ((class . title)
	  (right-edge . ,(lambda (w) (- (thumb-half-width w) title-pad 13)))
	  (top-edge . -33)
	  (background . ,title-r-s))
	 ((class . title)
	  (left-edge . ,(lambda (w) (- (thumb-half-width w) title-pad 13)))
	  (top-edge . -33)
	  (background . ,title-l-s))
	;; title
         ((left-edge . ,(lambda (w) (- (thumb-half-width w) title-pad)))
	  (right-edge . ,(lambda (w) (- (thumb-half-width w) title-pad)))
          (top-edge . -33)
          (width . ,(lambda (w) (+ (title-width w) title-pad title-pad )))
          (y-justify . center)
          (x-justify . center)
          (text . ,window-name)
	  (foreground . ,font-colors)
;;	  (font . ,font)
          (background . ,title)
          (class . title))

	;; bottom shaded title
	((left-edge . ,(lambda (w) (- (thumb-half-width w) title-pad)))
	  (right-edge . ,(lambda (w) (- (thumb-half-width w) title-pad)))
	  (width . ,(lambda (w) (+ (title-width w) title-pad title-pad )))
	  (top-edge . -1)
          (background . ,title-b-s)
          (class . title))
))

;; Recolor all images that need recolouring. Precalculates the lookup
;; tables first.
(define (recolor-all)
  ;; Use the SELECTED state of the background colors as the
  ;; midpoint of the gradient for recolouring images. (This is
  ;; usually a bright, contrasting colour, and thus is the
  ;; best choice. It works particularly well with the Eazel-Foo
  ;; themes)
  (let ((recolor-a-d (make-image-recolorer (a-d-col)
                                         #:zero-channel red-channel
                                         #:index-channel green-channel))

        (recolor-a-b (make-image-recolorer (a-b-col)
                                         #:zero-channel red-channel
                                         #:index-channel green-channel))

	(recolor-i-d (make-image-recolorer (i-d-col)
                                         #:zero-channel red-channel
                                         #:index-channel green-channel))

        (recolor-i-b (make-image-recolorer (i-b-col)
                                         #:zero-channel red-channel
                                         #:index-channel green-channel)))

    (mapc (lambda (x) (mapc recolor-a-d (cdr x)))
          (list topleft1 topright1 title title-l title-r title-l-s title-r-s
		title-b-s bottomleft bottomright left1 right1 bottom-d ))

    (mapc (lambda (x) (recolor-i-d ( car x )))
          (list topleft1 topright1 title title-l title-r title-l-s title-r-s
		title-b-s bottomleft bottomright left1 right1 bottom-d ))

    (mapc (lambda (x) (mapc recolor-a-b (cdr x)))
          (list top topright2 topright3 topleft2 topleft3 
		topright2s topleft2s left2 right2 bottom bottom-s))

    (mapc (lambda (x) (recolor-i-b ( car x )))
          (list top topright2 topright3 topleft2 topleft3 
		topright2s topleft2s left2 right2 bottom bottom-s))
))


(define (reframe-all)
  (reframe-windows-with-style 'Empire))

(define (color-changed)
  (recolor-all)
  (reframe-all))

  (recolor-all)

  (add-frame-style 'Empire
                   (lambda (w type)
                     (case type
                       ((default) frame)
                       ((transient) frame)
                       ((shaped) shaped-frame)
                       ((shaped-transient) shaped-frame))))

  (call-after-property-changed
   'WM_NAME (lambda ()
              (rebuild-frames-with-style 'Empire)))
