{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
module XMonad.Layout.ImageButtonDecoration
(
imageButtonDeco
, defaultThemeWithImageButtons
, shrinkText
, CustomShrink(CustomShrink)
, Shrinker
, imageTitleBarButtonHandler
, ImageButtonDecoration
) where
import XMonad
import XMonad.Layout.Decoration
import XMonad.Layout.DecorationAddons
import XMonad.Util.Image
import XMonad.Actions.WindowMenu
import XMonad.Actions.Minimize
import XMonad.Layout.Maximize
buttonSize :: Int
buttonSize :: Int
buttonSize = Int
10
menuButtonOffset :: Int
= Int
4
minimizeButtonOffset :: Int
minimizeButtonOffset :: Int
minimizeButtonOffset = Int
32
maximizeButtonOffset :: Int
maximizeButtonOffset :: Int
maximizeButtonOffset = Int
18
closeButtonOffset :: Int
closeButtonOffset :: Int
closeButtonOffset = Int
4
convertToBool' :: [Int] -> [Bool]
convertToBool' :: [Int] -> [Bool]
convertToBool' = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Eq a => a -> a -> Bool
== Int
1)
convertToBool :: [[Int]] -> [[Bool]]
convertToBool :: [[Int]] -> [[Bool]]
convertToBool = forall a b. (a -> b) -> [a] -> [b]
map [Int] -> [Bool]
convertToBool'
menuButton' :: [[Int]]
= [[Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1],
[Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1],
[Int
1,Int
1,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
1,Int
1],
[Int
1,Int
1,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
1,Int
1],
[Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1],
[Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1],
[Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1],
[Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1],
[Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1],
[Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1]]
menuButton :: [[Bool]]
= [[Int]] -> [[Bool]]
convertToBool [[Int]]
menuButton'
miniButton' :: [[Int]]
miniButton' :: [[Int]]
miniButton' = [[Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0],
[Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0],
[Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0],
[Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0],
[Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0],
[Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0],
[Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0],
[Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0],
[Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1],
[Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1]]
miniButton :: [[Bool]]
miniButton :: [[Bool]]
miniButton = [[Int]] -> [[Bool]]
convertToBool [[Int]]
miniButton'
maxiButton' :: [[Int]]
maxiButton' :: [[Int]]
maxiButton' = [[Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1],
[Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1],
[Int
1,Int
1,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
1,Int
1],
[Int
1,Int
1,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
1,Int
1],
[Int
1,Int
1,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
1,Int
1],
[Int
1,Int
1,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
1,Int
1],
[Int
1,Int
1,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
1,Int
1],
[Int
1,Int
1,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
1,Int
1],
[Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1],
[Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1]]
maxiButton :: [[Bool]]
maxiButton :: [[Bool]]
maxiButton = [[Int]] -> [[Bool]]
convertToBool [[Int]]
maxiButton'
closeButton' :: [[Int]]
closeButton' :: [[Int]]
closeButton' = [[Int
1,Int
1,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
1,Int
1],
[Int
1,Int
1,Int
1,Int
0,Int
0,Int
0,Int
0,Int
1,Int
1,Int
1],
[Int
0,Int
1,Int
1,Int
1,Int
0,Int
0,Int
1,Int
1,Int
1,Int
0],
[Int
0,Int
0,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
0,Int
0],
[Int
0,Int
0,Int
0,Int
1,Int
1,Int
1,Int
1,Int
0,Int
0,Int
0],
[Int
0,Int
0,Int
0,Int
1,Int
1,Int
1,Int
1,Int
0,Int
0,Int
0],
[Int
0,Int
0,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
0,Int
0],
[Int
0,Int
1,Int
1,Int
1,Int
0,Int
0,Int
1,Int
1,Int
1,Int
0],
[Int
1,Int
1,Int
1,Int
0,Int
0,Int
0,Int
0,Int
1,Int
1,Int
1],
[Int
1,Int
1,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
1,Int
1]]
closeButton :: [[Bool]]
closeButton :: [[Bool]]
closeButton = [[Int]] -> [[Bool]]
convertToBool [[Int]]
closeButton'
imageTitleBarButtonHandler :: Window -> Int -> Int -> X Bool
imageTitleBarButtonHandler :: Window -> Int -> Int -> X Bool
imageTitleBarButtonHandler Window
mainw Int
distFromLeft Int
distFromRight = do
let action :: X Bool
action
| forall a b. (Integral a, Num b) => a -> b
fi Int
distFromLeft forall a. Ord a => a -> a -> Bool
>= Int
menuButtonOffset Bool -> Bool -> Bool
&&
forall a b. (Integral a, Num b) => a -> b
fi Int
distFromLeft forall a. Ord a => a -> a -> Bool
<= Int
menuButtonOffset forall a. Num a => a -> a -> a
+ Int
buttonSize = Window -> X ()
focus Window
mainw forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> X ()
windowMenu forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
| forall a b. (Integral a, Num b) => a -> b
fi Int
distFromRight forall a. Ord a => a -> a -> Bool
>= Int
closeButtonOffset Bool -> Bool -> Bool
&&
forall a b. (Integral a, Num b) => a -> b
fi Int
distFromRight forall a. Ord a => a -> a -> Bool
<= Int
closeButtonOffset forall a. Num a => a -> a -> a
+ Int
buttonSize = Window -> X ()
focus Window
mainw forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> X ()
kill forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
| forall a b. (Integral a, Num b) => a -> b
fi Int
distFromRight forall a. Ord a => a -> a -> Bool
>= Int
maximizeButtonOffset Bool -> Bool -> Bool
&&
forall a b. (Integral a, Num b) => a -> b
fi Int
distFromRight forall a. Ord a => a -> a -> Bool
<= Int
maximizeButtonOffset forall a. Num a => a -> a -> a
+ Int
buttonSize = Window -> X ()
focus Window
mainw forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Message a => a -> X ()
sendMessage (Window -> MaximizeRestore
maximizeRestore Window
mainw) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
| forall a b. (Integral a, Num b) => a -> b
fi Int
distFromRight forall a. Ord a => a -> a -> Bool
>= Int
minimizeButtonOffset Bool -> Bool -> Bool
&&
forall a b. (Integral a, Num b) => a -> b
fi Int
distFromRight forall a. Ord a => a -> a -> Bool
<= Int
minimizeButtonOffset forall a. Num a => a -> a -> a
+ Int
buttonSize = Window -> X ()
focus Window
mainw forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Window -> X ()
minimizeWindow Window
mainw forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
X Bool
action
defaultThemeWithImageButtons :: Theme
defaultThemeWithImageButtons :: Theme
defaultThemeWithImageButtons = forall a. Default a => a
def {
windowTitleIcons :: [([[Bool]], Placement)]
windowTitleIcons = [ ([[Bool]]
menuButton, Int -> Placement
CenterLeft Int
3),
([[Bool]]
closeButton, Int -> Placement
CenterRight Int
3),
([[Bool]]
maxiButton, Int -> Placement
CenterRight Int
18),
([[Bool]]
miniButton, Int -> Placement
CenterRight Int
33) ]
}
imageButtonDeco :: (Eq a, Shrinker s) => s -> Theme
-> l a -> ModifiedLayout (Decoration ImageButtonDecoration s) l a
imageButtonDeco :: forall a s (l :: * -> *).
(Eq a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration ImageButtonDecoration s) l a
imageButtonDeco s
s Theme
c = forall (ds :: * -> *) a s (l :: * -> *).
(DecorationStyle ds a, Shrinker s) =>
s -> Theme -> ds a -> l a -> ModifiedLayout (Decoration ds s) l a
decoration s
s Theme
c forall a b. (a -> b) -> a -> b
$ forall a. Bool -> ImageButtonDecoration a
NFD Bool
True
newtype ImageButtonDecoration a = NFD Bool deriving (Int -> ImageButtonDecoration a -> ShowS
forall a. Int -> ImageButtonDecoration a -> ShowS
forall a. [ImageButtonDecoration a] -> ShowS
forall a. ImageButtonDecoration a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageButtonDecoration a] -> ShowS
$cshowList :: forall a. [ImageButtonDecoration a] -> ShowS
show :: ImageButtonDecoration a -> String
$cshow :: forall a. ImageButtonDecoration a -> String
showsPrec :: Int -> ImageButtonDecoration a -> ShowS
$cshowsPrec :: forall a. Int -> ImageButtonDecoration a -> ShowS
Show, ReadPrec [ImageButtonDecoration a]
ReadPrec (ImageButtonDecoration a)
ReadS [ImageButtonDecoration a]
forall a. ReadPrec [ImageButtonDecoration a]
forall a. ReadPrec (ImageButtonDecoration a)
forall a. Int -> ReadS (ImageButtonDecoration a)
forall a. ReadS [ImageButtonDecoration a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImageButtonDecoration a]
$creadListPrec :: forall a. ReadPrec [ImageButtonDecoration a]
readPrec :: ReadPrec (ImageButtonDecoration a)
$creadPrec :: forall a. ReadPrec (ImageButtonDecoration a)
readList :: ReadS [ImageButtonDecoration a]
$creadList :: forall a. ReadS [ImageButtonDecoration a]
readsPrec :: Int -> ReadS (ImageButtonDecoration a)
$creadsPrec :: forall a. Int -> ReadS (ImageButtonDecoration a)
Read)
instance Eq a => DecorationStyle ImageButtonDecoration a where
describeDeco :: ImageButtonDecoration a -> String
describeDeco ImageButtonDecoration a
_ = String
"ImageButtonDeco"
decorationCatchClicksHook :: ImageButtonDecoration a -> Window -> Int -> Int -> X Bool
decorationCatchClicksHook ImageButtonDecoration a
_ = Window -> Int -> Int -> X Bool
imageTitleBarButtonHandler
decorationAfterDraggingHook :: ImageButtonDecoration a -> (Window, Rectangle) -> Window -> X ()
decorationAfterDraggingHook ImageButtonDecoration a
_ (Window
mainw, Rectangle
_) Window
decoWin = Window -> X ()
focus Window
mainw forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Window -> Window -> X Bool
handleScreenCrossing Window
mainw Window
decoWin forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()