gnu-emacs-sources
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

floatbg.el 0.4


From: John Paul Wallington
Subject: floatbg.el 0.4
Date: 08 Nov 2001 16:04:03 +0000
User-agent: Gnus/5.090003 (Oort 0.03) XEmacs/21.1.10 (i386-debian-linux)

Changes:
-added floatbg-mode toggle on customize
-made shape of sinus customizable
-added derived from time of day switch to floatbg-initial-hue

posted on my website:
http://www.shootybangbang.com/jpw/software/floatbg.el

any comments, criticism, fixes, etc. gladly received...

;;; floatbg.el --- slowly modify background color

;; Copyright (C) 2001 John Paul Wallington

;; Author:  John Paul Wallington <address@hidden>
;; Created: 07 Nov 2001
;; Version: 0.4, 08 Nov 2001
;; Keywords: background frames faces

;; This file isn't part of Emacs.

;; 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, 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.

;;; Commentary:

;; Modifies backgound color by moving through an hsv color model, like 
;; floatbg for X-Windows by Jan Rekers.

;; Installation:
;; Put floatbg.el somewhere in your load-path.
;; Put the following two lines in your .emacs file:
;; (require 'floatbg)
;; (floatbg-mode t)


;;; Code:

;; Customize options

(defgroup floatbg nil
  "Slowly modify background color by moving through an HSV color model."
  :tag "Floating Background"
  :group 'frames
  :prefix "floatbg-")


(defcustom floatbg-mode nil
  "Toggle `floatbg-mode' on/off."
  :type 'boolean
  :tag "Toggle floatbg-mode on/off."
  :initialize 'custom-initialize-default
  :set (lambda (symbol value) (floatbg-mode value))
  :require 'floatbg
  :group 'floatbg)


(defcustom floatbg-delay 15
  "* Delay in seconds before changing color."
  :type 'number
  :group 'floatbg)


(defcustom floatbg-increment 1
  "* Size of increment of Hue in degrees when changing color."
  :type 'number
  :group 'floatbg)


(defcustom floatbg-initial-hue t
  "* Initial value of Hue (in HSV model) in degrees."
  :type '(choice integer
                 (const :tag "Derived from time of day" t)
                 (const :tag "Random" nil))
  :group 'floatbg)


(defun floatbg-set-sat-or-val (symbol value)
  (if (and (numberp value)
           (< 0.0 value)
           (< value 1.0))
      (set-default symbol value)
    (error "please set %s to more than 0.0 and less than 1.0"
           (symbol-name symbol))))


(defcustom floatbg-initial-sat 0.4
  "* Initial value of Saturation (in HSV model); should be > 0.0 and < 1.0."
  :type '(number :tag "Number more than 0.0 and less than 1.0")
  :set 'floatbg-set-sat-or-val
  :group 'floatbg)


(defcustom floatbg-initial-val 0.88
  "* Initial value of Value (in HSV model); should be > 0.0 and < 1.0."
  :type '(number :tag "Number more than 0.0 and less than 1.0")
  :set 'floatbg-set-sat-or-val
  :group 'floatbg)


(defvar floatbg-smid 0.375)
(defvar floatbg-svar 0.125)
(defvar floatbg-sfinhf 0.25)

(defun floatbg-set-sinus-shape (symbol value)
  (let ((smid (car value))
        (svar (car (cdr value)))
        (sfinhf (car (cdr (cdr value)))))
    (unless (null value) 
      (if (and (>= 1 (- smid svar))
               (>= 1 (+ smid svar))
               (<= 0 (- smid svar))
               (<= 0 (+ smid svar)))
          (setq floatbg-smid smid 
                floatbg-svar svar 
                floatbg-sfinhf sfinhf)
        (error "Invalid parameters.")))))


(defcustom floatbg-sinus-shape nil
  "* The sinus shape.
 Unquoted list containing smid, svar and sfinhf parameters.
 The default is (0.375 0.125 0.25).
 smid + svar and smid - svar should fall between 0 and 1."
  :type '(choice (const :tag "Default" nil)
                 (sexp :tag "Specify List"))
  :set 'floatbg-set-sinus-shape
  :group 'floatbg)
  

(defcustom floatbg-reset-on-toggle nil
  "* Reset colors to initial values when toggling `floatbg-mode'?"
  :type '(choice (const :tag "Yes" t)
                 (const :tag "No" nil))
  :group 'floatbg)


;; variables

(defvar floatbg-timer nil
  "Timer handle for floatbg mode.")

(defvar floatbg-hue
  (if (equal floatbg-initial-hue t)
      (* (1+ (car (nthcdr 2 (decode-time)))) 15)
    (or floatbg-initial-hue (random 360))))

(defvar floatbg-sat floatbg-initial-sat)
(defvar floatbg-val floatbg-initial-val)

;; Functions

;;;###autoload
(defun floatbg-mode (&optional arg)
  "Toggle floatbg mode"
  (interactive "P")
  (if floatbg-timer (cancel-timer floatbg-timer))
  (when (setq floatbg-mode
              (if (null arg)
                  (not floatbg-mode)
                (> (prefix-numeric-value arg) 0)))
    (if floatbg-reset-on-toggle
        (floatbg-reset-initial-values))
    (setq floatbg-timer
          (run-at-time 1 floatbg-delay 'floatbg-change)))
  (message "floatbg-mode now %s" (if floatbg-mode "on" "off")))


(defun floatbg-change ()
  "Change background color, imperceptibly."
  (setq floatbg-hue (mod (+ floatbg-hue floatbg-increment) 360)
        floatbg-sat (- floatbg-smid 
                       (* floatbg-svar
                          (sin (* (/ pi 180) floatbg-sfinhf floatbg-hue)))))
  (let ((background
         (floatbg-hsv-to-rgb-string floatbg-hue floatbg-sat floatbg-val))
        (frames (frame-list)))
    (while frames
      (modify-frame-parameters (car frames) 
                               (list (cons 'background-color background)))
      (setq frames (cdr frames)))
    (set-face-background 'default background)))


(defun floatbg-hsv-to-rgb-string (h s v)
  "Convert color in HSV values to RGB string."
  (setq h (degrees-to-radians h))
  (let (r g b)
    (if (zerop s)
        (setq r v g v b v)
      (let* ((h (/ (if (>= h (* 2 pi)) 0.0 h)
                   (/ pi 3)))
             (i (truncate h))
             (f (- h i)))
        (let ((p (* v (- 1.0 s)))
              (q (* v (- 1.0 (* s f))))
              (z (* v (- 1.0 (* s (- 1.0 f))))))
          (cond ((eq i 0) (setq r v g z b p))
                ((eq i 1) (setq r q g v b p))
                ((eq i 2) (setq r p g v b z))
                ((eq i 3) (setq r p g q b v))
                ((eq i 4) (setq r z g p b v))
                ((eq i 5) (setq r v g p b q))))))
    (setq r (* r 255) g (* g 255) b (* b 255))
    (format "#%.2X%.2X%.2X" r g b)))


(defun floatbg-reset-initial-values ()
  "Reset floatbg colors to initial values.  Recalulate them if appropriate."
  (interactive)
  (setq floatbg-hue 
        (if (equal floatbg-initial-hue t)
            (* (1+ (car (nthcdr 2 (decode-time)))) 15)
          (or floatbg-initial-hue (random 360))))
  (setq floatbg-val floatbg-initial-val))


(provide 'floatbg)
;;; floatbg.el ends here


-- 
John Paul Wallington




reply via email to

[Prev in Thread] Current Thread [Next in Thread]