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

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

floatbg.el 0.1


From: John Paul Wallington
Subject: floatbg.el 0.1
Date: 07 Nov 2001 02:29:57 +0000
User-agent: Gnus/5.090003 (Oort 0.03) XEmacs/21.1.10 (i386-debian-linux)

Any comments and improvements welcome.  Could someone tell me how to set
the background colour for GNU Emacs 20?

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

;; Copyright (C) 2001 John Paul Wallington

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

;; This file is not part of GNU 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 colour by moving through an hsv colour model, like 
;; floatbg for X-Windows by Jan Rekers.

;;; Code:

(defvar floatbg-hue (random 360))
(defvar floatbg-sat 0.4)
(defvar floatbg-val 0.88)

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

(defvar floatbg-delay 15
  "* Delay in seconds before calling `floatbg-change'.")

(defvar floatbg-mode nil
  "Mode variable for floatbg mode.")

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

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

(defun floatbg-change ()
  "Change background colour, imperceptibly."
  (setq floatbg-hue (mod (1+ floatbg-hue) 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)))
    (set-face-background 'default background)))

(defun floatbg-hsv-to-rgb-string (h s v)
  "Convert colour 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)))

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

-- 
John Paul Wallington




reply via email to

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