randsolid-0.2: Randsolid.hs

-- Change the root window background to a random solid colour.

import System.Random
import System.Environment (getArgs)
import Control.Applicative
import Data.Bits
import Graphics.X11.Xlib.Window
import Graphics.X11.Xlib.Display
import Graphics.X11.Xlib.Types


-- These are the bounds on the random generation of values.
data Values = V
	{ sat :: (Double, Double) -- ^ Saturation, valid values in [0..1]
	, hue :: (Double, Double) -- ^ Hue, valid values in [0..365]
	, val :: (Double, Double) -- ^ Value, valid values in [0..1]
	}

-- Default bounds.
defaultValues = V
	{ sat = (0.12, 0.30)
	, hue = (0, 365)
	, val = (0.5, 0.7)
	}


data HSV = HSV Double Double Double deriving Read
instance Show HSV where show = hsv2hex

data RGB = RGB Double Double Double
instance Show RGB where show = rgb2hex

-- Convert a HSV colour to its hexadecimal representation.
hsv2hex :: HSV -> String
hsv2hex = rgb2hex . hsv2rgb

-- Convert a RGB colour value into its hexadecimal representation.
rgb2hex :: RGB -> String
rgb2hex (RGB r g b) = "#" ++ r' ++ g' ++ b'
	where
		r' = table !! (floor (r * 255))
		g' = table !! (floor (g * 255))
		b' = table !! (floor (b * 255))
		table = [ x:y:[] | x <- "0123456789abcdef", y <- "0123456789abcdef" ]


hsv2rgb :: HSV -> RGB
hsv2rgb (HSV h s v) = case h' of
	0 -> RGB v t p
	1 -> RGB q v p
	2 -> RGB p v t
	3 -> RGB p q v
	4 -> RGB t p v
	_ -> RGB v p q
	where
		p = v * (1 - s)
		q = v * (1 - f * s)
		t = v * (1 - (1 - f) * s)

		f = (h / 60) - (fromIntegral (floor (h / 60)))
		h' = floor (h / 60) `mod` 6


hsv2pixel :: HSV -> Pixel
hsv2pixel hsv = sum $ map (\(pos, val) -> shiftL (floor (255 * val)) (8 * fromIntegral pos)) bits
	where
		(RGB r g b) = hsv2rgb hsv
		bits = zip [0,1,2] [b,g,r]


randcolour :: Values -> IO HSV
randcolour v = do
	h <- randomRIO (fst $ hue v, snd $ hue v)
	s <- randomRIO (fst $ sat v, snd $ sat v)
	v <- randomRIO (fst $ val v, snd $ val v)
	return $ HSV h s v


randsolid :: Values -> IO ()
randsolid v = do
	dpy  <- openDisplay ""
	root <- rootWindow dpy $ defaultScreen dpy
	setWindowBackground dpy root . hsv2pixel =<< randcolour v
	clearWindow dpy root
	closeDisplay dpy


main = do
	args <- getArgs
	if args == ["-p"] || args == ["--print"]
		then putStrLn . show =<< randcolour defaultValues
		else randsolid defaultValues