;;; -*- lexical-binding: t -*-
;;
;; this file:
;;   https://dataswamp.org/~incal/bad/bad-alpha.el

(defun bad-alpha-set (&optional alpha)
  (or alpha (setq alpha 0.6))
  (set-frame-parameter nil 'alpha-background alpha))

(defun bad-alpha-opaque ()
  (interactive)
  (bad-alpha-set 1.0))

(defun bad-alpha-get ()
  (frame-parameter nil 'alpha-background))

(defun bad-alpha-more (&optional inc)
  (or inc (setq inc 0.1))
  (unless (bad-alpha-get)
    (bad-alpha-set 1.0))
  (let* ((abg (bad-alpha-get))
         (abg-new (+ inc abg)))
    (bad-alpha-set (min 1.0 (max 0.0 abg-new)))
    (message "bg alpha: %0.1f" (bad-alpha-get))))

(defun bad-alpha-less (&optional dec)
  (or dec (setq dec 0.1))
  (bad-alpha-more (- dec)))

;; TODO: bug
(let* ((amin 0)
       (amax 1)
       (dir (/ (- amax amin) 100.0)))
  (defun alpha ()
    (interactive)
    (let ((a (frame-parameter nil 'alpha))
          (set-a))
      (if a
          (setq set-a (+ a dir))
        (setq set-a dir))
      (when a
        (if (not (< 0 a))
            (progn
              (setq set-a (+ amin (abs dir)))
              (setq dir dir))
          (unless (< a 1)
            (setq set-a (- amax (abs dir)))
            (setq dir (* -1 dir)))))
      (setq set-a (max 0.0 set-a))
      (setq set-a (min 1.0 set-a))
      (set-frame-parameter nil 'alpha set-a)
      (message "%.2f" (frame-parameter nil 'alpha))))
  (declare-function alpha nil))

(defun alpha-loop ()
  (interactive)
  (while t
    (sleep-for 0.05)
    (alpha)))

(provide 'bad-alpha)