A.RandomBackground: Parameterize randomBg by a RandomColor data

XMonad/Actions/RandomBackground.hs

@@ -13,27 +13,40 @@
 --
 -----------------------------------------------------------------------------
 
-module XMonad.Actions.RandomBackground (randomBg,randomBg') where
+module XMonad.Actions.RandomBackground (randomBg',randomBg,RandomColor(HSV,RGB)) where
 
 import XMonad(X, XConf(config), XConfig(terminal), io, spawn,
               MonadIO, asks)
-import System.Random(Random(randomRIO))
+import System.Random
-import Control.Monad(replicateM)
+import Control.Monad(replicateM,liftM)
 import Numeric(showHex)
 
--- | randomHex produces hex values in the form @xxyyzz@, with each of @xx@,
+-- | RandomColor fixes constraints when generating random colors
--- @yy@, @zz@ within the range specified. The first parameter determines the
+data RandomColor = RGB { _colorMin :: Int, _colorMax :: Int }
--- the number of such groups.
+                 | HSV { _colorSaturation :: Double, _colorValue :: Double }
-randomHex ::  Int -> (Int, Int) -> IO String
+
-randomHex n = fmap disp . replicateM n . randomRIO
+toHex :: [Int] -> String
+toHex =  ("'#"++) . (++"'") . concatMap (ensure 2 . ($ "") . showHex)
     where ensure x = reverse . take x . (++repeat '0') . reverse
-          disp = concatMap $ ensure 2 . ($ "") . showHex
 
--- | randomBg' appends the random hex @ -bg '#xxyyzz'@ to the supplied string
+randPermutation ::  (RandomGen g) => [a] -> g -> [a]
-randomBg' ::  (MonadIO m) => (Int, Int) -> String -> m String
+randPermutation xs g = swap $ zip (randoms g) xs
-randomBg' x t = do
+  where
-  num <- io $ randomHex 3 x
+    swap ((True,x):(c,y):ys) = y:swap ((c,x):ys)
-  return $ concat [t," -bg '#",num,"'"]
+    swap ((False,x):ys) = x:swap ys
+    swap x = map snd x
 
-randomBg :: (Int,Int) -> X ()
+-- | randomBg' produces a random hex number in the form @'#xxyyzz'@
-randomBg x = spawn =<< randomBg' x =<< asks (terminal . config)
+randomBg' ::  (MonadIO m) => RandomColor -> m String
+randomBg' (RGB l h) = liftM toHex $ replicateM 3 $ io $ randomRIO (l,h)
+randomBg' (HSV s v) = io $ do
+    g <- newStdGen
+    let -- x = (sqrt 3 - tan theta) / sqrt 3
+        x = (^2) $ fst $ randomR (0,sqrt $ pi / 3) g
+    return $ toHex $ map round $ randPermutation [v,(v-s)*x + s,s] g
+
+randomBg :: RandomColor -> X ()
+randomBg x = do
+    t <- asks (terminal . config)
+    c <- randomBg' x
+    spawn $ t ++ " -bg " ++ c