[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
floatbg.el 0.2
From: |
John Paul Wallington |
Subject: |
floatbg.el 0.2 |
Date: |
07 Nov 2001 17:37:33 +0000 |
User-agent: |
Gnus/5.090003 (Oort 0.03) XEmacs/21.1.10 (i386-debian-linux) |
Changes - works on GNU Emacs 20.7.
Comments and improvements welcome.
;;; floatbg.el --- slowly modify background colour
;; Copyright (C) 2001 John Paul Wallington
;; Author: John Paul Wallington <address@hidden>
;; Created: 07 Nov 2001
;; Version: 0.2, 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 "floatbg-mode now %s" (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))
(frames (frame-list))
(sfpbound (fboundp 'set-frame-property)))
(while frames
(if sfpbound
(set-frame-property (car frames) [default background] background)
(modify-frame-parameters (car frames)
(list (cons 'background-color background)))
(set-face-background 'default background))
(setq frames (cdr frames)))))
(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
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- floatbg.el 0.2,
John Paul Wallington <=