-----------------------------------------------------------------------------
-- |
-- 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
"'#"String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> ([Int] -> String) -> [Int] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"'") (String -> String) -> ([Int] -> String) -> [Int] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> String) -> [Int] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> String -> String
ensure Int
2 (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"") ((String -> String) -> String)
-> (Int -> String -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex)
    where ensure :: Int -> String -> String
ensure Int
x = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
x (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++Char -> String
forall a. a -> [a]
repeat Char
'0') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
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 = [(Bool, a)] -> [a]
forall {b}. [(Bool, b)] -> [b]
swap ([(Bool, a)] -> [a]) -> [(Bool, a)] -> [a]
forall a b. (a -> b) -> a -> b
$ [Bool] -> [a] -> [(Bool, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip (g -> [Bool]
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
yb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[(Bool, b)] -> [b]
swap ((Bool
c,b
x)(Bool, b) -> [(Bool, b)] -> [(Bool, b)]
forall a. a -> [a] -> [a]
:[(Bool, b)]
ys)
    swap ((Bool
False,b
x):[(Bool, b)]
ys) = b
xb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[(Bool, b)] -> [b]
swap [(Bool, b)]
ys
    swap [(Bool, b)]
x = ((Bool, b) -> b) -> [(Bool, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, b) -> b
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) = IO String -> m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ (StdGen -> String) -> IO StdGen -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Int] -> String
toHex ([Int] -> String) -> (StdGen -> [Int]) -> StdGen -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
3 ([Int] -> [Int]) -> (StdGen -> [Int]) -> StdGen -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> StdGen -> [Int]
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (Int
l,Int
h)) IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
randomBg' (HSV Double
s Double
v) = IO String -> m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ do
    StdGen
g <- IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
    let x :: Double
x = (Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
2::Int)) (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ (Double, StdGen) -> Double
forall a b. (a, b) -> a
fst ((Double, StdGen) -> Double) -> (Double, StdGen) -> Double
forall a b. (a -> b) -> a -> b
$ (Double, Double) -> StdGen -> (Double, StdGen)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Double
0,Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
3) StdGen
g
    String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ [Int] -> String
toHex ([Int] -> String) -> [Int] -> String
forall a b. (a -> b) -> a -> b
$ (Double -> Int) -> [Double] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round ([Double] -> [Int]) -> [Double] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Double] -> StdGen -> [Double]
forall g a. RandomGen g => [a] -> g -> [a]
randPermutation [Double
v,(Double
vDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
s)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
x Double -> Double -> Double
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 <- (XConf -> String) -> X String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (XConfig Layout -> String
forall (l :: * -> *). XConfig l -> String
terminal (XConfig Layout -> String)
-> (XConf -> XConfig Layout) -> XConf -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config)
    String
c <- RandomColor -> X String
forall (m :: * -> *). MonadIO m => RandomColor -> m String
randomBg' RandomColor
x
    String -> X ()
forall (m :: * -> *). MonadIO m => String -> m ()
spawn (String -> X ()) -> String -> X ()
forall a b. (a -> b) -> a -> b
$ String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -bg " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c