From b3e300a0ad4d48ffadb90337eed5bb8581d23a76 Mon Sep 17 00:00:00 2001 From: Roman Cheplyaka Date: Tue, 11 Nov 2008 06:36:47 +0100 Subject: GridSelect: remove tabs darcs-hash:20081111053647-3ebed-5450725a6859c12fd9b1625228b5252664254df6.gz --- XMonad/Actions/GridSelect.hs | 122 +++++++++++++++++++++---------------------- 1 file changed, 61 insertions(+), 61 deletions(-) (limited to 'XMonad/Actions/GridSelect.hs') diff --git a/XMonad/Actions/GridSelect.hs b/XMonad/Actions/GridSelect.hs index c268f6a..bacea13 100644 --- a/XMonad/Actions/GridSelect.hs +++ b/XMonad/Actions/GridSelect.hs @@ -60,11 +60,11 @@ data GSConfig = GSConfig { type TwoDPosition = (Integer, Integer) data TwoDState = TwoDState { td_curpos :: TwoDPosition, - td_windowmap :: [(TwoDPosition,(String,Window))], - td_gsconfig :: GSConfig, - td_font :: XMonadFont, - td_paneX :: Integer, - td_paneY :: Integer } + td_windowmap :: [(TwoDPosition,(String,Window))], + td_gsconfig :: GSConfig, + td_font :: XMonadFont, + td_paneX :: Integer, + td_paneY :: Integer } type TwoD a = StateT TwoDState X a @@ -72,8 +72,8 @@ type TwoD a = StateT TwoDState X a diamondLayer :: (Enum b', Num b') => b' -> [(b', b')] -- FIXME remove nub diamondLayer n = let ul = [ (x,n-x) | x <- [0..n] ] - in nub $ ul ++ (map (negate *** id) ul) ++ - (map (negate *** negate) ul) ++ + in nub $ ul ++ (map (negate *** id) ul) ++ + (map (negate *** negate) ul) ++ (map (id *** negate) ul) diamond :: (Enum a, Num a) => [(a, a)] @@ -87,9 +87,9 @@ diamond = concatMap diamondLayer [0..] diamondRestrict :: (Enum t, Num t, Ord t) => t -> t -> [(t, t)] diamondRestrict x y = L.filter f diamond where f (x',y') = (x' <= x) && - (x' >= -x) && - (y' <= y) && - (y' >= -y) + (x' >= -x) && + (y' <= y) && + (y' >= -y) tupadd :: (Num t1, Num t) => (t, t1) -> (t, t1) -> (t, t1) tupadd (a,b) (c,d) = (a+c,b+d) @@ -110,9 +110,9 @@ drawWinBox dpy win font (fg,bg) ch cw text x y cp = do fillRectangle dpy win gc (fromInteger x) (fromInteger y) (fromInteger cw) (fromInteger ch) drawRectangle dpy win bordergc (fromInteger x) (fromInteger y) (fromInteger cw) (fromInteger ch) stext <- shrinkWhile (shrinkIt shrinkText) - (\n -> do size <- liftIO $ textWidthXMF dpy font n - return $ size > (fromInteger (cw-(2*cp)))) - text + (\n -> do size <- liftIO $ textWidthXMF dpy font n + return $ size > (fromInteger (cw-(2*cp)))) + text printStringXMF dpy win font gc bg fg (fromInteger (x+cp)) (fromInteger (y+(div ch 2))) stext liftIO $ freeGC dpy gc liftIO $ freeGC dpy bordergc @@ -121,30 +121,30 @@ updateWindows :: Display -> Window -> TwoD () updateWindows dpy win = do (TwoDState curpos windowList gsconfig font paneX paneY) <- get let cellwidth = gs_cellwidth gsconfig - cellheight = gs_cellheight gsconfig - paneX' = div (paneX-cellwidth) 2 + cellheight = gs_cellheight gsconfig + paneX' = div (paneX-cellwidth) 2 paneY' = div (paneY-cellheight) 2 - updateWindow (pos@(x,y),(text, clientwindow)) = lift $ do - colors <- (gs_colorizer gsconfig) clientwindow (pos == curpos) - drawWinBox dpy win font - colors - (gs_cellheight gsconfig) - (gs_cellwidth gsconfig) text - (paneX'+x*cellwidth) - (paneY'+y*cellheight) - (gs_cellpadding gsconfig) + updateWindow (pos@(x,y),(text, clientwindow)) = lift $ do + colors <- (gs_colorizer gsconfig) clientwindow (pos == curpos) + drawWinBox dpy win font + colors + (gs_cellheight gsconfig) + (gs_cellwidth gsconfig) text + (paneX'+x*cellwidth) + (paneY'+y*cellheight) + (gs_cellpadding gsconfig) mapM updateWindow windowList return () eventLoop :: Display -> Window -> TwoD (Maybe Window) eventLoop d win = do (keysym,string,event) <- liftIO $ allocaXEvent $ \e -> do - nextEvent d e - ev <- getEvent e - (ks,s) <- if ev_event_type ev == keyPress - then lookupString $ asKeyEvent e - else return (Nothing, "") - return (ks,s,ev) + nextEvent d e + ev <- getEvent e + (ks,s) <- if ev_event_type ev == keyPress + then lookupString $ asKeyEvent e + else return (Nothing, "") + return (ks,s,ev) handle d win (fromMaybe xK_VoidSymbol keysym,string) event handle :: Display @@ -162,10 +162,10 @@ handle d win (ks,_) (KeyEvent {ev_event_type = t}) (TwoDState pos win' _ _ _ _) <- get return $ fmap (snd . snd) $ find ((== pos) . fst) win' where diffAndRefresh diff = do - (TwoDState pos windowlist gsconfig font paneX paneY) <- get - put $ TwoDState (pos `tupadd` diff) windowlist gsconfig font paneX paneY - updateWindows d win - eventLoop d win + (TwoDState pos windowlist gsconfig font paneX paneY) <- get + put $ TwoDState (pos `tupadd` diff) windowlist gsconfig font paneX paneY + updateWindows d win + eventLoop d win handle d win _ _ = do updateWindows d win @@ -176,26 +176,26 @@ handle d win _ _ = do hsv2rgb :: Fractional a => (Integer,a,a) -> (a,a,a) hsv2rgb (h,s,v) = let hi = (div h 60) `mod` 6 :: Integer - f = (((fromInteger h)/60) - (fromInteger hi)) :: Fractional a => a - q = v * (1-f) - p = v * (1-s) - t = v * (1-(1-f)*s) + f = (((fromInteger h)/60) - (fromInteger hi)) :: Fractional a => a + q = v * (1-f) + p = v * (1-s) + t = v * (1-(1-f)*s) in case hi of - 0 -> (v,t,p) - 1 -> (q,v,p) - 2 -> (p,v,t) - 3 -> (p,q,v) - 4 -> (t,p,v) - 5 -> (v,p,q) - _ -> error "The world is ending. x mod a >= a." + 0 -> (v,t,p) + 1 -> (q,v,p) + 2 -> (p,v,t) + 3 -> (p,q,v) + 4 -> (t,p,v) + 5 -> (v,p,q) + _ -> error "The world is ending. x mod a >= a." default_colorizer :: Window -> Bool -> X (String, String) default_colorizer w active = do classname <- runQuery className w let seed x = toInteger (sum $ map ((*x).fromEnum) classname) :: Integer (r,g,b) = hsv2rgb ((seed 83) `mod` 360, - (fromInteger ((seed 191) `mod` 1000))/2500+0.4, - (fromInteger ((seed 121) `mod` 1000))/2500+0.4) + (fromInteger ((seed 191) `mod` 1000))/2500+0.4, + (fromInteger ((seed 121) `mod` 1000))/2500+0.4) if active then return ("#faff69", "black") else return ("#" ++ concat (map (twodigitHex.(round :: Double -> Integer).(*256)) [r, g, b] ), "white") @@ -218,21 +218,21 @@ gridselect gsconfig = status <- io $ grabKeyboard dpy win True grabModeAsync grabModeAsync currentTime font <- initXMF (gs_font gsconfig) let screenWidth = toInteger $ rect_width s; - screenHeight = toInteger $ rect_height s; + screenHeight = toInteger $ rect_height s; selectedWindow <- if (status == grabSuccess) then - do - let restrictX = floor $ ((fromInteger screenWidth)/(fromInteger $ gs_cellwidth gsconfig)-1)/2 ; - restrictY = floor $ ((fromInteger screenHeight)/(fromInteger $ gs_cellheight gsconfig)-1)/2 ; - selectedWindow <- evalStateT (do updateWindows dpy win; eventLoop dpy win) - (TwoDState (0,0) - (zipWith (,) (diamondRestrict restrictX restrictY) windowList) - gsconfig - font - screenWidth - screenHeight) - return selectedWindow - else - return Nothing + do + let restrictX = floor $ ((fromInteger screenWidth)/(fromInteger $ gs_cellwidth gsconfig)-1)/2 ; + restrictY = floor $ ((fromInteger screenHeight)/(fromInteger $ gs_cellheight gsconfig)-1)/2 ; + selectedWindow <- evalStateT (do updateWindows dpy win; eventLoop dpy win) + (TwoDState (0,0) + (zipWith (,) (diamondRestrict restrictX restrictY) windowList) + gsconfig + font + screenWidth + screenHeight) + return selectedWindow + else + return Nothing liftIO $ do unmapWindow dpy win destroyWindow dpy win -- cgit v1.2.3