From 47cca33d39d65f47baf2a383e5a3c3497f0cb097 Mon Sep 17 00:00:00 2001 From: Clemens Fruhwirth Date: Tue, 11 Nov 2008 11:04:05 +0100 Subject: Simplify handle/eventLoop, introduce findInWindowMap, partial updates for key movements (less flickering) * handle/eventLoop carried the display and the drawing window as parameters. The display is available from the embedded X monad, the drawing windows was added. * updateWindows now takes a list of windows to update. updateAllWindows updates all windows. * only the windows that are modified by key movements are redrawn now. This means less flickering. darcs-hash:20081111100405-ed0c4-bd24b3e2c9ecbf8183582700d73bc61e64b503f5.gz --- XMonad/Actions/GridSelect.hs | 100 +++++++++++++++++++++++++++---------------- 1 file changed, 62 insertions(+), 38 deletions(-) (limited to 'XMonad/Actions/GridSelect.hs') diff --git a/XMonad/Actions/GridSelect.hs b/XMonad/Actions/GridSelect.hs index 59e7172..3ea97a4 100644 --- a/XMonad/Actions/GridSelect.hs +++ b/XMonad/Actions/GridSelect.hs @@ -59,12 +59,16 @@ data GSConfig = GSConfig { type TwoDPosition = (Integer, Integer) +type TwoDWindowMap = [(TwoDPosition,(String,Window))] + data TwoDState = TwoDState { td_curpos :: TwoDPosition, td_windowmap :: [(TwoDPosition,(String,Window))], td_gsconfig :: GSConfig, td_font :: XMonadFont, td_paneX :: Integer, - td_paneY :: Integer } + td_paneY :: Integer, + td_drawingWin :: Window + } type TwoD a = StateT TwoDState X a @@ -85,11 +89,13 @@ diamondRestrict x y = L.filter (\(x',y') -> abs x' <= x && abs y' <= y) . tupadd :: (Num t1, Num t) => (t, t1) -> (t, t1) -> (t, t1) tupadd (a,b) (c,d) = (a+c,b+d) -tupmul :: (Num t1, Num t) => (t, t1) -> (t, t1) -> (t, t1) -tupmul (a,b) (c,d) = (a*c,b*d) -drawWinBox :: Display -> Window -> XMonadFont -> (String, String) -> Integer -> Integer -> String -> Integer -> Integer -> Integer -> X () -drawWinBox dpy win font (fg,bg) ch cw text x y cp = do +findInWindowMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b) +findInWindowMap pos = find ((== pos) . fst) + +drawWinBox :: Window -> XMonadFont -> (String, String) -> Integer -> Integer -> String -> Integer -> Integer -> Integer -> X () +drawWinBox win font (fg,bg) ch cw text x y cp = + withDisplay $ \dpy -> do gc <- liftIO $ createGC dpy win bordergc <- liftIO $ createGC dpy win liftIO $ do @@ -109,61 +115,77 @@ drawWinBox dpy win font (fg,bg) ch cw text x y cp = do liftIO $ freeGC dpy gc liftIO $ freeGC dpy bordergc -updateWindows :: Display -> Window -> TwoD () -updateWindows dpy win = do - (TwoDState curpos windowList gsconfig font paneX paneY) <- get +updateAllWindows :: TwoD () +updateAllWindows = + do + TwoDState { td_windowmap = wins } <- get + updateWindows wins + +updateWindows :: TwoDWindowMap -> TwoD () +updateWindows windowmap = do + TwoDState { td_curpos = curpos, + td_drawingWin = win, + td_gsconfig = gsconfig, + td_font = font, + td_paneX = paneX, + td_paneY = paneY} <- get let cellwidth = gs_cellwidth gsconfig 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 + drawWinBox win font colors - (gs_cellheight gsconfig) - (gs_cellwidth gsconfig) text - (paneX'+x*cellwidth) - (paneY'+y*cellheight) - (gs_cellpadding gsconfig) - mapM updateWindow windowList + cellheight + cellwidth + text + (paneX'+x*cellwidth) + (paneY'+y*cellheight) + (gs_cellpadding gsconfig) + mapM updateWindow windowmap return () -eventLoop :: Display -> Window -> TwoD (Maybe Window) -eventLoop d win = do - (keysym,string,event) <- liftIO $ allocaXEvent $ \e -> do +eventLoop :: TwoD (Maybe Window) +eventLoop = do + (keysym,string,event) <- lift $ withDisplay $ \d -> 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) - handle d win (fromMaybe xK_VoidSymbol keysym,string) event + handle (fromMaybe xK_VoidSymbol keysym,string) event -handle :: Display - -> Window - -> (KeySym, String) +handle :: (KeySym, String) -> Event -> StateT TwoDState X (Maybe Window) -handle d win (ks,_) (KeyEvent {ev_event_type = t}) +handle (ks,_) (KeyEvent {ev_event_type = t}) | t == keyPress && ks == xK_Escape = return Nothing | t == keyPress && ks == xK_Left = diffAndRefresh (-1,0) | t == keyPress && ks == xK_Right = diffAndRefresh (1,0) | t == keyPress && ks == xK_Down = diffAndRefresh (0,1) | t == keyPress && ks == xK_Up = diffAndRefresh (0,-1) | t == keyPress && ks == xK_Return = do - (TwoDState pos win' _ _ _ _) <- get - return $ fmap (snd . snd) $ find ((== pos) . fst) win' + (TwoDState { td_curpos = pos, td_windowmap = winmap }) <- get + return $ fmap (snd . snd) $ findInWindowMap pos winmap where diffAndRefresh diff = do - (TwoDState pos windowmap gsconfig font paneX paneY) <- get - let newpos = pos `tupadd` diff - when (isJust $ find ((newpos ==).fst) windowmap) $ do - put $ TwoDState newpos windowmap gsconfig font paneX paneY - updateWindows d win - eventLoop d win + state <- get + let windowmap = td_windowmap state + oldPos = td_curpos state + newPos = oldPos `tupadd` diff + newSelectedWin = findInWindowMap newPos windowmap + when (isJust newSelectedWin) $ do + put state { td_curpos = newPos } + updateWindows (catMaybes [(findInWindowMap oldPos windowmap), newSelectedWin]) + eventLoop -handle d win _ _ = do - updateWindows d win - eventLoop d win +handle _ (ExposeEvent { }) = do + updateAllWindows + eventLoop + +handle _ _ = do + eventLoop -- FIXME probably move that into Utils? -- Conversion scheme as in http://en.wikipedia.org/wiki/HSV_color_space @@ -217,13 +239,15 @@ gridselect gsconfig = 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) + winmap = zipWith (,) (diamondRestrict restrictX restrictY) windowList + selectedWindow <- evalStateT (do updateAllWindows; eventLoop) (TwoDState (0,0) - (zipWith (,) (diamondRestrict restrictX restrictY) windowList) + winmap gsconfig font screenWidth - screenHeight) + screenHeight + win) return selectedWindow else return Nothing @@ -243,7 +267,7 @@ withSelectedWindow callback conf = do case mbWindow of Just w -> callback w Nothing -> return () - + windowMap :: X [(String,Window)] windowMap = do -- cgit v1.2.3