A.RandomBackground: Parameterize randomBg by a RandomColor data

Ignore-this: ba8042aa0f5d3221583aead9dced6cc

darcs-hash:20090629004147-1499c-31ce5c2b4a2fd52d8dc48f94a27ba06607a9820a.gz

1 files changed, 29 insertions, 16 deletions

diff --git a/XMonad/Actions/RandomBackground.hs b/XMonad/Actions/RandomBackground.hs
index 71a5744..21dc4f8 100644
--- a/XMonad/Actions/RandomBackground.hs
+++ b/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 Control.Monad(replicateM)
+import System.Random
+import Control.Monad(replicateM,liftM)
 import Numeric(showHex)
 
--- | randomHex produces hex values in the form @xxyyzz@, with each of @xx@,
--- @yy@, @zz@ within the range specified. The first parameter determines the
--- the number of such groups.
-randomHex ::  Int -> (Int, Int) -> IO String
-randomHex n = fmap disp . replicateM n . randomRIO
+-- | RandomColor fixes constraints when generating random colors
+data RandomColor = RGB { _colorMin :: Int, _colorMax :: Int }
+                 | HSV { _colorSaturation :: Double, _colorValue :: Double }
+
+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
-randomBg' ::  (MonadIO m) => (Int, Int) -> String -> m String
-randomBg' x t = do
-  num <- io $ randomHex 3 x
-  return $ concat [t," -bg '#",num,"'"]
+randPermutation ::  (RandomGen g) => [a] -> g -> [a]
+randPermutation xs g = swap $ zip (randoms g) xs
+  where
+    swap ((True,x):(c,y):ys) = y:swap ((c,x):ys)
+    swap ((False,x):ys) = x:swap ys
+    swap x = map snd x
+
+-- | randomBg' produces a random hex number in the form @'#xxyyzz'@
+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 :: (Int,Int) -> X ()
-randomBg x = spawn =<< randomBg' x =<< asks (terminal . config)
+randomBg :: RandomColor -> X ()
+randomBg x = do
+    t <- asks (terminal . config)
+    c <- randomBg' x
+    spawn $ t ++ " -bg " ++ c