mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-08-01 12:41:52 -07:00
GridSelect: remove tabs
This commit is contained in:
Roman Cheplyaka
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user