{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances, OverlappingInstances #-}
module XMonad.Actions.GridSelect (
GSConfig(..),
def,
defaultGSConfig,
TwoDPosition,
buildDefaultGSConfig,
gridselect,
gridselectWindow,
withSelectedWindow,
bringSelected,
goToSelected,
gridselectWorkspace,
gridselectWorkspace',
spawnSelected,
runSelectedAction,
HasColorizer(defaultColorizer),
fromClassName,
stringColorizer,
colorRangeFromClassName,
TwoD,
makeXEventhandler,
shadowWithKeymap,
defaultNavigation,
substringSearch,
navNSearch,
setPos,
move,
moveNext, movePrev,
select,
cancel,
transformSearchString,
Rearranger,
noRearranger,
searchStringRearrangerGenerator,
TwoDState,
) where
import Data.Maybe
import Data.Bits
import Data.Char
import Data.Ord (comparing)
import Control.Applicative
import Control.Monad.State
import Control.Arrow
import Data.List as L
import qualified Data.Map as M
import XMonad hiding (liftX)
import XMonad.Util.Font
import XMonad.Prompt (mkUnmanagedWindow)
import XMonad.StackSet as W
import XMonad.Layout.Decoration
import XMonad.Util.NamedWindows
import XMonad.Actions.WindowBringer (bringWindow)
import Text.Printf
import System.Random (mkStdGen, genRange, next)
import Data.Word (Word8)
data GSConfig a = GSConfig {
GSConfig a -> Integer
gs_cellheight :: Integer,
GSConfig a -> Integer
gs_cellwidth :: Integer,
GSConfig a -> Integer
gs_cellpadding :: Integer,
GSConfig a -> a -> Bool -> X (String, String)
gs_colorizer :: a -> Bool -> X (String, String),
GSConfig a -> String
gs_font :: String,
GSConfig a -> TwoD a (Maybe a)
gs_navigate :: TwoD a (Maybe a),
GSConfig a -> Rearranger a
gs_rearranger :: Rearranger a,
GSConfig a -> Double
gs_originFractX :: Double,
GSConfig a -> Double
gs_originFractY :: Double,
GSConfig a -> String
gs_bordercolor :: String
}
class HasColorizer a where
defaultColorizer :: a -> Bool -> X (String, String)
instance HasColorizer Window where
defaultColorizer :: Window -> Bool -> X (String, String)
defaultColorizer = Window -> Bool -> X (String, String)
fromClassName
instance HasColorizer String where
defaultColorizer :: String -> Bool -> X (String, String)
defaultColorizer = String -> Bool -> X (String, String)
stringColorizer
instance HasColorizer a where
defaultColorizer :: a -> Bool -> X (String, String)
defaultColorizer _ isFg :: Bool
isFg =
let getColor :: XConfig l -> String
getColor = if Bool
isFg then XConfig l -> String
forall (l :: * -> *). XConfig l -> String
focusedBorderColor else XConfig l -> String
forall (l :: * -> *). XConfig l -> String
normalBorderColor
in (XConf -> (String, String)) -> X (String, String)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((XConf -> (String, String)) -> X (String, String))
-> (XConf -> (String, String)) -> X (String, String)
forall a b. (a -> b) -> a -> b
$ (String -> String -> (String, String))
-> String -> String -> (String, String)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) "black" (String -> (String, String))
-> (XConf -> String) -> XConf -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConfig Layout -> String
forall (l :: * -> *). XConfig l -> String
getColor (XConfig Layout -> String)
-> (XConf -> XConfig Layout) -> XConf -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config
instance HasColorizer a => Default (GSConfig a) where
def :: GSConfig a
def = (a -> Bool -> X (String, String)) -> GSConfig a
forall a. (a -> Bool -> X (String, String)) -> GSConfig a
buildDefaultGSConfig a -> Bool -> X (String, String)
forall a. HasColorizer a => a -> Bool -> X (String, String)
defaultColorizer
{-# DEPRECATED defaultGSConfig "Use def (from Data.Default, and re-exported from XMonad.Actions.GridSelect) instead." #-}
defaultGSConfig :: HasColorizer a => GSConfig a
defaultGSConfig :: GSConfig a
defaultGSConfig = GSConfig a
forall a. Default a => a
def
type TwoDPosition = (Integer, Integer)
type TwoDElementMap a = [(TwoDPosition,(String,a))]
data TwoDState a = TwoDState { TwoDState a -> TwoDPosition
td_curpos :: TwoDPosition
, TwoDState a -> [TwoDPosition]
td_availSlots :: [TwoDPosition]
, TwoDState a -> [(String, a)]
td_elements :: [(String,a)]
, TwoDState a -> GSConfig a
td_gsconfig :: GSConfig a
, TwoDState a -> XMonadFont
td_font :: XMonadFont
, TwoDState a -> Integer
td_paneX :: Integer
, TwoDState a -> Integer
td_paneY :: Integer
, TwoDState a -> Window
td_drawingWin :: Window
, TwoDState a -> String
td_searchString :: String
, TwoDState a -> TwoDElementMap a
td_elementmap :: TwoDElementMap a
}
generateElementmap :: TwoDState a -> X (TwoDElementMap a)
generateElementmap :: TwoDState a -> X (TwoDElementMap a)
generateElementmap s :: TwoDState a
s = do
[(String, a)]
rearrangedElements <- Rearranger a
rearranger String
searchString [(String, a)]
sortedElements
TwoDElementMap a -> X (TwoDElementMap a)
forall (m :: * -> *) a. Monad m => a -> m a
return (TwoDElementMap a -> X (TwoDElementMap a))
-> TwoDElementMap a -> X (TwoDElementMap a)
forall a b. (a -> b) -> a -> b
$ [TwoDPosition] -> [(String, a)] -> TwoDElementMap a
forall a b. [a] -> [b] -> [(a, b)]
zip [TwoDPosition]
positions [(String, a)]
rearrangedElements
where
TwoDState {td_availSlots :: forall a. TwoDState a -> [TwoDPosition]
td_availSlots = [TwoDPosition]
positions,
td_gsconfig :: forall a. TwoDState a -> GSConfig a
td_gsconfig = GSConfig a
gsconfig,
td_searchString :: forall a. TwoDState a -> String
td_searchString = String
searchString} = TwoDState a
s
GSConfig {gs_rearranger :: forall a. GSConfig a -> Rearranger a
gs_rearranger = Rearranger a
rearranger} = GSConfig a
gsconfig
filteredElements :: [(String, a)]
filteredElements = ((String, a) -> Bool) -> [(String, a)] -> [(String, a)]
forall a. (a -> Bool) -> [a] -> [a]
L.filter ((String
searchString String -> String -> Bool
`isInfixOfI`) (String -> Bool) -> ((String, a) -> String) -> (String, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, a) -> String
forall a b. (a, b) -> a
fst) (TwoDState a -> [(String, a)]
forall a. TwoDState a -> [(String, a)]
td_elements TwoDState a
s)
sortedElements :: [(String, a)]
sortedElements = String -> [(String, a)] -> [(String, a)]
forall a. String -> [(String, a)] -> [(String, a)]
orderElementmap String
searchString [(String, a)]
filteredElements
needle :: String
needle isInfixOfI :: String -> String -> Bool
`isInfixOfI` haystack :: String
haystack = (String -> String
upper String
needle) String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` (String -> String
upper String
haystack)
upper :: String -> String
upper = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper
orderElementmap :: String -> [(String,a)] -> [(String,a)]
orderElementmap :: String -> [(String, a)] -> [(String, a)]
orderElementmap searchString :: String
searchString elements :: [(String, a)]
elements = if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
searchString then [(String, a)]
sortedElements else [(String, a)]
elements
where
upper :: String -> String
upper = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper
calcScore :: (String, b) -> (Int, (String, b))
calcScore element :: (String, b)
element = ( [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> [String] -> Int
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf (String -> String
upper String
searchString)) (String -> [String]
forall a. [a] -> [[a]]
tails (String -> [String])
-> ((String, b) -> String) -> (String, b) -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
upper (String -> String)
-> ((String, b) -> String) -> (String, b) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, b) -> String
forall a b. (a, b) -> a
fst ((String, b) -> [String]) -> (String, b) -> [String]
forall a b. (a -> b) -> a -> b
$ (String, b)
element)
, (String, b)
element)
compareScore :: (Int, (String, b)) -> (Int, (String, b)) -> Ordering
compareScore = ((Int, (String, b)) -> (Int, String))
-> (Int, (String, b)) -> (Int, (String, b)) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (\(score :: Int
score, (str :: String
str,_)) -> (Int
score, String
str))
sortedElements :: [(String, a)]
sortedElements = ((Int, (String, a)) -> (String, a))
-> [(Int, (String, a))] -> [(String, a)]
forall a b. (a -> b) -> [a] -> [b]
map (Int, (String, a)) -> (String, a)
forall a b. (a, b) -> b
snd ([(Int, (String, a))] -> [(String, a)])
-> ([(Int, (String, a))] -> [(Int, (String, a))])
-> [(Int, (String, a))]
-> [(String, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, (String, a)) -> (Int, (String, a)) -> Ordering)
-> [(Int, (String, a))] -> [(Int, (String, a))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Int, (String, a)) -> (Int, (String, a)) -> Ordering
forall b. (Int, (String, b)) -> (Int, (String, b)) -> Ordering
compareScore ([(Int, (String, a))] -> [(String, a)])
-> [(Int, (String, a))] -> [(String, a)]
forall a b. (a -> b) -> a -> b
$ ((String, a) -> (Int, (String, a)))
-> [(String, a)] -> [(Int, (String, a))]
forall a b. (a -> b) -> [a] -> [b]
map (String, a) -> (Int, (String, a))
forall b. (String, b) -> (Int, (String, b))
calcScore [(String, a)]
elements
newtype TwoD a b = TwoD { TwoD a b -> StateT (TwoDState a) X b
unTwoD :: StateT (TwoDState a) X b }
deriving (Applicative (TwoD a)
a -> TwoD a a
Applicative (TwoD a) =>
(forall a b. TwoD a a -> (a -> TwoD a b) -> TwoD a b)
-> (forall a b. TwoD a a -> TwoD a b -> TwoD a b)
-> (forall a. a -> TwoD a a)
-> Monad (TwoD a)
TwoD a a -> (a -> TwoD a b) -> TwoD a b
TwoD a a -> TwoD a b -> TwoD a b
forall a. Applicative (TwoD a)
forall a. a -> TwoD a a
forall a a. a -> TwoD a a
forall a b. TwoD a a -> TwoD a b -> TwoD a b
forall a b. TwoD a a -> (a -> TwoD a b) -> TwoD a b
forall a a b. TwoD a a -> TwoD a b -> TwoD a b
forall a a b. TwoD a a -> (a -> TwoD a b) -> TwoD a b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> TwoD a a
$creturn :: forall a a. a -> TwoD a a
>> :: TwoD a a -> TwoD a b -> TwoD a b
$c>> :: forall a a b. TwoD a a -> TwoD a b -> TwoD a b
>>= :: TwoD a a -> (a -> TwoD a b) -> TwoD a b
$c>>= :: forall a a b. TwoD a a -> (a -> TwoD a b) -> TwoD a b
$cp1Monad :: forall a. Applicative (TwoD a)
Monad,a -> TwoD a b -> TwoD a a
(a -> b) -> TwoD a a -> TwoD a b
(forall a b. (a -> b) -> TwoD a a -> TwoD a b)
-> (forall a b. a -> TwoD a b -> TwoD a a) -> Functor (TwoD a)
forall a b. a -> TwoD a b -> TwoD a a
forall a b. (a -> b) -> TwoD a a -> TwoD a b
forall a a b. a -> TwoD a b -> TwoD a a
forall a a b. (a -> b) -> TwoD a a -> TwoD a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> TwoD a b -> TwoD a a
$c<$ :: forall a a b. a -> TwoD a b -> TwoD a a
fmap :: (a -> b) -> TwoD a a -> TwoD a b
$cfmap :: forall a a b. (a -> b) -> TwoD a a -> TwoD a b
Functor,MonadState (TwoDState a))
instance Applicative (TwoD a) where
<*> :: TwoD a (a -> b) -> TwoD a a -> TwoD a b
(<*>) = TwoD a (a -> b) -> TwoD a a -> TwoD a b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
pure :: a -> TwoD a a
pure = a -> TwoD a a
forall (m :: * -> *) a. Monad m => a -> m a
return
liftX :: X a1 -> TwoD a a1
liftX :: X a1 -> TwoD a a1
liftX = StateT (TwoDState a) X a1 -> TwoD a a1
forall a b. StateT (TwoDState a) X b -> TwoD a b
TwoD (StateT (TwoDState a) X a1 -> TwoD a a1)
-> (X a1 -> StateT (TwoDState a) X a1) -> X a1 -> TwoD a a1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X a1 -> StateT (TwoDState a) X a1
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
evalTwoD :: TwoD a1 a -> TwoDState a1 -> X a
evalTwoD :: TwoD a1 a -> TwoDState a1 -> X a
evalTwoD m :: TwoD a1 a
m s :: TwoDState a1
s = (StateT (TwoDState a1) X a -> TwoDState a1 -> X a)
-> TwoDState a1 -> StateT (TwoDState a1) X a -> X a
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (TwoDState a1) X a -> TwoDState a1 -> X a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT TwoDState a1
s (StateT (TwoDState a1) X a -> X a)
-> StateT (TwoDState a1) X a -> X a
forall a b. (a -> b) -> a -> b
$ TwoD a1 a -> StateT (TwoDState a1) X a
forall a b. TwoD a b -> StateT (TwoDState a) X b
unTwoD TwoD a1 a
m
diamondLayer :: (Enum a, Num a, Eq a) => a -> [(a, a)]
diamondLayer :: a -> [(a, a)]
diamondLayer 0 = [(0,0)]
diamondLayer n :: a
n =
let tr :: [(a, a)]
tr = [ (a
x,a
na -> a -> a
forall a. Num a => a -> a -> a
-a
x) | a
x <- [0..a
na -> a -> a
forall a. Num a => a -> a -> a
-1] ]
r :: [(a, a)]
r = [(a, a)]
tr [(a, a)] -> [(a, a)] -> [(a, a)]
forall a. [a] -> [a] -> [a]
++ (((a, a) -> (a, a)) -> [(a, a)] -> [(a, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\(x :: a
x,y :: a
y) -> (a
y,-a
x)) [(a, a)]
tr)
in [(a, a)]
r [(a, a)] -> [(a, a)] -> [(a, a)]
forall a. [a] -> [a] -> [a]
++ (((a, a) -> (a, a)) -> [(a, a)] -> [(a, a)]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a
forall a. Num a => a -> a
negate (a -> a) -> (a -> a) -> (a, a) -> (a, a)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** a -> a
forall a. Num a => a -> a
negate) [(a, a)]
r)
diamond :: (Enum a, Num a, Eq a) => [(a, a)]
diamond :: [(a, a)]
diamond = (a -> [(a, a)]) -> [a] -> [(a, a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap a -> [(a, a)]
forall a. (Enum a, Num a, Eq a) => a -> [(a, a)]
diamondLayer [0..]
diamondRestrict :: Integer -> Integer -> Integer -> Integer -> [(Integer, Integer)]
diamondRestrict :: Integer -> Integer -> Integer -> Integer -> [TwoDPosition]
diamondRestrict x :: Integer
x y :: Integer
y originX :: Integer
originX originY :: Integer
originY =
(TwoDPosition -> Bool) -> [TwoDPosition] -> [TwoDPosition]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (\(x' :: Integer
x',y' :: Integer
y') -> Integer -> Integer
forall a. Num a => a -> a
abs Integer
x' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
x Bool -> Bool -> Bool
&& Integer -> Integer
forall a. Num a => a -> a
abs Integer
y' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
y) ([TwoDPosition] -> [TwoDPosition])
-> ([TwoDPosition] -> [TwoDPosition])
-> [TwoDPosition]
-> [TwoDPosition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(TwoDPosition -> TwoDPosition) -> [TwoDPosition] -> [TwoDPosition]
forall a b. (a -> b) -> [a] -> [b]
map (\(x' :: Integer
x', y' :: Integer
y') -> (Integer
x' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer -> Integer
forall a. Num a => Integer -> a
fromInteger Integer
originX, Integer
y' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer -> Integer
forall a. Num a => Integer -> a
fromInteger Integer
originY)) ([TwoDPosition] -> [TwoDPosition])
-> ([TwoDPosition] -> [TwoDPosition])
-> [TwoDPosition]
-> [TwoDPosition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> [TwoDPosition] -> [TwoDPosition]
forall a. Int -> [a] -> [a]
take 1000 ([TwoDPosition] -> [TwoDPosition])
-> [TwoDPosition] -> [TwoDPosition]
forall a b. (a -> b) -> a -> b
$ [TwoDPosition]
forall a. (Enum a, Num a, Eq a) => [(a, a)]
diamond
findInElementMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b)
findInElementMap :: a -> [(a, b)] -> Maybe (a, b)
findInElementMap pos :: a
pos = ((a, b) -> Bool) -> [(a, b)] -> Maybe (a, b)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
pos) (a -> Bool) -> ((a, b) -> a) -> (a, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> a
forall a b. (a, b) -> a
fst)
drawWinBox :: Window -> XMonadFont -> (String, String) -> String -> Integer -> Integer -> String -> Integer -> Integer -> Integer -> X ()
drawWinBox :: Window
-> XMonadFont
-> (String, String)
-> String
-> Integer
-> Integer
-> String
-> Integer
-> Integer
-> Integer
-> X ()
drawWinBox win :: Window
win font :: XMonadFont
font (fg :: String
fg,bg :: String
bg) bc :: String
bc ch :: Integer
ch cw :: Integer
cw text :: String
text x :: Integer
x y :: Integer
y cp :: Integer
cp =
(Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \dpy :: Display
dpy -> do
GC
gc <- IO GC -> X GC
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GC -> X GC) -> IO GC -> X GC
forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO GC
createGC Display
dpy Window
win
GC
bordergc <- IO GC -> X GC
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GC -> X GC) -> IO GC -> X GC
forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO GC
createGC Display
dpy Window
win
IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ do
Just fgcolor :: Window
fgcolor <- Display -> String -> IO (Maybe Window)
initColor Display
dpy String
fg
Just bgcolor :: Window
bgcolor <- Display -> String -> IO (Maybe Window)
initColor Display
dpy String
bg
Just bordercolor :: Window
bordercolor <- Display -> String -> IO (Maybe Window)
initColor Display
dpy String
bc
Display -> GC -> Window -> IO ()
setForeground Display
dpy GC
gc Window
fgcolor
Display -> GC -> Window -> IO ()
setBackground Display
dpy GC
gc Window
bgcolor
Display -> GC -> Window -> IO ()
setForeground Display
dpy GC
bordergc Window
bordercolor
Display
-> Window
-> GC
-> Position
-> Position
-> Dimension
-> Dimension
-> IO ()
fillRectangle Display
dpy Window
win GC
gc (Integer -> Position
forall a. Num a => Integer -> a
fromInteger Integer
x) (Integer -> Position
forall a. Num a => Integer -> a
fromInteger Integer
y) (Integer -> Dimension
forall a. Num a => Integer -> a
fromInteger Integer
cw) (Integer -> Dimension
forall a. Num a => Integer -> a
fromInteger Integer
ch)
Display
-> Window
-> GC
-> Position
-> Position
-> Dimension
-> Dimension
-> IO ()
drawRectangle Display
dpy Window
win GC
bordergc (Integer -> Position
forall a. Num a => Integer -> a
fromInteger Integer
x) (Integer -> Position
forall a. Num a => Integer -> a
fromInteger Integer
y) (Integer -> Dimension
forall a. Num a => Integer -> a
fromInteger Integer
cw) (Integer -> Dimension
forall a. Num a => Integer -> a
fromInteger Integer
ch)
String
stext <- (String -> [String]) -> (String -> X Bool) -> String -> X String
shrinkWhile (DefaultShrinker -> String -> [String]
forall s. Shrinker s => s -> String -> [String]
shrinkIt DefaultShrinker
shrinkText)
(\n :: String
n -> do Int
size <- IO Int -> X Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> X Int) -> IO Int -> X Int
forall a b. (a -> b) -> a -> b
$ Display -> XMonadFont -> String -> IO Int
forall (m :: * -> *).
MonadIO m =>
Display -> XMonadFont -> String -> m Int
textWidthXMF Display
dpy XMonadFont
font String
n
Bool -> X Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> X Bool) -> Bool -> X Bool
forall a b. (a -> b) -> a -> b
$ Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer
cwInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-(2Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
cp))))
String
text
(asc :: Position
asc,desc :: Position
desc) <- IO (Position, Position) -> X (Position, Position)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Position, Position) -> X (Position, Position))
-> IO (Position, Position) -> X (Position, Position)
forall a b. (a -> b) -> a -> b
$ XMonadFont -> String -> IO (Position, Position)
forall (m :: * -> *).
MonadIO m =>
XMonadFont -> String -> m (Position, Position)
textExtentsXMF XMonadFont
font String
stext
let offset :: Integer
offset = ((Integer
ch Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Position -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Position
asc Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
desc)) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` 2) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Position -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
asc
Display
-> Window
-> XMonadFont
-> GC
-> String
-> String
-> Position
-> Position
-> String
-> X ()
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display
-> Window
-> XMonadFont
-> GC
-> String
-> String
-> Position
-> Position
-> String
-> m ()
printStringXMF Display
dpy Window
win XMonadFont
font GC
gc String
bg String
fg (Integer -> Position
forall a. Num a => Integer -> a
fromInteger (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
cp)) (Integer -> Position
forall a. Num a => Integer -> a
fromInteger (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
offset)) String
stext
IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> GC -> IO ()
freeGC Display
dpy GC
gc
IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> GC -> IO ()
freeGC Display
dpy GC
bordergc
updateAllElements :: TwoD a ()
updateAllElements :: TwoD a ()
updateAllElements =
do
TwoDState a
s <- TwoD a (TwoDState a)
forall s (m :: * -> *). MonadState s m => m s
get
TwoDElementMap a -> TwoD a ()
forall a. TwoDElementMap a -> TwoD a ()
updateElements (TwoDState a -> TwoDElementMap a
forall a. TwoDState a -> TwoDElementMap a
td_elementmap TwoDState a
s)
grayoutElements :: Int -> TwoD a ()
grayoutElements :: Int -> TwoD a ()
grayoutElements skip :: Int
skip =
do
TwoDState a
s <- TwoD a (TwoDState a)
forall s (m :: * -> *). MonadState s m => m s
get
(a -> Bool -> X (String, String)) -> TwoDElementMap a -> TwoD a ()
forall a.
(a -> Bool -> X (String, String)) -> TwoDElementMap a -> TwoD a ()
updateElementsWithColorizer a -> Bool -> X (String, String)
forall (m :: * -> *) p p. Monad m => p -> p -> m (String, String)
grayOnly (TwoDElementMap a -> TwoD a ()) -> TwoDElementMap a -> TwoD a ()
forall a b. (a -> b) -> a -> b
$ Int -> TwoDElementMap a -> TwoDElementMap a
forall a. Int -> [a] -> [a]
drop Int
skip (TwoDState a -> TwoDElementMap a
forall a. TwoDState a -> TwoDElementMap a
td_elementmap TwoDState a
s)
where grayOnly :: p -> p -> m (String, String)
grayOnly _ _ = (String, String) -> m (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return ("#808080", "#808080")
updateElements :: TwoDElementMap a -> TwoD a ()
updateElements :: TwoDElementMap a -> TwoD a ()
updateElements elementmap :: TwoDElementMap a
elementmap = do
TwoDState a
s <- TwoD a (TwoDState a)
forall s (m :: * -> *). MonadState s m => m s
get
(a -> Bool -> X (String, String)) -> TwoDElementMap a -> TwoD a ()
forall a.
(a -> Bool -> X (String, String)) -> TwoDElementMap a -> TwoD a ()
updateElementsWithColorizer (GSConfig a -> a -> Bool -> X (String, String)
forall a. GSConfig a -> a -> Bool -> X (String, String)
gs_colorizer (TwoDState a -> GSConfig a
forall a. TwoDState a -> GSConfig a
td_gsconfig TwoDState a
s)) TwoDElementMap a
elementmap
updateElementsWithColorizer :: (a -> Bool -> X (String, String)) -> TwoDElementMap a -> TwoD a ()
updateElementsWithColorizer :: (a -> Bool -> X (String, String)) -> TwoDElementMap a -> TwoD a ()
updateElementsWithColorizer colorizer :: a -> Bool -> X (String, String)
colorizer elementmap :: TwoDElementMap a
elementmap = do
TwoDState { td_curpos :: forall a. TwoDState a -> TwoDPosition
td_curpos = TwoDPosition
curpos,
td_drawingWin :: forall a. TwoDState a -> Window
td_drawingWin = Window
win,
td_gsconfig :: forall a. TwoDState a -> GSConfig a
td_gsconfig = GSConfig a
gsconfig,
td_font :: forall a. TwoDState a -> XMonadFont
td_font = XMonadFont
font,
td_paneX :: forall a. TwoDState a -> Integer
td_paneX = Integer
paneX,
td_paneY :: forall a. TwoDState a -> Integer
td_paneY = Integer
paneY} <- TwoD a (TwoDState a)
forall s (m :: * -> *). MonadState s m => m s
get
let cellwidth :: Integer
cellwidth = GSConfig a -> Integer
forall a. GSConfig a -> Integer
gs_cellwidth GSConfig a
gsconfig
cellheight :: Integer
cellheight = GSConfig a -> Integer
forall a. GSConfig a -> Integer
gs_cellheight GSConfig a
gsconfig
paneX' :: Integer
paneX' = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div (Integer
paneXInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
cellwidth) 2
paneY' :: Integer
paneY' = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div (Integer
paneYInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
cellheight) 2
updateElement :: (TwoDPosition, (String, a)) -> TwoD a ()
updateElement (pos :: TwoDPosition
pos@(x :: Integer
x,y :: Integer
y),(text :: String
text, element :: a
element)) = X () -> TwoD a ()
forall a1 a. X a1 -> TwoD a a1
liftX (X () -> TwoD a ()) -> X () -> TwoD a ()
forall a b. (a -> b) -> a -> b
$ do
(String, String)
colors <- a -> Bool -> X (String, String)
colorizer a
element (TwoDPosition
pos TwoDPosition -> TwoDPosition -> Bool
forall a. Eq a => a -> a -> Bool
== TwoDPosition
curpos)
Window
-> XMonadFont
-> (String, String)
-> String
-> Integer
-> Integer
-> String
-> Integer
-> Integer
-> Integer
-> X ()
drawWinBox Window
win XMonadFont
font
(String, String)
colors
(GSConfig a -> String
forall a. GSConfig a -> String
gs_bordercolor GSConfig a
gsconfig)
Integer
cellheight
Integer
cellwidth
String
text
(Integer
paneX'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
cellwidth)
(Integer
paneY'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
cellheight)
(GSConfig a -> Integer
forall a. GSConfig a -> Integer
gs_cellpadding GSConfig a
gsconfig)
((TwoDPosition, (String, a)) -> TwoD a ())
-> TwoDElementMap a -> TwoD a ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (TwoDPosition, (String, a)) -> TwoD a ()
forall a. (TwoDPosition, (String, a)) -> TwoD a ()
updateElement TwoDElementMap a
elementmap
stdHandle :: Event -> TwoD a (Maybe a) -> TwoD a (Maybe a)
stdHandle :: Event -> TwoD a (Maybe a) -> TwoD a (Maybe a)
stdHandle (ButtonEvent { ev_event_type :: Event -> Dimension
ev_event_type = Dimension
t, ev_x :: Event -> CInt
ev_x = CInt
x, ev_y :: Event -> CInt
ev_y = CInt
y }) contEventloop :: TwoD a (Maybe a)
contEventloop
| Dimension
t Dimension -> Dimension -> Bool
forall a. Eq a => a -> a -> Bool
== Dimension
buttonRelease = do
s :: TwoDState a
s @ TwoDState { td_paneX :: forall a. TwoDState a -> Integer
td_paneX = Integer
px, td_paneY :: forall a. TwoDState a -> Integer
td_paneY = Integer
py,
td_gsconfig :: forall a. TwoDState a -> GSConfig a
td_gsconfig = (GSConfig ch :: Integer
ch cw :: Integer
cw _ _ _ _ _ _ _ _) } <- TwoD a (TwoDState a)
forall s (m :: * -> *). MonadState s m => m s
get
let gridX :: Integer
gridX = (CInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fi CInt
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Integer
px Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
cw) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` 2) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
cw
gridY :: Integer
gridY = (CInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fi CInt
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Integer
py Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
ch) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` 2) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
ch
case TwoDPosition -> [(TwoDPosition, (String, a))] -> Maybe (String, a)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Integer
gridX,Integer
gridY) (TwoDState a -> [(TwoDPosition, (String, a))]
forall a. TwoDState a -> TwoDElementMap a
td_elementmap TwoDState a
s) of
Just (_,el :: a
el) -> Maybe a -> TwoD a (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
el)
Nothing -> TwoD a (Maybe a)
contEventloop
| Bool
otherwise = TwoD a (Maybe a)
contEventloop
stdHandle (ExposeEvent { }) contEventloop :: TwoD a (Maybe a)
contEventloop = TwoD a ()
forall a. TwoD a ()
updateAllElements TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TwoD a (Maybe a)
contEventloop
stdHandle _ contEventloop :: TwoD a (Maybe a)
contEventloop = TwoD a (Maybe a)
contEventloop
makeXEventhandler :: ((KeySym, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
makeXEventhandler :: ((Window, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
makeXEventhandler keyhandler :: (Window, String, KeyMask) -> TwoD a (Maybe a)
keyhandler = (TwoD a (Maybe a) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
forall a. (a -> a) -> a
fix ((TwoD a (Maybe a) -> TwoD a (Maybe a)) -> TwoD a (Maybe a))
-> (TwoD a (Maybe a) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
forall a b. (a -> b) -> a -> b
$ \me :: TwoD a (Maybe a)
me -> TwoD a (TwoD a (Maybe a)) -> TwoD a (Maybe a)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (TwoD a (TwoD a (Maybe a)) -> TwoD a (Maybe a))
-> TwoD a (TwoD a (Maybe a)) -> TwoD a (Maybe a)
forall a b. (a -> b) -> a -> b
$ X (TwoD a (Maybe a)) -> TwoD a (TwoD a (Maybe a))
forall a1 a. X a1 -> TwoD a a1
liftX (X (TwoD a (Maybe a)) -> TwoD a (TwoD a (Maybe a)))
-> X (TwoD a (Maybe a)) -> TwoD a (TwoD a (Maybe a))
forall a b. (a -> b) -> a -> b
$ (Display -> X (TwoD a (Maybe a))) -> X (TwoD a (Maybe a))
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X (TwoD a (Maybe a))) -> X (TwoD a (Maybe a)))
-> (Display -> X (TwoD a (Maybe a))) -> X (TwoD a (Maybe a))
forall a b. (a -> b) -> a -> b
$ \d :: Display
d -> IO (TwoD a (Maybe a)) -> X (TwoD a (Maybe a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TwoD a (Maybe a)) -> X (TwoD a (Maybe a)))
-> IO (TwoD a (Maybe a)) -> X (TwoD a (Maybe a))
forall a b. (a -> b) -> a -> b
$ (XEventPtr -> IO (TwoD a (Maybe a))) -> IO (TwoD a (Maybe a))
forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent ((XEventPtr -> IO (TwoD a (Maybe a))) -> IO (TwoD a (Maybe a)))
-> (XEventPtr -> IO (TwoD a (Maybe a))) -> IO (TwoD a (Maybe a))
forall a b. (a -> b) -> a -> b
$ \e :: XEventPtr
e -> do
Display -> Window -> XEventPtr -> IO ()
maskEvent Display
d (Window
exposureMask Window -> Window -> Window
forall a. Bits a => a -> a -> a
.|. Window
keyPressMask Window -> Window -> Window
forall a. Bits a => a -> a -> a
.|. Window
buttonReleaseMask) XEventPtr
e
Event
ev <- XEventPtr -> IO Event
getEvent XEventPtr
e
if Event -> Dimension
ev_event_type Event
ev Dimension -> Dimension -> Bool
forall a. Eq a => a -> a -> Bool
== Dimension
keyPress
then do
(ks :: Maybe Window
ks,s :: String
s) <- XKeyEventPtr -> IO (Maybe Window, String)
lookupString (XKeyEventPtr -> IO (Maybe Window, String))
-> XKeyEventPtr -> IO (Maybe Window, String)
forall a b. (a -> b) -> a -> b
$ XEventPtr -> XKeyEventPtr
asKeyEvent XEventPtr
e
TwoD a (Maybe a) -> IO (TwoD a (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (TwoD a (Maybe a) -> IO (TwoD a (Maybe a)))
-> TwoD a (Maybe a) -> IO (TwoD a (Maybe a))
forall a b. (a -> b) -> a -> b
$ do
KeyMask
mask <- X KeyMask -> TwoD a KeyMask
forall a1 a. X a1 -> TwoD a a1
liftX (X KeyMask -> TwoD a KeyMask) -> X KeyMask -> TwoD a KeyMask
forall a b. (a -> b) -> a -> b
$ KeyMask -> X KeyMask
cleanMask (Event -> KeyMask
ev_state Event
ev)
(Window, String, KeyMask) -> TwoD a (Maybe a)
keyhandler (Window -> Maybe Window -> Window
forall a. a -> Maybe a -> a
fromMaybe Window
xK_VoidSymbol Maybe Window
ks, String
s, KeyMask
mask)
else
TwoD a (Maybe a) -> IO (TwoD a (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (TwoD a (Maybe a) -> IO (TwoD a (Maybe a)))
-> TwoD a (Maybe a) -> IO (TwoD a (Maybe a))
forall a b. (a -> b) -> a -> b
$ Event -> TwoD a (Maybe a) -> TwoD a (Maybe a)
forall a. Event -> TwoD a (Maybe a) -> TwoD a (Maybe a)
stdHandle Event
ev TwoD a (Maybe a)
me
shadowWithKeymap :: M.Map (KeyMask, KeySym) a -> ((KeySym, String, KeyMask) -> a) -> (KeySym, String, KeyMask) -> a
shadowWithKeymap :: Map (KeyMask, Window) a
-> ((Window, String, KeyMask) -> a)
-> (Window, String, KeyMask)
-> a
shadowWithKeymap keymap :: Map (KeyMask, Window) a
keymap dflt :: (Window, String, KeyMask) -> a
dflt keyEvent :: (Window, String, KeyMask)
keyEvent@(ks :: Window
ks,_,m' :: KeyMask
m') = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe ((Window, String, KeyMask) -> a
dflt (Window, String, KeyMask)
keyEvent) ((KeyMask, Window) -> Map (KeyMask, Window) a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (KeyMask
m',Window
ks) Map (KeyMask, Window) a
keymap)
select :: TwoD a (Maybe a)
select :: TwoD a (Maybe a)
select = do
TwoDState a
s <- TwoD a (TwoDState a)
forall s (m :: * -> *). MonadState s m => m s
get
Maybe a -> TwoD a (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> TwoD a (Maybe a)) -> Maybe a -> TwoD a (Maybe a)
forall a b. (a -> b) -> a -> b
$ ((TwoDPosition, (String, a)) -> a)
-> Maybe (TwoDPosition, (String, a)) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String, a) -> a
forall a b. (a, b) -> b
snd ((String, a) -> a)
-> ((TwoDPosition, (String, a)) -> (String, a))
-> (TwoDPosition, (String, a))
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TwoDPosition, (String, a)) -> (String, a)
forall a b. (a, b) -> b
snd) (Maybe (TwoDPosition, (String, a)) -> Maybe a)
-> Maybe (TwoDPosition, (String, a)) -> Maybe a
forall a b. (a -> b) -> a -> b
$ TwoDPosition
-> [(TwoDPosition, (String, a))]
-> Maybe (TwoDPosition, (String, a))
forall a b. Eq a => a -> [(a, b)] -> Maybe (a, b)
findInElementMap (TwoDState a -> TwoDPosition
forall a. TwoDState a -> TwoDPosition
td_curpos TwoDState a
s) (TwoDState a -> [(TwoDPosition, (String, a))]
forall a. TwoDState a -> TwoDElementMap a
td_elementmap TwoDState a
s)
cancel :: TwoD a (Maybe a)
cancel :: TwoD a (Maybe a)
cancel = Maybe a -> TwoD a (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
setPos :: (Integer, Integer) -> TwoD a ()
setPos :: TwoDPosition -> TwoD a ()
setPos newPos :: TwoDPosition
newPos = do
TwoDState a
s <- TwoD a (TwoDState a)
forall s (m :: * -> *). MonadState s m => m s
get
let elmap :: TwoDElementMap a
elmap = TwoDState a -> TwoDElementMap a
forall a. TwoDState a -> TwoDElementMap a
td_elementmap TwoDState a
s
newSelectedEl :: Maybe (TwoDPosition, (String, a))
newSelectedEl = TwoDPosition
-> TwoDElementMap a -> Maybe (TwoDPosition, (String, a))
forall a b. Eq a => a -> [(a, b)] -> Maybe (a, b)
findInElementMap TwoDPosition
newPos (TwoDState a -> TwoDElementMap a
forall a. TwoDState a -> TwoDElementMap a
td_elementmap TwoDState a
s)
oldPos :: TwoDPosition
oldPos = TwoDState a -> TwoDPosition
forall a. TwoDState a -> TwoDPosition
td_curpos TwoDState a
s
Bool -> TwoD a () -> TwoD a ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (TwoDPosition, (String, a)) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (TwoDPosition, (String, a))
newSelectedEl Bool -> Bool -> Bool
&& TwoDPosition
newPos TwoDPosition -> TwoDPosition -> Bool
forall a. Eq a => a -> a -> Bool
/= TwoDPosition
oldPos) (TwoD a () -> TwoD a ()) -> TwoD a () -> TwoD a ()
forall a b. (a -> b) -> a -> b
$ do
TwoDState a -> TwoD a ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put TwoDState a
s { td_curpos :: TwoDPosition
td_curpos = TwoDPosition
newPos }
TwoDElementMap a -> TwoD a ()
forall a. TwoDElementMap a -> TwoD a ()
updateElements ([Maybe (TwoDPosition, (String, a))] -> TwoDElementMap a
forall a. [Maybe a] -> [a]
catMaybes [(TwoDPosition
-> TwoDElementMap a -> Maybe (TwoDPosition, (String, a))
forall a b. Eq a => a -> [(a, b)] -> Maybe (a, b)
findInElementMap TwoDPosition
oldPos TwoDElementMap a
elmap), Maybe (TwoDPosition, (String, a))
newSelectedEl])
move :: (Integer, Integer) -> TwoD a ()
move :: TwoDPosition -> TwoD a ()
move (dx :: Integer
dx,dy :: Integer
dy) = do
TwoDState a
s <- TwoD a (TwoDState a)
forall s (m :: * -> *). MonadState s m => m s
get
let (x :: Integer
x,y :: Integer
y) = TwoDState a -> TwoDPosition
forall a. TwoDState a -> TwoDPosition
td_curpos TwoDState a
s
newPos :: TwoDPosition
newPos = (Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
dx,Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
dy)
TwoDPosition -> TwoD a ()
forall a. TwoDPosition -> TwoD a ()
setPos TwoDPosition
newPos
moveNext :: TwoD a ()
moveNext :: TwoD a ()
moveNext = do
TwoDPosition
position <- (TwoDState a -> TwoDPosition) -> TwoD a TwoDPosition
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TwoDState a -> TwoDPosition
forall a. TwoDState a -> TwoDPosition
td_curpos
TwoDElementMap a
elems <- (TwoDState a -> TwoDElementMap a) -> TwoD a (TwoDElementMap a)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TwoDState a -> TwoDElementMap a
forall a. TwoDState a -> TwoDElementMap a
td_elementmap
let n :: Int
n = TwoDElementMap a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length TwoDElementMap a
elems
m :: Maybe Int
m = case ((TwoDPosition, (String, a)) -> Bool)
-> TwoDElementMap a -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (\p :: (TwoDPosition, (String, a))
p -> (TwoDPosition, (String, a)) -> TwoDPosition
forall a b. (a, b) -> a
fst (TwoDPosition, (String, a))
p TwoDPosition -> TwoDPosition -> Bool
forall a. Eq a => a -> a -> Bool
== TwoDPosition
position) TwoDElementMap a
elems of
Nothing -> Maybe Int
forall a. Maybe a
Nothing
Just k :: Int
k | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1 -> Int -> Maybe Int
forall a. a -> Maybe a
Just 0
| Bool
otherwise -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
Maybe Int -> (Int -> TwoD a ()) -> TwoD a ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Int
m ((Int -> TwoD a ()) -> TwoD a ())
-> (Int -> TwoD a ()) -> TwoD a ()
forall a b. (a -> b) -> a -> b
$ \i :: Int
i ->
TwoDPosition -> TwoD a ()
forall a. TwoDPosition -> TwoD a ()
setPos ((TwoDPosition, (String, a)) -> TwoDPosition
forall a b. (a, b) -> a
fst ((TwoDPosition, (String, a)) -> TwoDPosition)
-> (TwoDPosition, (String, a)) -> TwoDPosition
forall a b. (a -> b) -> a -> b
$ TwoDElementMap a
elems TwoDElementMap a -> Int -> (TwoDPosition, (String, a))
forall a. [a] -> Int -> a
!! Int
i)
movePrev :: TwoD a ()
movePrev :: TwoD a ()
movePrev = do
TwoDPosition
position <- (TwoDState a -> TwoDPosition) -> TwoD a TwoDPosition
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TwoDState a -> TwoDPosition
forall a. TwoDState a -> TwoDPosition
td_curpos
TwoDElementMap a
elems <- (TwoDState a -> TwoDElementMap a) -> TwoD a (TwoDElementMap a)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TwoDState a -> TwoDElementMap a
forall a. TwoDState a -> TwoDElementMap a
td_elementmap
let n :: Int
n = TwoDElementMap a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length TwoDElementMap a
elems
m :: Maybe Int
m = case ((TwoDPosition, (String, a)) -> Bool)
-> TwoDElementMap a -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (\p :: (TwoDPosition, (String, a))
p -> (TwoDPosition, (String, a)) -> TwoDPosition
forall a b. (a, b) -> a
fst (TwoDPosition, (String, a))
p TwoDPosition -> TwoDPosition -> Bool
forall a. Eq a => a -> a -> Bool
== TwoDPosition
position) TwoDElementMap a
elems of
Nothing -> Maybe Int
forall a. Maybe a
Nothing
Just 0 -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
Just k :: Int
k -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
Maybe Int -> (Int -> TwoD a ()) -> TwoD a ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Int
m ((Int -> TwoD a ()) -> TwoD a ())
-> (Int -> TwoD a ()) -> TwoD a ()
forall a b. (a -> b) -> a -> b
$ \i :: Int
i ->
TwoDPosition -> TwoD a ()
forall a. TwoDPosition -> TwoD a ()
setPos ((TwoDPosition, (String, a)) -> TwoDPosition
forall a b. (a, b) -> a
fst ((TwoDPosition, (String, a)) -> TwoDPosition)
-> (TwoDPosition, (String, a)) -> TwoDPosition
forall a b. (a -> b) -> a -> b
$ TwoDElementMap a
elems TwoDElementMap a -> Int -> (TwoDPosition, (String, a))
forall a. [a] -> Int -> a
!! Int
i)
transformSearchString :: (String -> String) -> TwoD a ()
transformSearchString :: (String -> String) -> TwoD a ()
transformSearchString f :: String -> String
f = do
TwoDState a
s <- TwoD a (TwoDState a)
forall s (m :: * -> *). MonadState s m => m s
get
let oldSearchString :: String
oldSearchString = TwoDState a -> String
forall a. TwoDState a -> String
td_searchString TwoDState a
s
newSearchString :: String
newSearchString = String -> String
f String
oldSearchString
Bool -> TwoD a () -> TwoD a ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
newSearchString String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
oldSearchString) (TwoD a () -> TwoD a ()) -> TwoD a () -> TwoD a ()
forall a b. (a -> b) -> a -> b
$ do
let s' :: TwoDState a
s' = TwoDState a
s { td_searchString :: String
td_searchString = String
newSearchString }
TwoDElementMap a
m <- X (TwoDElementMap a) -> TwoD a (TwoDElementMap a)
forall a1 a. X a1 -> TwoD a a1
liftX (X (TwoDElementMap a) -> TwoD a (TwoDElementMap a))
-> X (TwoDElementMap a) -> TwoD a (TwoDElementMap a)
forall a b. (a -> b) -> a -> b
$ TwoDState a -> X (TwoDElementMap a)
forall a. TwoDState a -> X (TwoDElementMap a)
generateElementmap TwoDState a
s'
let s'' :: TwoDState a
s'' = TwoDState a
s' { td_elementmap :: TwoDElementMap a
td_elementmap = TwoDElementMap a
m }
oldLen :: Int
oldLen = TwoDElementMap a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (TwoDElementMap a -> Int) -> TwoDElementMap a -> Int
forall a b. (a -> b) -> a -> b
$ TwoDState a -> TwoDElementMap a
forall a. TwoDState a -> TwoDElementMap a
td_elementmap TwoDState a
s
newLen :: Int
newLen = TwoDElementMap a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (TwoDElementMap a -> Int) -> TwoDElementMap a -> Int
forall a b. (a -> b) -> a -> b
$ TwoDState a -> TwoDElementMap a
forall a. TwoDState a -> TwoDElementMap a
td_elementmap TwoDState a
s''
Bool -> TwoD a () -> TwoD a ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
newLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
oldLen) (TwoD a () -> TwoD a ()) -> TwoD a () -> TwoD a ()
forall a b. (a -> b) -> a -> b
$ Int -> TwoD a ()
forall a. Int -> TwoD a ()
grayoutElements Int
newLen
TwoDState a -> TwoD a ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put TwoDState a
s''
TwoD a ()
forall a. TwoD a ()
updateAllElements
defaultNavigation :: TwoD a (Maybe a)
defaultNavigation :: TwoD a (Maybe a)
defaultNavigation = ((Window, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
forall a.
((Window, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
makeXEventhandler (((Window, String, KeyMask) -> TwoD a (Maybe a))
-> TwoD a (Maybe a))
-> ((Window, String, KeyMask) -> TwoD a (Maybe a))
-> TwoD a (Maybe a)
forall a b. (a -> b) -> a -> b
$ Map (KeyMask, Window) (TwoD a (Maybe a))
-> ((Window, String, KeyMask) -> TwoD a (Maybe a))
-> (Window, String, KeyMask)
-> TwoD a (Maybe a)
forall a.
Map (KeyMask, Window) a
-> ((Window, String, KeyMask) -> a)
-> (Window, String, KeyMask)
-> a
shadowWithKeymap Map (KeyMask, Window) (TwoD a (Maybe a))
forall a. Map (KeyMask, Window) (TwoD a (Maybe a))
navKeyMap (Window, String, KeyMask) -> TwoD a (Maybe a)
forall b a. b -> TwoD a (Maybe a)
navDefaultHandler
where navKeyMap :: Map (KeyMask, Window) (TwoD a (Maybe a))
navKeyMap = [((KeyMask, Window), TwoD a (Maybe a))]
-> Map (KeyMask, Window) (TwoD a (Maybe a))
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
((0,Window
xK_Escape) , TwoD a (Maybe a)
forall a. TwoD a (Maybe a)
cancel)
,((0,Window
xK_Return) , TwoD a (Maybe a)
forall a. TwoD a (Maybe a)
select)
,((0,Window
xK_slash) , TwoD a (Maybe a) -> TwoD a (Maybe a)
forall a. TwoD a (Maybe a) -> TwoD a (Maybe a)
substringSearch TwoD a (Maybe a)
forall a. TwoD a (Maybe a)
defaultNavigation)
,((0,Window
xK_Left) , TwoDPosition -> TwoD a ()
forall a. TwoDPosition -> TwoD a ()
move (-1,0) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TwoD a (Maybe a)
forall a. TwoD a (Maybe a)
defaultNavigation)
,((0,Window
xK_h) , TwoDPosition -> TwoD a ()
forall a. TwoDPosition -> TwoD a ()
move (-1,0) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TwoD a (Maybe a)
forall a. TwoD a (Maybe a)
defaultNavigation)
,((0,Window
xK_Right) , TwoDPosition -> TwoD a ()
forall a. TwoDPosition -> TwoD a ()
move (1,0) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TwoD a (Maybe a)
forall a. TwoD a (Maybe a)
defaultNavigation)
,((0,Window
xK_l) , TwoDPosition -> TwoD a ()
forall a. TwoDPosition -> TwoD a ()
move (1,0) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TwoD a (Maybe a)
forall a. TwoD a (Maybe a)
defaultNavigation)
,((0,Window
xK_Down) , TwoDPosition -> TwoD a ()
forall a. TwoDPosition -> TwoD a ()
move (0,1) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TwoD a (Maybe a)
forall a. TwoD a (Maybe a)
defaultNavigation)
,((0,Window
xK_j) , TwoDPosition -> TwoD a ()
forall a. TwoDPosition -> TwoD a ()
move (0,1) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TwoD a (Maybe a)
forall a. TwoD a (Maybe a)
defaultNavigation)
,((0,Window
xK_Up) , TwoDPosition -> TwoD a ()
forall a. TwoDPosition -> TwoD a ()
move (0,-1) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TwoD a (Maybe a)
forall a. TwoD a (Maybe a)
defaultNavigation)
,((0,Window
xK_k) , TwoDPosition -> TwoD a ()
forall a. TwoDPosition -> TwoD a ()
move (0,-1) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TwoD a (Maybe a)
forall a. TwoD a (Maybe a)
defaultNavigation)
,((0,Window
xK_Tab) , TwoD a ()
forall a. TwoD a ()
moveNext TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TwoD a (Maybe a)
forall a. TwoD a (Maybe a)
defaultNavigation)
,((0,Window
xK_n) , TwoD a ()
forall a. TwoD a ()
moveNext TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TwoD a (Maybe a)
forall a. TwoD a (Maybe a)
defaultNavigation)
,((KeyMask
shiftMask,Window
xK_Tab), TwoD a ()
forall a. TwoD a ()
movePrev TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TwoD a (Maybe a)
forall a. TwoD a (Maybe a)
defaultNavigation)
,((0,Window
xK_p) , TwoD a ()
forall a. TwoD a ()
movePrev TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TwoD a (Maybe a)
forall a. TwoD a (Maybe a)
defaultNavigation)
]
navDefaultHandler :: b -> TwoD a (Maybe a)
navDefaultHandler = TwoD a (Maybe a) -> b -> TwoD a (Maybe a)
forall a b. a -> b -> a
const TwoD a (Maybe a)
forall a. TwoD a (Maybe a)
defaultNavigation
navNSearch :: TwoD a (Maybe a)
navNSearch :: TwoD a (Maybe a)
navNSearch = ((Window, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
forall a.
((Window, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
makeXEventhandler (((Window, String, KeyMask) -> TwoD a (Maybe a))
-> TwoD a (Maybe a))
-> ((Window, String, KeyMask) -> TwoD a (Maybe a))
-> TwoD a (Maybe a)
forall a b. (a -> b) -> a -> b
$ Map (KeyMask, Window) (TwoD a (Maybe a))
-> ((Window, String, KeyMask) -> TwoD a (Maybe a))
-> (Window, String, KeyMask)
-> TwoD a (Maybe a)
forall a.
Map (KeyMask, Window) a
-> ((Window, String, KeyMask) -> a)
-> (Window, String, KeyMask)
-> a
shadowWithKeymap Map (KeyMask, Window) (TwoD a (Maybe a))
forall a. Map (KeyMask, Window) (TwoD a (Maybe a))
navNSearchKeyMap (Window, String, KeyMask) -> TwoD a (Maybe a)
forall a c a. (a, String, c) -> TwoD a (Maybe a)
navNSearchDefaultHandler
where navNSearchKeyMap :: Map (KeyMask, Window) (TwoD a (Maybe a))
navNSearchKeyMap = [((KeyMask, Window), TwoD a (Maybe a))]
-> Map (KeyMask, Window) (TwoD a (Maybe a))
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
((0,Window
xK_Escape) , TwoD a (Maybe a)
forall a. TwoD a (Maybe a)
cancel)
,((0,Window
xK_Return) , TwoD a (Maybe a)
forall a. TwoD a (Maybe a)
select)
,((0,Window
xK_Left) , TwoDPosition -> TwoD a ()
forall a. TwoDPosition -> TwoD a ()
move (-1,0) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TwoD a (Maybe a)
forall a. TwoD a (Maybe a)
navNSearch)
,((0,Window
xK_Right) , TwoDPosition -> TwoD a ()
forall a. TwoDPosition -> TwoD a ()
move (1,0) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TwoD a (Maybe a)
forall a. TwoD a (Maybe a)
navNSearch)
,((0,Window
xK_Down) , TwoDPosition -> TwoD a ()
forall a. TwoDPosition -> TwoD a ()
move (0,1) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TwoD a (Maybe a)
forall a. TwoD a (Maybe a)
navNSearch)
,((0,Window
xK_Up) , TwoDPosition -> TwoD a ()
forall a. TwoDPosition -> TwoD a ()
move (0,-1) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TwoD a (Maybe a)
forall a. TwoD a (Maybe a)
navNSearch)
,((0,Window
xK_Tab) , TwoD a ()
forall a. TwoD a ()
moveNext TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TwoD a (Maybe a)
forall a. TwoD a (Maybe a)
navNSearch)
,((KeyMask
shiftMask,Window
xK_Tab), TwoD a ()
forall a. TwoD a ()
movePrev TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TwoD a (Maybe a)
forall a. TwoD a (Maybe a)
navNSearch)
,((0,Window
xK_BackSpace), (String -> String) -> TwoD a ()
forall a. (String -> String) -> TwoD a ()
transformSearchString (\s :: String
s -> if (String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "") then "" else String -> String
forall a. [a] -> [a]
init String
s) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TwoD a (Maybe a)
forall a. TwoD a (Maybe a)
navNSearch)
]
navNSearchDefaultHandler :: (a, String, c) -> TwoD a (Maybe a)
navNSearchDefaultHandler (_,s :: String
s,_) = do
(String -> String) -> TwoD a ()
forall a. (String -> String) -> TwoD a ()
transformSearchString (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
TwoD a (Maybe a)
forall a. TwoD a (Maybe a)
navNSearch
substringSearch :: TwoD a (Maybe a) -> TwoD a (Maybe a)
substringSearch :: TwoD a (Maybe a) -> TwoD a (Maybe a)
substringSearch returnNavigation :: TwoD a (Maybe a)
returnNavigation = (TwoD a (Maybe a) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
forall a. (a -> a) -> a
fix ((TwoD a (Maybe a) -> TwoD a (Maybe a)) -> TwoD a (Maybe a))
-> (TwoD a (Maybe a) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
forall a b. (a -> b) -> a -> b
$ \me :: TwoD a (Maybe a)
me ->
let searchKeyMap :: Map (KeyMask, Window) (TwoD a (Maybe a))
searchKeyMap = [((KeyMask, Window), TwoD a (Maybe a))]
-> Map (KeyMask, Window) (TwoD a (Maybe a))
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
((0,Window
xK_Escape) , (String -> String) -> TwoD a ()
forall a. (String -> String) -> TwoD a ()
transformSearchString (String -> String -> String
forall a b. a -> b -> a
const "") TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TwoD a (Maybe a)
returnNavigation)
,((0,Window
xK_Return) , TwoD a (Maybe a)
returnNavigation)
,((0,Window
xK_BackSpace), (String -> String) -> TwoD a ()
forall a. (String -> String) -> TwoD a ()
transformSearchString (\s :: String
s -> if (String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "") then "" else String -> String
forall a. [a] -> [a]
init String
s) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TwoD a (Maybe a)
me)
]
searchDefaultHandler :: (a, String, c) -> TwoD a (Maybe a)
searchDefaultHandler (_,s :: String
s,_) = do
(String -> String) -> TwoD a ()
forall a. (String -> String) -> TwoD a ()
transformSearchString (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
TwoD a (Maybe a)
me
in ((Window, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
forall a.
((Window, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
makeXEventhandler (((Window, String, KeyMask) -> TwoD a (Maybe a))
-> TwoD a (Maybe a))
-> ((Window, String, KeyMask) -> TwoD a (Maybe a))
-> TwoD a (Maybe a)
forall a b. (a -> b) -> a -> b
$ Map (KeyMask, Window) (TwoD a (Maybe a))
-> ((Window, String, KeyMask) -> TwoD a (Maybe a))
-> (Window, String, KeyMask)
-> TwoD a (Maybe a)
forall a.
Map (KeyMask, Window) a
-> ((Window, String, KeyMask) -> a)
-> (Window, String, KeyMask)
-> a
shadowWithKeymap Map (KeyMask, Window) (TwoD a (Maybe a))
searchKeyMap (Window, String, KeyMask) -> TwoD a (Maybe a)
forall a c. (a, String, c) -> TwoD a (Maybe a)
searchDefaultHandler
hsv2rgb :: Fractional a => (Integer,a,a) -> (a,a,a)
hsv2rgb :: (Integer, a, a) -> (a, a, a)
hsv2rgb (h :: Integer
h,s :: a
s,v :: a
v) =
let hi :: Integer
hi = (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
h 60) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` 6 :: Integer
f :: a
f = (((Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
h)a -> a -> a
forall a. Fractional a => a -> a -> a
/60) a -> a -> a
forall a. Num a => a -> a -> a
- (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
hi)) :: Fractional a => a
q :: a
q = a
v a -> a -> a
forall a. Num a => a -> a -> a
* (1a -> a -> a
forall a. Num a => a -> a -> a
-a
f)
p :: a
p = a
v a -> a -> a
forall a. Num a => a -> a -> a
* (1a -> a -> a
forall a. Num a => a -> a -> a
-a
s)
t :: a
t = a
v a -> a -> a
forall a. Num a => a -> a -> a
* (1a -> a -> a
forall a. Num a => a -> a -> a
-(1a -> a -> a
forall a. Num a => a -> a -> a
-a
f)a -> a -> a
forall a. Num a => a -> a -> a
*a
s)
in case Integer
hi of
0 -> (a
v,a
t,a
p)
1 -> (a
q,a
v,a
p)
2 -> (a
p,a
v,a
t)
3 -> (a
p,a
q,a
v)
4 -> (a
t,a
p,a
v)
5 -> (a
v,a
p,a
q)
_ -> String -> (a, a, a)
forall a. HasCallStack => String -> a
error "The world is ending. x mod a >= a."
stringColorizer :: String -> Bool -> X (String, String)
stringColorizer :: String -> Bool -> X (String, String)
stringColorizer s :: String
s active :: Bool
active =
let seed :: Int -> Integer
seed x :: Int
x = Int -> Integer
forall a. Integral a => a -> Integer
toInteger ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
x)(Int -> Int) -> (Char -> Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Int
forall a. Enum a => a -> Int
fromEnum) String
s) :: Integer
(r :: Double
r,g :: Double
g,b :: Double
b) = (Integer, Double, Double) -> (Double, Double, Double)
forall a. Fractional a => (Integer, a, a) -> (a, a, a)
hsv2rgb ((Int -> Integer
seed 83) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` 360,
(Integer -> Double
forall a. Num a => Integer -> a
fromInteger ((Int -> Integer
seed 191) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` 1000))Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/2500Double -> Double -> Double
forall a. Num a => a -> a -> a
+0.4,
(Integer -> Double
forall a. Num a => Integer -> a
fromInteger ((Int -> Integer
seed 121) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` 1000))Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/2500Double -> Double -> Double
forall a. Num a => a -> a -> a
+0.4)
in if Bool
active
then (String, String) -> X (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return ("#faff69", "black")
else (String, String) -> X (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return ("#" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Double -> String) -> [Double] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Word8 -> String
twodigitHex(Word8 -> String) -> (Double -> Word8) -> Double -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Double -> Word8
forall a b. (RealFrac a, Integral b) => a -> b
round :: Double -> Word8)(Double -> Word8) -> (Double -> Double) -> Double -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Double -> Double -> Double
forall a. Num a => a -> a -> a
*256)) [Double
r, Double
g, Double
b] ), "white")
fromClassName :: Window -> Bool -> X (String, String)
fromClassName :: Window -> Bool -> X (String, String)
fromClassName w :: Window
w active :: Bool
active = Query String -> Window -> X String
forall a. Query a -> Window -> X a
runQuery Query String
className Window
w X String -> (String -> X (String, String)) -> X (String, String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Bool -> X (String, String))
-> Bool -> String -> X (String, String)
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Bool -> X (String, String)
forall a. HasColorizer a => a -> Bool -> X (String, String)
defaultColorizer Bool
active
twodigitHex :: Word8 -> String
twodigitHex :: Word8 -> String
twodigitHex a :: Word8
a = String -> Word8 -> String
forall r. PrintfType r => String -> r
printf "%02x" Word8
a
colorRangeFromClassName :: (Word8, Word8, Word8)
-> (Word8, Word8, Word8)
-> (Word8, Word8, Word8)
-> (Word8, Word8, Word8)
-> (Word8, Word8, Word8)
-> Window -> Bool -> X (String, String)
colorRangeFromClassName :: (Word8, Word8, Word8)
-> (Word8, Word8, Word8)
-> (Word8, Word8, Word8)
-> (Word8, Word8, Word8)
-> (Word8, Word8, Word8)
-> Window
-> Bool
-> X (String, String)
colorRangeFromClassName startC :: (Word8, Word8, Word8)
startC endC :: (Word8, Word8, Word8)
endC activeC :: (Word8, Word8, Word8)
activeC inactiveT :: (Word8, Word8, Word8)
inactiveT activeT :: (Word8, Word8, Word8)
activeT w :: Window
w active :: Bool
active =
do String
classname <- Query String -> Window -> X String
forall a. Query a -> Window -> X a
runQuery Query String
className Window
w
if Bool
active
then (String, String) -> X (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Word8, Word8, Word8) -> String
rgbToHex (Word8, Word8, Word8)
activeC, (Word8, Word8, Word8) -> String
rgbToHex (Word8, Word8, Word8)
activeT)
else (String, String) -> X (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Word8, Word8, Word8) -> String
rgbToHex ((Word8, Word8, Word8) -> String)
-> (Word8, Word8, Word8) -> String
forall a b. (a -> b) -> a -> b
$ (Word8, Word8, Word8)
-> (Word8, Word8, Word8) -> Double -> (Word8, Word8, Word8)
mix (Word8, Word8, Word8)
startC (Word8, Word8, Word8)
endC
(Double -> (Word8, Word8, Word8))
-> Double -> (Word8, Word8, Word8)
forall a b. (a -> b) -> a -> b
$ String -> Double
stringToRatio String
classname, (Word8, Word8, Word8) -> String
rgbToHex (Word8, Word8, Word8)
inactiveT)
where rgbToHex :: (Word8, Word8, Word8) -> String
rgbToHex :: (Word8, Word8, Word8) -> String
rgbToHex (r :: Word8
r, g :: Word8
g, b :: Word8
b) = '#'Char -> String -> String
forall a. a -> [a] -> [a]
:Word8 -> String
twodigitHex Word8
r
String -> String -> String
forall a. [a] -> [a] -> [a]
++Word8 -> String
twodigitHex Word8
gString -> String -> String
forall a. [a] -> [a] -> [a]
++Word8 -> String
twodigitHex Word8
b
mix :: (Word8, Word8, Word8) -> (Word8, Word8, Word8)
-> Double -> (Word8, Word8, Word8)
mix :: (Word8, Word8, Word8)
-> (Word8, Word8, Word8) -> Double -> (Word8, Word8, Word8)
mix (r1 :: Word8
r1, g1 :: Word8
g1, b1 :: Word8
b1) (r2 :: Word8
r2, g2 :: Word8
g2, b2 :: Word8
b2) r :: Double
r = (Word8 -> Word8 -> Word8
forall b a a. (Integral b, Integral a, Integral a) => a -> a -> b
mix' Word8
r1 Word8
r2, Word8 -> Word8 -> Word8
forall b a a. (Integral b, Integral a, Integral a) => a -> a -> b
mix' Word8
g1 Word8
g2, Word8 -> Word8 -> Word8
forall b a a. (Integral b, Integral a, Integral a) => a -> a -> b
mix' Word8
b1 Word8
b2)
where mix' :: a -> a -> b
mix' a :: a
a b :: a
b = Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> b) -> Double -> b
forall a b. (a -> b) -> a -> b
$ (a -> Double
forall a b. (Integral a, Num b) => a -> b
fi a
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (a -> Double
forall a b. (Integral a, Num b) => a -> b
fi a
b Double -> Double -> Double
forall a. Num a => a -> a -> a
* (1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
r))
stringToRatio :: String -> Double
stringToRatio :: String -> Double
stringToRatio "" = 0
stringToRatio s :: String
s = let gen :: StdGen
gen = Int -> StdGen
mkStdGen (Int -> StdGen) -> Int -> StdGen
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
forall a. Enum a => a -> Int
fromEnum String
s
range :: Int
range = (\(a :: Int
a, b :: Int
b) -> Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
a) ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ StdGen -> (Int, Int)
forall g. RandomGen g => g -> (Int, Int)
genRange StdGen
gen
randomInt :: StdGen -> (Int, StdGen)
randomInt = ((StdGen -> (Int, StdGen))
-> (StdGen -> (Int, StdGen)) -> StdGen -> (Int, StdGen))
-> [StdGen -> (Int, StdGen)] -> StdGen -> (Int, StdGen)
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (StdGen -> (Int, StdGen))
-> (StdGen -> (Int, StdGen)) -> StdGen -> (Int, StdGen)
forall p a t t. (p -> (a, t)) -> (t -> t) -> p -> t
combine ([StdGen -> (Int, StdGen)] -> StdGen -> (Int, StdGen))
-> [StdGen -> (Int, StdGen)] -> StdGen -> (Int, StdGen)
forall a b. (a -> b) -> a -> b
$ Int -> (StdGen -> (Int, StdGen)) -> [StdGen -> (Int, StdGen)]
forall a. Int -> a -> [a]
replicate 20 StdGen -> (Int, StdGen)
forall g. RandomGen g => g -> (Int, g)
next
combine :: (p -> (a, t)) -> (t -> t) -> p -> t
combine f1 :: p -> (a, t)
f1 f2 :: t -> t
f2 g :: p
g = let (_, g' :: t
g') = p -> (a, t)
f1 p
g in t -> t
f2 t
g'
in Int -> Double
forall a b. (Integral a, Num b) => a -> b
fi ((Int, StdGen) -> Int
forall a b. (a, b) -> a
fst ((Int, StdGen) -> Int) -> (Int, StdGen) -> Int
forall a b. (a -> b) -> a -> b
$ StdGen -> (Int, StdGen)
randomInt StdGen
gen) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fi Int
range
gridselect :: GSConfig a -> [(String,a)] -> X (Maybe a)
gridselect :: GSConfig a -> [(String, a)] -> X (Maybe a)
gridselect _ [] = Maybe a -> X (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
gridselect gsconfig :: GSConfig a
gsconfig elements :: [(String, a)]
elements =
(Display -> X (Maybe a)) -> X (Maybe a)
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X (Maybe a)) -> X (Maybe a))
-> (Display -> X (Maybe a)) -> X (Maybe a)
forall a b. (a -> b) -> a -> b
$ \dpy :: Display
dpy -> do
Window
rootw <- (XConf -> Window) -> X Window
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
theRoot
Rectangle
scr <- (XState -> Rectangle) -> X Rectangle
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState -> Rectangle) -> X Rectangle)
-> (XState -> Rectangle) -> X Rectangle
forall a b. (a -> b) -> a -> b
$ ScreenDetail -> Rectangle
screenRect (ScreenDetail -> Rectangle)
-> (XState -> ScreenDetail) -> XState -> Rectangle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout Window) Window ScreenId ScreenDetail
-> ScreenDetail
forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail (Screen String (Layout Window) Window ScreenId ScreenDetail
-> ScreenDetail)
-> (XState
-> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> (XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset
Window
win <- IO Window -> X Window
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Window -> X Window) -> IO Window -> X Window
forall a b. (a -> b) -> a -> b
$ Display
-> Screen
-> Window
-> Position
-> Position
-> Dimension
-> Dimension
-> IO Window
mkUnmanagedWindow Display
dpy (Display -> Screen
defaultScreenOfDisplay Display
dpy) Window
rootw
(Rectangle -> Position
rect_x Rectangle
scr) (Rectangle -> Position
rect_y Rectangle
scr) (Rectangle -> Dimension
rect_width Rectangle
scr) (Rectangle -> Dimension
rect_height Rectangle
scr)
IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO ()
mapWindow Display
dpy Window
win
IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> IO ()
selectInput Display
dpy Window
win (Window
exposureMask Window -> Window -> Window
forall a. Bits a => a -> a -> a
.|. Window
keyPressMask Window -> Window -> Window
forall a. Bits a => a -> a -> a
.|. Window
buttonReleaseMask)
CInt
status <- IO CInt -> X CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO CInt -> X CInt) -> IO CInt -> X CInt
forall a b. (a -> b) -> a -> b
$ Display -> Window -> Bool -> CInt -> CInt -> Window -> IO CInt
grabKeyboard Display
dpy Window
win Bool
True CInt
grabModeAsync CInt
grabModeAsync Window
currentTime
IO CInt -> X CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO CInt -> X CInt) -> IO CInt -> X CInt
forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> Bool
-> Window
-> CInt
-> CInt
-> Window
-> Window
-> Window
-> IO CInt
grabPointer Display
dpy Window
win Bool
True Window
buttonReleaseMask CInt
grabModeAsync CInt
grabModeAsync Window
none Window
none Window
currentTime
XMonadFont
font <- String -> X XMonadFont
initXMF (GSConfig a -> String
forall a. GSConfig a -> String
gs_font GSConfig a
gsconfig)
let screenWidth :: Integer
screenWidth = Dimension -> Integer
forall a. Integral a => a -> Integer
toInteger (Dimension -> Integer) -> Dimension -> Integer
forall a b. (a -> b) -> a -> b
$ Rectangle -> Dimension
rect_width Rectangle
scr
screenHeight :: Integer
screenHeight = Dimension -> Integer
forall a. Integral a => a -> Integer
toInteger (Dimension -> Integer) -> Dimension -> Integer
forall a b. (a -> b) -> a -> b
$ Rectangle -> Dimension
rect_height Rectangle
scr
Maybe a
selectedElement <- if (CInt
status CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
grabSuccess) then do
let restriction :: Integer -> (GSConfig a -> Integer) -> Double
restriction ss :: Integer
ss cs :: GSConfig a -> Integer
cs = (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
ssDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Integer -> Double
forall a. Num a => Integer -> a
fromInteger (GSConfig a -> Integer
cs GSConfig a
gsconfig)Double -> Double -> Double
forall a. Num a => a -> a -> a
-1)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/2 :: Double
restrictX :: Integer
restrictX = Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Integer) -> Double -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> (GSConfig a -> Integer) -> Double
restriction Integer
screenWidth GSConfig a -> Integer
forall a. GSConfig a -> Integer
gs_cellwidth
restrictY :: Integer
restrictY = Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Integer) -> Double -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> (GSConfig a -> Integer) -> Double
restriction Integer
screenHeight GSConfig a -> Integer
forall a. GSConfig a -> Integer
gs_cellheight
originPosX :: Integer
originPosX = Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Integer) -> Double -> Integer
forall a b. (a -> b) -> a -> b
$ ((GSConfig a -> Double
forall a. GSConfig a -> Double
gs_originFractX GSConfig a
gsconfig) Double -> Double -> Double
forall a. Num a => a -> a -> a
- (1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/2)) Double -> Double -> Double
forall a. Num a => a -> a -> a
* 2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
restrictX
originPosY :: Integer
originPosY = Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Integer) -> Double -> Integer
forall a b. (a -> b) -> a -> b
$ ((GSConfig a -> Double
forall a. GSConfig a -> Double
gs_originFractY GSConfig a
gsconfig) Double -> Double -> Double
forall a. Num a => a -> a -> a
- (1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/2)) Double -> Double -> Double
forall a. Num a => a -> a -> a
* 2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
restrictY
coords :: [TwoDPosition]
coords = Integer -> Integer -> Integer -> Integer -> [TwoDPosition]
diamondRestrict Integer
restrictX Integer
restrictY Integer
originPosX Integer
originPosY
s :: TwoDState a
s = TwoDState :: forall a.
TwoDPosition
-> [TwoDPosition]
-> [(String, a)]
-> GSConfig a
-> XMonadFont
-> Integer
-> Integer
-> Window
-> String
-> TwoDElementMap a
-> TwoDState a
TwoDState { td_curpos :: TwoDPosition
td_curpos = ([TwoDPosition] -> TwoDPosition
forall a. [a] -> a
head [TwoDPosition]
coords),
td_availSlots :: [TwoDPosition]
td_availSlots = [TwoDPosition]
coords,
td_elements :: [(String, a)]
td_elements = [(String, a)]
elements,
td_gsconfig :: GSConfig a
td_gsconfig = GSConfig a
gsconfig,
td_font :: XMonadFont
td_font = XMonadFont
font,
td_paneX :: Integer
td_paneX = Integer
screenWidth,
td_paneY :: Integer
td_paneY = Integer
screenHeight,
td_drawingWin :: Window
td_drawingWin = Window
win,
td_searchString :: String
td_searchString = "",
td_elementmap :: TwoDElementMap a
td_elementmap = [] }
TwoDElementMap a
m <- TwoDState a -> X (TwoDElementMap a)
forall a. TwoDState a -> X (TwoDElementMap a)
generateElementmap TwoDState a
s
TwoD a (Maybe a) -> TwoDState a -> X (Maybe a)
forall a1 a. TwoD a1 a -> TwoDState a1 -> X a
evalTwoD (TwoD a ()
forall a. TwoD a ()
updateAllElements TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (GSConfig a -> TwoD a (Maybe a)
forall a. GSConfig a -> TwoD a (Maybe a)
gs_navigate GSConfig a
gsconfig))
(TwoDState a
s { td_elementmap :: TwoDElementMap a
td_elementmap = TwoDElementMap a
m })
else
Maybe a -> X (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ do
Display -> Window -> IO ()
unmapWindow Display
dpy Window
win
Display -> Window -> IO ()
destroyWindow Display
dpy Window
win
Display -> Window -> IO ()
ungrabPointer Display
dpy Window
currentTime
Display -> Bool -> IO ()
sync Display
dpy Bool
False
XMonadFont -> X ()
releaseXMF XMonadFont
font
Maybe a -> X (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
selectedElement
gridselectWindow :: GSConfig Window -> X (Maybe Window)
gridselectWindow :: GSConfig Window -> X (Maybe Window)
gridselectWindow gsconf :: GSConfig Window
gsconf = X [(String, Window)]
windowMap X [(String, Window)]
-> ([(String, Window)] -> X (Maybe Window)) -> X (Maybe Window)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GSConfig Window -> [(String, Window)] -> X (Maybe Window)
forall a. GSConfig a -> [(String, a)] -> X (Maybe a)
gridselect GSConfig Window
gsconf
withSelectedWindow :: (Window -> X ()) -> GSConfig Window -> X ()
withSelectedWindow :: (Window -> X ()) -> GSConfig Window -> X ()
withSelectedWindow callback :: Window -> X ()
callback conf :: GSConfig Window
conf = do
Maybe Window
mbWindow <- GSConfig Window -> X (Maybe Window)
gridselectWindow GSConfig Window
conf
case Maybe Window
mbWindow of
Just w :: Window
w -> Window -> X ()
callback Window
w
Nothing -> () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
windowMap :: X [(String,Window)]
windowMap :: X [(String, Window)]
windowMap = do
StackSet String (Layout Window) Window ScreenId ScreenDetail
ws <- (XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X (StackSet String (Layout Window) Window ScreenId ScreenDetail)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset
[(String, Window)]
wins <- (Window -> X (String, Window)) -> [Window] -> X [(String, Window)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Window -> X (String, Window)
keyValuePair (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> [Window]
forall a i l s sd. Eq a => StackSet i l a s sd -> [a]
W.allWindows StackSet String (Layout Window) Window ScreenId ScreenDetail
ws)
[(String, Window)] -> X [(String, Window)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(String, Window)]
wins
where keyValuePair :: Window -> X (String, Window)
keyValuePair w :: Window
w = (String -> Window -> (String, Window))
-> Window -> String -> (String, Window)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) Window
w (String -> (String, Window)) -> X String -> X (String, Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Window -> X String
decorateName' Window
w
decorateName' :: Window -> X String
decorateName' :: Window -> X String
decorateName' w :: Window
w = do
(NamedWindow -> String) -> X NamedWindow -> X String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NamedWindow -> String
forall a. Show a => a -> String
show (X NamedWindow -> X String) -> X NamedWindow -> X String
forall a b. (a -> b) -> a -> b
$ Window -> X NamedWindow
getName Window
w
buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a
buildDefaultGSConfig :: (a -> Bool -> X (String, String)) -> GSConfig a
buildDefaultGSConfig col :: a -> Bool -> X (String, String)
col = Integer
-> Integer
-> Integer
-> (a -> Bool -> X (String, String))
-> String
-> TwoD a (Maybe a)
-> Rearranger a
-> Double
-> Double
-> String
-> GSConfig a
forall a.
Integer
-> Integer
-> Integer
-> (a -> Bool -> X (String, String))
-> String
-> TwoD a (Maybe a)
-> Rearranger a
-> Double
-> Double
-> String
-> GSConfig a
GSConfig 50 130 10 a -> Bool -> X (String, String)
col "xft:Sans-8" TwoD a (Maybe a)
forall a. TwoD a (Maybe a)
defaultNavigation Rearranger a
forall a. Rearranger a
noRearranger (1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/2) (1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/2) "white"
bringSelected :: GSConfig Window -> X ()
bringSelected :: GSConfig Window -> X ()
bringSelected = (Window -> X ()) -> GSConfig Window -> X ()
withSelectedWindow ((Window -> X ()) -> GSConfig Window -> X ())
-> (Window -> X ()) -> GSConfig Window -> X ()
forall a b. (a -> b) -> a -> b
$ \w :: Window
w -> do
(StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows (Window
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
bringWindow Window
w)
Window -> X ()
XMonad.focus Window
w
(StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.shiftMaster
goToSelected :: GSConfig Window -> X ()
goToSelected :: GSConfig Window -> X ()
goToSelected = (Window -> X ()) -> GSConfig Window -> X ()
withSelectedWindow ((Window -> X ()) -> GSConfig Window -> X ())
-> (Window -> X ()) -> GSConfig Window -> X ()
forall a b. (a -> b) -> a -> b
$ (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows ((StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ())
-> (Window
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> Window
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
forall s a i l sd.
(Eq s, Eq a, Eq i) =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.focusWindow
spawnSelected :: GSConfig String -> [String] -> X ()
spawnSelected :: GSConfig String -> [String] -> X ()
spawnSelected conf :: GSConfig String
conf lst :: [String]
lst = GSConfig String -> [(String, String)] -> X (Maybe String)
forall a. GSConfig a -> [(String, a)] -> X (Maybe a)
gridselect GSConfig String
conf ([String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
lst [String]
lst) X (Maybe String) -> (Maybe String -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe String -> (String -> X ()) -> X ())
-> (String -> X ()) -> Maybe String -> X ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe String -> (String -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust String -> X ()
forall (m :: * -> *). MonadIO m => String -> m ()
spawn
runSelectedAction :: GSConfig (X ()) -> [(String, X ())] -> X ()
runSelectedAction :: GSConfig (X ()) -> [(String, X ())] -> X ()
runSelectedAction conf :: GSConfig (X ())
conf actions :: [(String, X ())]
actions = do
Maybe (X ())
selectedActionM <- GSConfig (X ()) -> [(String, X ())] -> X (Maybe (X ()))
forall a. GSConfig a -> [(String, a)] -> X (Maybe a)
gridselect GSConfig (X ())
conf [(String, X ())]
actions
case Maybe (X ())
selectedActionM of
Just selectedAction :: X ()
selectedAction -> X ()
selectedAction
Nothing -> () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
gridselectWorkspace :: GSConfig WorkspaceId ->
(WorkspaceId -> WindowSet -> WindowSet) -> X ()
gridselectWorkspace :: GSConfig String
-> (String
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ()
gridselectWorkspace conf :: GSConfig String
conf viewFunc :: String
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
viewFunc = GSConfig String -> (String -> X ()) -> X ()
gridselectWorkspace' GSConfig String
conf ((StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows ((StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ())
-> (String
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> String
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
viewFunc)
gridselectWorkspace' :: GSConfig WorkspaceId -> (WorkspaceId -> X ()) -> X ()
gridselectWorkspace' :: GSConfig String -> (String -> X ()) -> X ()
gridselectWorkspace' conf :: GSConfig String
conf func :: String -> X ()
func = (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> X ())
-> X ()
forall a.
(StackSet String (Layout Window) Window ScreenId ScreenDetail
-> X a)
-> X a
withWindowSet ((StackSet String (Layout Window) Window ScreenId ScreenDetail
-> X ())
-> X ())
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> X ())
-> X ()
forall a b. (a -> b) -> a -> b
$ \ws :: StackSet String (Layout Window) Window ScreenId ScreenDetail
ws -> do
let wss :: [String]
wss = (Workspace String (Layout Window) Window -> String)
-> [Workspace String (Layout Window) Window] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Workspace String (Layout Window) Window -> String
forall i l a. Workspace i l a -> i
W.tag ([Workspace String (Layout Window) Window] -> [String])
-> [Workspace String (Layout Window) Window] -> [String]
forall a b. (a -> b) -> a -> b
$ StackSet String (Layout Window) Window ScreenId ScreenDetail
-> [Workspace String (Layout Window) Window]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
W.hidden StackSet String (Layout Window) Window ScreenId ScreenDetail
ws [Workspace String (Layout Window) Window]
-> [Workspace String (Layout Window) Window]
-> [Workspace String (Layout Window) Window]
forall a. [a] -> [a] -> [a]
++ (Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window)
-> [Screen String (Layout Window) Window ScreenId ScreenDetail]
-> [Workspace String (Layout Window) Window]
forall a b. (a -> b) -> [a] -> [b]
map Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current StackSet String (Layout Window) Window ScreenId ScreenDetail
ws Screen String (Layout Window) Window ScreenId ScreenDetail
-> [Screen String (Layout Window) Window ScreenId ScreenDetail]
-> [Screen String (Layout Window) Window ScreenId ScreenDetail]
forall a. a -> [a] -> [a]
: StackSet String (Layout Window) Window ScreenId ScreenDetail
-> [Screen String (Layout Window) Window ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible StackSet String (Layout Window) Window ScreenId ScreenDetail
ws)
GSConfig String -> [(String, String)] -> X (Maybe String)
forall a. GSConfig a -> [(String, a)] -> X (Maybe a)
gridselect GSConfig String
conf ([String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
wss [String]
wss) X (Maybe String) -> (Maybe String -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe String -> (String -> X ()) -> X ())
-> (String -> X ()) -> Maybe String -> X ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe String -> (String -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust String -> X ()
func
type Rearranger a = String -> [(String, a)] -> X [(String, a)]
noRearranger :: Rearranger a
noRearranger :: Rearranger a
noRearranger _ = [(String, a)] -> X [(String, a)]
forall (m :: * -> *) a. Monad m => a -> m a
return
searchStringRearrangerGenerator :: (String -> a) -> Rearranger a
searchStringRearrangerGenerator :: (String -> a) -> Rearranger a
searchStringRearrangerGenerator f :: String -> a
f =
let r :: String -> [(String, a)] -> m [(String, a)]
r "" xs :: [(String, a)]
xs = [(String, a)] -> m [(String, a)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, a)] -> m [(String, a)])
-> [(String, a)] -> m [(String, a)]
forall a b. (a -> b) -> a -> b
$ [(String, a)]
xs
r s :: String
s xs :: [(String, a)]
xs | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((String, a) -> String) -> [(String, a)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, a) -> String
forall a b. (a, b) -> a
fst [(String, a)]
xs = [(String, a)] -> m [(String, a)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, a)] -> m [(String, a)])
-> [(String, a)] -> m [(String, a)]
forall a b. (a -> b) -> a -> b
$ [(String, a)]
xs
| Bool
otherwise = [(String, a)] -> m [(String, a)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, a)] -> m [(String, a)])
-> [(String, a)] -> m [(String, a)]
forall a b. (a -> b) -> a -> b
$ [(String, a)]
xs [(String, a)] -> [(String, a)] -> [(String, a)]
forall a. [a] -> [a] -> [a]
++ [(String
s, String -> a
f String
s)]
in Rearranger a
forall (m :: * -> *).
Monad m =>
String -> [(String, a)] -> m [(String, a)]
r