-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.RandomBackground
-- Description :  Start terminals with a random background color.
-- Copyright   :  (c) 2009 Anze Slosar
--                translation to Haskell by Adam Vogt
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  <vogt.adam@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- An action to start terminals with a random background color
--
-----------------------------------------------------------------------------

module XMonad.Actions.RandomBackground (
    -- * Usage
    -- $usage
    randomBg',
    randomBg,
    RandomColor(HSV,RGB)
    ) where

import XMonad(X, XConf(config), XConfig(terminal), io, spawn,
              MonadIO, asks)
import System.Random
import Numeric(showHex)

-- $usage
--
-- Add to your keybindings something like:
--
-- > ,((modm .|. shiftMask, xK_Return), randomBg $ HSV 0xff 0x20

-- | RandomColor fixes constraints when generating random colors. All
-- parameters should be in the range 0 -- 0xff
data RandomColor = RGB { RandomColor -> Int
_colorMin :: Int
                       , RandomColor -> Int
_colorMax :: Int
                       } -- ^ specify the minimum and maximum lowest values for each color channel.
                 | HSV { RandomColor -> Double
_colorSaturation :: Double
                       , RandomColor -> Double
_colorValue :: Double
                       } -- ^ specify the saturation and value, leaving the hue random.

toHex :: [Int] -> String
toHex :: [Int] -> String
toHex =  (String
"'#"forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++String
"'") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> String -> String
ensure Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ String
"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Integral a, Show a) => a -> String -> String
showHex)
    where ensure :: Int -> String -> String
ensure Int
x = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++forall a. a -> [a]
repeat Char
'0') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

randPermutation ::  (RandomGen g) => [a] -> g -> [a]
randPermutation :: forall g a. RandomGen g => [a] -> g -> [a]
randPermutation [a]
xs g
g = forall {b}. [(Bool, b)] -> [b]
swap forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a g. (Random a, RandomGen g) => g -> [a]
randoms g
g) [a]
xs
  where
    swap :: [(Bool, b)] -> [b]
swap ((Bool
True,b
x):(Bool
c,b
y):[(Bool, b)]
ys) = b
yforall a. a -> [a] -> [a]
:[(Bool, b)] -> [b]
swap ((Bool
c,b
x)forall a. a -> [a] -> [a]
:[(Bool, b)]
ys)
    swap ((Bool
False,b
x):[(Bool, b)]
ys) = b
xforall a. a -> [a] -> [a]
:[(Bool, b)] -> [b]
swap [(Bool, b)]
ys
    swap [(Bool, b)]
x = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Bool, b)]
x

-- | @randomBg'@ produces a random hex number in the form @'#xxyyzz'@
randomBg' ::  (MonadIO m) => RandomColor -> m String
randomBg' :: forall (m :: * -> *). MonadIO m => RandomColor -> m String
randomBg' (RGB Int
l Int
h) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Int] -> String
toHex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (Int
l,Int
h)) forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
randomBg' (HSV Double
s Double
v) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ do
    StdGen
g <- forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
    let x :: Double
x = (forall a b. (Num a, Integral b) => a -> b -> a
^(Int
2::Int)) forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Double
0,forall a. Floating a => a -> a
sqrt forall a b. (a -> b) -> a -> b
$ forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
3) StdGen
g
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Int] -> String
toHex forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ forall g a. RandomGen g => [a] -> g -> [a]
randPermutation [Double
v,(Double
vforall a. Num a => a -> a -> a
-Double
s)forall a. Num a => a -> a -> a
*Double
x forall a. Num a => a -> a -> a
+ Double
s,Double
s] StdGen
g

-- | @randomBg@ starts a terminal with the background color taken from 'randomBg''
--
-- This depends on the your 'terminal' configuration field accepting an
-- argument like @-bg '#ff0023'@
randomBg :: RandomColor -> X ()
randomBg :: RandomColor -> X ()
randomBg RandomColor
x = do
    String
t <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall (l :: * -> *). XConfig l -> String
terminal forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config)
    String
c <- forall (m :: * -> *). MonadIO m => RandomColor -> m String
randomBg' RandomColor
x
    forall (m :: * -> *). MonadIO m => String -> m ()
spawn forall a b. (a -> b) -> a -> b
$ String
t forall a. [a] -> [a] -> [a]
++ String
" -bg " forall a. [a] -> [a] -> [a]
++ String
c