twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-08-11 02:02:11 -07:00
Code Issues Packages Projects Releases Wiki Activity

Extended GridSelect

Browse Source 
1) Added another convenience wrapper that allows to select an X() action
   from a given list.
2) Implemented the option to change the position of the selection diamond.
(Re-recorded from Bluetile repo, rebased to current darcs)
This commit is contained in:
Jan Vornberger
2009-09-30 15:27:41 +00:00
parent 832d435dee
commit 77f52bc84d
1 changed files with 24 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

33
XMonad/Actions/GridSelect.hs
View File

@@ -27,6 +27,7 @@ module XMonad.Actions.GridSelect (
bringSelected, bringSelected,
goToSelected, goToSelected,
spawnSelected, spawnSelected,
runSelectedAction,
fromClassName, fromClassName,
defaultColorizer, defaultColorizer,
colorRangeFromClassName colorRangeFromClassName
@@ -73,7 +74,9 @@ data GSConfig a = GSConfig {
gs_cellpadding :: Integer, gs_cellpadding :: Integer,
gs_colorizer :: a -> Bool -> X (String, String), gs_colorizer :: a -> Bool -> X (String, String),
gs_font :: String, gs_font :: String,
gs_navigate :: NavigateMap gs_navigate :: NavigateMap,
gs_originFractX :: Double,
gs_originFractY :: Double
} }
type NavigateMap = M.Map (KeyMask,KeySym) (TwoDPosition -> TwoDPosition) type NavigateMap = M.Map (KeyMask,KeySym) (TwoDPosition -> TwoDPosition)
@@ -114,9 +117,11 @@ diamondLayer n = let ul = [ (x,n-x) | x <- [0..n] ]
diamond :: (Enum a, Num a) => [(a, a)] diamond :: (Enum a, Num a) => [(a, a)]
diamond = concatMap diamondLayer [0..] diamond = concatMap diamondLayer [0..]
diamondRestrict :: (Enum t, Num t, Ord t) => t -> t -> [(t, t)] diamondRestrict :: Integer -> Integer -> Integer -> Integer -> [(Integer, Integer)]
diamondRestrict x y = L.filter (\(x',y') -> abs x' <= x && abs y' <= y) . diamondRestrict x y originX originY =
L.takeWhile (\(x',y') -> abs x' + abs y' <= x+y) $ diamond L.filter (\(x',y') -> abs x' <= x && abs y' <= y) .
map (\(x', y') -> (x' + fromInteger originX, y' + fromInteger originY)) .
take 1000 $ diamond
tupadd :: (Num t1, Num t) => (t, t1) -> (t, t1) -> (t, t1) tupadd :: (Num t1, Num t) => (t, t1) -> (t, t1) -> (t, t1)
tupadd (a,b) (c,d) = (a+c,b+d) tupadd (a,b) (c,d) = (a+c,b+d)
@@ -208,8 +213,8 @@ handle (ks,_) (KeyEvent {ev_event_type = t, ev_state = m })
handle _ (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y }) handle _ (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y })
| t == buttonRelease = do | t == buttonRelease = do
TwoDState { td_elementmap = elmap, td_paneX = px, td_paneY = py, (TwoDState { td_elementmap = elmap, td_paneX = px, td_paneY = py,
td_gsconfig = (GSConfig ch cw _ _ _ _) } <- get td_gsconfig = (GSConfig ch cw _ _ _ _ _ _) }) <- get
let gridX = (fi x - (px - cw) `div` 2) `div` cw let gridX = (fi x - (px - cw) `div` 2) `div` cw
gridY = (fi y - (py - ch) `div` 2) `div` ch gridY = (fi y - (py - ch) `div` 2) `div` ch
case lookup (gridX,gridY) elmap of case lookup (gridX,gridY) elmap of
@@ -316,10 +321,13 @@ gridselect gsconfig elmap =
restriction ss cs = ((fromInteger ss)/(fromInteger $ cs gsconfig)-1)/2 restriction ss cs = ((fromInteger ss)/(fromInteger $ cs gsconfig)-1)/2
restrictX = floor $ restriction screenWidth gs_cellwidth restrictX = floor $ restriction screenWidth gs_cellwidth
restrictY = floor $ restriction screenHeight gs_cellheight restrictY = floor $ restriction screenHeight gs_cellheight
elmap' = zip (diamondRestrict restrictX restrictY) elmap originPosX = floor $ ((gs_originFractX gsconfig) - (1/2)) * 2 * fromIntegral restrictX
originPosY = floor $ ((gs_originFractY gsconfig) - (1/2)) * 2 * fromIntegral restrictY
coords = diamondRestrict restrictX restrictY originPosX originPosY
elmap' = zip coords elmap
evalTwoD (updateAllElements >> eventLoop) evalTwoD (updateAllElements >> eventLoop)
(TwoDState (0,0) (TwoDState (head coords)
elmap' elmap'
gsconfig gsconfig
font font
@@ -365,7 +373,7 @@ defaultGSConfig = buildDefaultGSConfig fromClassName
-- | Builds a default gs config from a colorizer function. -- | Builds a default gs config from a colorizer function.
buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a
buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultGSNav buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultGSNav (1/2) (1/2)
defaultGSNav :: NavigateMap defaultGSNav :: NavigateMap
defaultGSNav = M.map tupadd $ M.fromList defaultGSNav = M.map tupadd $ M.fromList
@@ -400,3 +408,10 @@ defaultGSSpawnConfig = buildDefaultGSConfig defaultColorizer
spawnSelected :: GSConfig String -> [String] -> X () spawnSelected :: GSConfig String -> [String] -> X ()
spawnSelected conf lst = gridselect conf (zip lst lst) >>= flip whenJust spawn spawnSelected conf lst = gridselect conf (zip lst lst) >>= flip whenJust spawn
-- | Select an action and run it in the X monad
runSelectedAction :: GSConfig (X ()) -> [(String, X ())] -> X ()
runSelectedAction conf actions = do
selectedActionM <- gridselect conf actions
case selectedActionM of
Just selectedAction -> selectedAction
Nothing -> return ()