{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, ViewPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DefaultSignatures #-}
module XMonad.Layout.DecorationEx.Engine (
DecorationEngine (..),
DrawData (..),
DecorationLayoutState (..),
Shrinker (..), shrinkText,
mkDrawData,
paintDecorationSimple
) where
import Control.Monad
import Data.Kind
import Foreign.C.Types (CInt)
import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as W
import XMonad.Layout.Decoration (Shrinker (..), shrinkWhile, shrinkText)
import XMonad.Layout.DraggingVisualizer (DraggingVisualizerMsg (..))
import XMonad.Layout.DecorationAddons (handleScreenCrossing)
import XMonad.Util.Font
import XMonad.Util.NamedWindows (getName)
import XMonad.Layout.DecorationEx.Common
data DrawData engine widget = DrawData {
forall (engine :: * -> * -> *) widget.
DrawData engine widget -> DecorationEngineState engine
ddEngineState :: !(DecorationEngineState engine)
, forall (engine :: * -> * -> *) widget.
DrawData engine widget -> Style (Theme engine widget)
ddStyle :: !(Style (Theme engine widget))
, forall (engine :: * -> * -> *) widget.
DrawData engine widget -> Window
ddOrigWindow :: !Window
, forall (engine :: * -> * -> *) widget.
DrawData engine widget -> String
ddWindowTitle :: !String
, forall (engine :: * -> * -> *) widget.
DrawData engine widget -> Rectangle
ddDecoRect :: !Rectangle
, forall (engine :: * -> * -> *) widget.
DrawData engine widget -> WidgetLayout widget
ddWidgets :: !(WidgetLayout widget)
, forall (engine :: * -> * -> *) widget.
DrawData engine widget -> WidgetLayout WidgetPlace
ddWidgetPlaces :: !(WidgetLayout WidgetPlace)
}
data DecorationLayoutState engine = DecorationLayoutState {
forall (engine :: * -> * -> *).
DecorationLayoutState engine -> DecorationEngineState engine
dsStyleState :: !(DecorationEngineState engine)
, forall (engine :: * -> * -> *).
DecorationLayoutState engine -> [WindowDecoration]
dsDecorations :: ![WindowDecoration]
}
class (Read (engine widget a), Show (engine widget a),
Eq a,
DecorationWidget widget,
HasWidgets (Theme engine) widget,
ClickHandler (Theme engine) widget,
ThemeAttributes (Theme engine widget))
=> DecorationEngine engine widget a where
type Theme engine :: Type -> Type
type DecorationPaintingContext engine
type DecorationEngineState engine
describeEngine :: engine widget a -> String
initializeState :: engine widget a
-> geom a
-> Theme engine widget
-> X (DecorationEngineState engine)
releaseStateResources :: engine widget a
-> DecorationEngineState engine
-> X ()
calcWidgetPlace :: engine widget a
-> DrawData engine widget
-> widget
-> X WidgetPlace
placeWidgets :: Shrinker shrinker
=> engine widget a
-> Theme engine widget
-> shrinker
-> DecorationEngineState engine
-> Rectangle
-> Window
-> WidgetLayout widget
-> X (WidgetLayout WidgetPlace)
placeWidgets engine widget a
engine Theme engine widget
theme shrinker
_ DecorationEngineState engine
decoStyle Rectangle
decoRect Window
window WidgetLayout widget
wlayout = do
let leftWidgets :: [widget]
leftWidgets = forall a. WidgetLayout a -> [a]
wlLeft WidgetLayout widget
wlayout
rightWidgets :: [widget]
rightWidgets = forall a. WidgetLayout a -> [a]
wlRight WidgetLayout widget
wlayout
centerWidgets :: [widget]
centerWidgets = forall a. WidgetLayout a -> [a]
wlCenter WidgetLayout widget
wlayout
DrawData engine widget
dd <- forall (engine :: * -> * -> *) widget a.
(DecorationEngine engine widget a,
ThemeAttributes (Theme engine widget),
HasWidgets (Theme engine) widget) =>
engine widget a
-> Theme engine widget
-> DecorationEngineState engine
-> Window
-> Rectangle
-> X (DrawData engine widget)
mkDrawData engine widget a
engine Theme engine widget
theme DecorationEngineState engine
decoStyle Window
window Rectangle
decoRect
let paddedDecoRect :: Rectangle
paddedDecoRect = BoxBorders Dimension -> Rectangle -> Rectangle
pad (forall theme.
ThemeAttributes theme =>
theme -> BoxBorders Dimension
widgetsPadding Theme engine widget
theme) (forall (engine :: * -> * -> *) widget.
DrawData engine widget -> Rectangle
ddDecoRect DrawData engine widget
dd)
paddedDd :: DrawData engine widget
paddedDd = DrawData engine widget
dd {ddDecoRect :: Rectangle
ddDecoRect = Rectangle
paddedDecoRect}
[WidgetPlace]
rightRects <- forall (engine :: * -> * -> *) widget a.
DecorationEngine engine widget a =>
engine widget a
-> DrawData engine widget -> [widget] -> X [WidgetPlace]
alignRight engine widget a
engine DrawData engine widget
paddedDd [widget]
rightWidgets
[WidgetPlace]
leftRects <- forall (engine :: * -> * -> *) widget a.
DecorationEngine engine widget a =>
engine widget a
-> DrawData engine widget -> [widget] -> X [WidgetPlace]
alignLeft engine widget a
engine DrawData engine widget
paddedDd [widget]
leftWidgets
let wantedLeftWidgetsWidth :: Dimension
wantedLeftWidgetsWidth = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Rectangle -> Dimension
rect_width forall b c a. (b -> c) -> (a -> b) -> a -> c
. WidgetPlace -> Rectangle
wpRectangle) [WidgetPlace]
leftRects
wantedRightWidgetsWidth :: Dimension
wantedRightWidgetsWidth = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Rectangle -> Dimension
rect_width forall b c a. (b -> c) -> (a -> b) -> a -> c
. WidgetPlace -> Rectangle
wpRectangle) [WidgetPlace]
rightRects
hasShrinkableOnLeft :: Bool
hasShrinkableOnLeft = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall widget. DecorationWidget widget => widget -> Bool
isShrinkable [widget]
leftWidgets
hasShrinkableOnRight :: Bool
hasShrinkableOnRight = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall widget. DecorationWidget widget => widget -> Bool
isShrinkable [widget]
rightWidgets
decoWidth :: Dimension
decoWidth = Rectangle -> Dimension
rect_width Rectangle
decoRect
(Dimension
leftWidgetsWidth, Dimension
rightWidgetsWidth)
| Bool
hasShrinkableOnLeft =
(forall a. Ord a => a -> a -> a
min (Dimension
decoWidth forall a. Num a => a -> a -> a
- Dimension
wantedRightWidgetsWidth) Dimension
wantedLeftWidgetsWidth,
Dimension
wantedRightWidgetsWidth)
| Bool
hasShrinkableOnRight =
(Dimension
wantedLeftWidgetsWidth,
forall a. Ord a => a -> a -> a
min (Dimension
decoWidth forall a. Num a => a -> a -> a
- Dimension
wantedLeftWidgetsWidth) Dimension
wantedRightWidgetsWidth)
| Bool
otherwise = (Dimension
wantedLeftWidgetsWidth, Dimension
wantedRightWidgetsWidth)
ddForCenter :: DrawData engine widget
ddForCenter = DrawData engine widget
paddedDd {ddDecoRect :: Rectangle
ddDecoRect = Dimension -> Dimension -> Rectangle -> Rectangle
padCenter Dimension
leftWidgetsWidth Dimension
rightWidgetsWidth Rectangle
paddedDecoRect}
[WidgetPlace]
centerRects <- forall (engine :: * -> * -> *) widget a.
DecorationEngine engine widget a =>
engine widget a
-> DrawData engine widget -> [widget] -> X [WidgetPlace]
alignCenter engine widget a
engine DrawData engine widget
ddForCenter [widget]
centerWidgets
let shrinkedLeftRects :: [WidgetPlace]
shrinkedLeftRects = Position -> [WidgetPlace] -> [WidgetPlace]
packLeft (Rectangle -> Position
rect_x Rectangle
paddedDecoRect) forall a b. (a -> b) -> a -> b
$ Dimension -> [(WidgetPlace, Bool)] -> [WidgetPlace]
shrinkPlaces Dimension
leftWidgetsWidth forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [WidgetPlace]
leftRects (forall a b. (a -> b) -> [a] -> [b]
map forall widget. DecorationWidget widget => widget -> Bool
isShrinkable [widget]
leftWidgets)
shrinkedRightRects :: [WidgetPlace]
shrinkedRightRects = Dimension -> [WidgetPlace] -> [WidgetPlace]
packRight (Rectangle -> Dimension
rect_width Rectangle
paddedDecoRect) forall a b. (a -> b) -> a -> b
$ Dimension -> [(WidgetPlace, Bool)] -> [WidgetPlace]
shrinkPlaces Dimension
rightWidgetsWidth forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [WidgetPlace]
rightRects (forall a b. (a -> b) -> [a] -> [b]
map forall widget. DecorationWidget widget => widget -> Bool
isShrinkable [widget]
rightWidgets)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a] -> [a] -> WidgetLayout a
WidgetLayout [WidgetPlace]
shrinkedLeftRects [WidgetPlace]
centerRects [WidgetPlace]
shrinkedRightRects
where
shrinkPlaces :: Dimension -> [(WidgetPlace, Bool)] -> [WidgetPlace]
shrinkPlaces Dimension
targetWidth [(WidgetPlace, Bool)]
ps =
let nShrinkable :: Int
nShrinkable = forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> [a]
filter forall a b. (a, b) -> b
snd [(WidgetPlace, Bool)]
ps)
totalUnshrinkedWidth :: Dimension
totalUnshrinkedWidth = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Rectangle -> Dimension
rect_width forall b c a. (b -> c) -> (a -> b) -> a -> c
. WidgetPlace -> Rectangle
wpRectangle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(WidgetPlace, Bool)]
ps
shrinkedWidth :: Dimension
shrinkedWidth = (Dimension
targetWidth forall a. Num a => a -> a -> a
- Dimension
totalUnshrinkedWidth) forall a. Integral a => a -> a -> a
`div` forall a b. (Integral a, Num b) => a -> b
fi Int
nShrinkable
resetX :: WidgetPlace -> WidgetPlace
resetX WidgetPlace
place = WidgetPlace
place {wpRectangle :: Rectangle
wpRectangle = (WidgetPlace -> Rectangle
wpRectangle WidgetPlace
place) {rect_x :: Position
rect_x = Position
0}}
adjust :: (WidgetPlace, Bool) -> WidgetPlace
adjust (WidgetPlace
place, Bool
True) = WidgetPlace -> WidgetPlace
resetX forall a b. (a -> b) -> a -> b
$ WidgetPlace
place {wpRectangle :: Rectangle
wpRectangle = (WidgetPlace -> Rectangle
wpRectangle WidgetPlace
place) {rect_width :: Dimension
rect_width = Dimension
shrinkedWidth}}
adjust (WidgetPlace
place, Bool
False) = WidgetPlace -> WidgetPlace
resetX WidgetPlace
place
in forall a b. (a -> b) -> [a] -> [b]
map (WidgetPlace, Bool) -> WidgetPlace
adjust [(WidgetPlace, Bool)]
ps
pad :: BoxBorders Dimension -> Rectangle -> Rectangle
pad BoxBorders Dimension
p (Rectangle Position
_ Position
_ Dimension
w Dimension
h) =
Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (forall a b. (Integral a, Num b) => a -> b
fi (forall a. BoxBorders a -> a
bxLeft BoxBorders Dimension
p)) (forall a b. (Integral a, Num b) => a -> b
fi (forall a. BoxBorders a -> a
bxTop BoxBorders Dimension
p))
(Dimension
w forall a. Num a => a -> a -> a
- forall a. BoxBorders a -> a
bxLeft BoxBorders Dimension
p forall a. Num a => a -> a -> a
- forall a. BoxBorders a -> a
bxRight BoxBorders Dimension
p)
(Dimension
h forall a. Num a => a -> a -> a
- forall a. BoxBorders a -> a
bxTop BoxBorders Dimension
p forall a. Num a => a -> a -> a
- forall a. BoxBorders a -> a
bxBottom BoxBorders Dimension
p)
padCenter :: Dimension -> Dimension -> Rectangle -> Rectangle
padCenter Dimension
left Dimension
right (Rectangle Position
x Position
y Dimension
w Dimension
h) =
Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
left) Position
y
(Dimension
w forall a. Num a => a -> a -> a
- Dimension
left forall a. Num a => a -> a -> a
- Dimension
right) Dimension
h
getShrinkedWindowName :: Shrinker shrinker
=> engine widget a
-> shrinker
-> DecorationEngineState engine
-> String
-> Dimension
-> Dimension
-> X String
default getShrinkedWindowName :: (Shrinker shrinker, DecorationEngineState engine ~ XMonadFont)
=> engine widget a -> shrinker -> DecorationEngineState engine -> String -> Dimension -> Dimension -> X String
getShrinkedWindowName engine widget a
_ shrinker
shrinker DecorationEngineState engine
font String
name Dimension
wh Dimension
_ = do
let s :: String -> [String]
s = forall s. Shrinker s => s -> String -> [String]
shrinkIt shrinker
shrinker
Display
dpy <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
(String -> [String]) -> (String -> X Bool) -> String -> X String
shrinkWhile String -> [String]
s (\String
n -> do Int
size <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
Display -> XMonadFont -> String -> m Int
textWidthXMF Display
dpy DecorationEngineState engine
font String
n
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int
size forall a. Ord a => a -> a -> Bool
> forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
wh) String
name
decorationXEventMask :: engine widget a -> EventMask
decorationXEventMask engine widget a
_ = Window
exposureMask forall a. Bits a => a -> a -> a
.|. Window
buttonPressMask
propsToRepaintDecoration :: engine widget a -> X [Atom]
propsToRepaintDecoration engine widget a
_ =
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> X Window
getAtom [String
"WM_NAME", String
"_NET_WM_NAME", String
"WM_STATE", String
"WM_HINTS"]
decorationEventHookEx :: Shrinker shrinker
=> engine widget a
-> Theme engine widget
-> DecorationLayoutState engine
-> shrinker
-> Event
-> X ()
decorationEventHookEx = forall (engine :: * -> * -> *) widget a shrinker.
(DecorationEngine engine widget a, Shrinker shrinker) =>
engine widget a
-> Theme engine widget
-> DecorationLayoutState engine
-> shrinker
-> Event
-> X ()
handleMouseFocusDrag
handleDecorationClick :: engine widget a
-> Theme engine widget
-> Rectangle
-> [Rectangle]
-> Window
-> Int
-> Int
-> Int
-> X Bool
handleDecorationClick = forall (engine :: * -> * -> *) widget a.
(DecorationEngine engine widget a,
ClickHandler (Theme engine) widget) =>
engine widget a
-> Theme engine widget
-> Rectangle
-> [Rectangle]
-> Window
-> Int
-> Int
-> Int
-> X Bool
decorationHandler
decorationWhileDraggingHook :: engine widget a
-> CInt
-> CInt
-> (Window, Rectangle)
-> Position
-> Position
-> X ()
decorationWhileDraggingHook engine widget a
_ = CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()
handleDraggingInProgress
decorationAfterDraggingHook :: engine widget a
-> (Window, Rectangle)
-> Window
-> X ()
decorationAfterDraggingHook engine widget a
_ds (Window
w, Rectangle
_r) Window
decoWin = do
Window -> X ()
focus Window
w
Bool
hasCrossed <- Window -> Window -> X Bool
handleScreenCrossing Window
w Window
decoWin
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hasCrossed forall a b. (a -> b) -> a -> b
$ do
forall a. Message a => a -> X ()
sendMessage DraggingVisualizerMsg
DraggingStopped
Window -> X ()
performWindowSwitching Window
w
paintDecoration :: Shrinker shrinker
=> engine widget a
-> a
-> Dimension
-> Dimension
-> shrinker
-> DrawData engine widget
-> Bool
-> X ()
paintWidget :: Shrinker shrinker
=> engine widget a
-> DecorationPaintingContext engine
-> WidgetPlace
-> shrinker
-> DrawData engine widget
-> widget
-> Bool
-> X ()
handleDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()
handleDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()
handleDraggingInProgress CInt
ex CInt
ey (Window
mainw, Rectangle
r) Position
x Position
y = do
let rect :: Rectangle
rect = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
x forall a. Num a => a -> a -> a
- (forall a b. (Integral a, Num b) => a -> b
fi CInt
ex forall a. Num a => a -> a -> a
- Rectangle -> Position
rect_x Rectangle
r))
(Position
y forall a. Num a => a -> a -> a
- (forall a b. (Integral a, Num b) => a -> b
fi CInt
ey forall a. Num a => a -> a -> a
- Rectangle -> Position
rect_y Rectangle
r))
(Rectangle -> Dimension
rect_width Rectangle
r)
(Rectangle -> Dimension
rect_height Rectangle
r)
forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ Window -> Rectangle -> DraggingVisualizerMsg
DraggingWindow Window
mainw Rectangle
rect
performWindowSwitching :: Window -> X ()
performWindowSwitching :: Window -> X ()
performWindowSwitching Window
win =
forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d -> do
Window
root <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
theRoot
(Bool
_, Window
_, Window
selWin, CInt
_, CInt
_, CInt
_, CInt
_, Modifier
_) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
queryPointer Display
d Window
root
WindowSet
ws <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
let allWindows :: [Window]
allWindows = forall i l a s sd. StackSet i l a s sd -> [a]
W.index WindowSet
ws
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Window
win forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
allWindows) Bool -> Bool -> Bool
&& (Window
selWin forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
allWindows)) forall a b. (a -> b) -> a -> b
$ do
let allWindowsSwitched :: [Window]
allWindowsSwitched = forall a b. (a -> b) -> [a] -> [b]
map (forall {a}. Eq a => a -> a -> a -> a
switchEntries Window
win Window
selWin) [Window]
allWindows
let ([Window]
ls, forall a. HasCallStack => [a] -> NonEmpty a
notEmpty -> Window
t :| [Window]
rs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Window
win forall a. Eq a => a -> a -> Bool
==) [Window]
allWindowsSwitched
let newStack :: Stack Window
newStack = forall a. a -> [a] -> [a] -> Stack a
W.Stack Window
t (forall a. [a] -> [a]
reverse [Window]
ls) [Window]
rs
(WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
W.modify' forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const Stack Window
newStack
where
switchEntries :: a -> a -> a -> a
switchEntries a
a a
b a
x
| a
x forall a. Eq a => a -> a -> Bool
== a
a = a
b
| a
x forall a. Eq a => a -> a -> Bool
== a
b = a
a
| Bool
otherwise = a
x
ignoreX :: WidgetPlace -> WidgetPlace
ignoreX :: WidgetPlace -> WidgetPlace
ignoreX WidgetPlace
place = WidgetPlace
place {wpRectangle :: Rectangle
wpRectangle = (WidgetPlace -> Rectangle
wpRectangle WidgetPlace
place) {rect_x :: Position
rect_x = Position
0}}
alignLeft :: forall engine widget a. DecorationEngine engine widget a => engine widget a -> DrawData engine widget -> [widget] -> X [WidgetPlace]
alignLeft :: forall (engine :: * -> * -> *) widget a.
DecorationEngine engine widget a =>
engine widget a
-> DrawData engine widget -> [widget] -> X [WidgetPlace]
alignLeft engine widget a
engine DrawData engine widget
dd [widget]
widgets = do
[WidgetPlace]
places <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (engine :: * -> * -> *) widget a.
DecorationEngine engine widget a =>
engine widget a
-> DrawData engine widget -> widget -> X WidgetPlace
calcWidgetPlace engine widget a
engine DrawData engine widget
dd) [widget]
widgets
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Position -> [WidgetPlace] -> [WidgetPlace]
packLeft (Rectangle -> Position
rect_x forall a b. (a -> b) -> a -> b
$ forall (engine :: * -> * -> *) widget.
DrawData engine widget -> Rectangle
ddDecoRect DrawData engine widget
dd) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map WidgetPlace -> WidgetPlace
ignoreX [WidgetPlace]
places
packLeft :: Position -> [WidgetPlace] -> [WidgetPlace]
packLeft :: Position -> [WidgetPlace] -> [WidgetPlace]
packLeft Position
_ [] = []
packLeft Position
x0 (WidgetPlace
place : [WidgetPlace]
places) =
let rect :: Rectangle
rect = WidgetPlace -> Rectangle
wpRectangle WidgetPlace
place
x' :: Position
x' = Position
x0 forall a. Num a => a -> a -> a
+ Rectangle -> Position
rect_x Rectangle
rect
rect' :: Rectangle
rect' = Rectangle
rect {rect_x :: Position
rect_x = Position
x'}
place' :: WidgetPlace
place' = WidgetPlace
place {wpRectangle :: Rectangle
wpRectangle = Rectangle
rect'}
in WidgetPlace
place' forall a. a -> [a] -> [a]
: Position -> [WidgetPlace] -> [WidgetPlace]
packLeft (Position
x' forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_width Rectangle
rect)) [WidgetPlace]
places
alignRight :: forall engine widget a. DecorationEngine engine widget a => engine widget a -> DrawData engine widget -> [widget] -> X [WidgetPlace]
alignRight :: forall (engine :: * -> * -> *) widget a.
DecorationEngine engine widget a =>
engine widget a
-> DrawData engine widget -> [widget] -> X [WidgetPlace]
alignRight engine widget a
engine DrawData engine widget
dd [widget]
widgets = do
[WidgetPlace]
places <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (engine :: * -> * -> *) widget a.
DecorationEngine engine widget a =>
engine widget a
-> DrawData engine widget -> widget -> X WidgetPlace
calcWidgetPlace engine widget a
engine DrawData engine widget
dd) [widget]
widgets
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Dimension -> [WidgetPlace] -> [WidgetPlace]
packRight (Rectangle -> Dimension
rect_width forall a b. (a -> b) -> a -> b
$ forall (engine :: * -> * -> *) widget.
DrawData engine widget -> Rectangle
ddDecoRect DrawData engine widget
dd) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map WidgetPlace -> WidgetPlace
ignoreX [WidgetPlace]
places
packRight :: Dimension -> [WidgetPlace] -> [WidgetPlace]
packRight :: Dimension -> [WidgetPlace] -> [WidgetPlace]
packRight Dimension
x0 [WidgetPlace]
places = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ Dimension -> [WidgetPlace] -> [WidgetPlace]
go Dimension
x0 [WidgetPlace]
places
where
go :: Dimension -> [WidgetPlace] -> [WidgetPlace]
go Dimension
_ [] = []
go Dimension
x (WidgetPlace
place : [WidgetPlace]
rest) =
let rect :: Rectangle
rect = WidgetPlace -> Rectangle
wpRectangle WidgetPlace
place
x' :: Dimension
x' = Dimension
x forall a. Num a => a -> a -> a
- Rectangle -> Dimension
rect_width Rectangle
rect
rect' :: Rectangle
rect' = Rectangle
rect {rect_x :: Position
rect_x = forall a b. (Integral a, Num b) => a -> b
fi Dimension
x'}
place' :: WidgetPlace
place' = WidgetPlace
place {wpRectangle :: Rectangle
wpRectangle = Rectangle
rect'}
in WidgetPlace
place' forall a. a -> [a] -> [a]
: Dimension -> [WidgetPlace] -> [WidgetPlace]
go Dimension
x' [WidgetPlace]
rest
alignCenter :: forall engine widget a. DecorationEngine engine widget a => engine widget a -> DrawData engine widget -> [widget] -> X [WidgetPlace]
alignCenter :: forall (engine :: * -> * -> *) widget a.
DecorationEngine engine widget a =>
engine widget a
-> DrawData engine widget -> [widget] -> X [WidgetPlace]
alignCenter engine widget a
engine DrawData engine widget
dd [widget]
widgets = do
[WidgetPlace]
places <- forall (engine :: * -> * -> *) widget a.
DecorationEngine engine widget a =>
engine widget a
-> DrawData engine widget -> [widget] -> X [WidgetPlace]
alignLeft engine widget a
engine DrawData engine widget
dd [widget]
widgets
let totalWidth :: Dimension
totalWidth = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Rectangle -> Dimension
rect_width forall b c a. (b -> c) -> (a -> b) -> a -> c
. WidgetPlace -> Rectangle
wpRectangle) [WidgetPlace]
places
availableWidth :: Position
availableWidth = forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_width (forall (engine :: * -> * -> *) widget.
DrawData engine widget -> Rectangle
ddDecoRect DrawData engine widget
dd)) :: Position
x0 :: Position
x0 = forall a. Ord a => a -> a -> a
max Position
0 forall a b. (a -> b) -> a -> b
$ (Position
availableWidth forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Dimension
totalWidth) forall a. Integral a => a -> a -> a
`div` Position
2
places' :: [WidgetPlace]
places' = forall a b. (a -> b) -> [a] -> [b]
map (forall {a}. Integral a => a -> WidgetPlace -> WidgetPlace
shift Position
x0) [WidgetPlace]
places
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Dimension -> [WidgetPlace] -> [WidgetPlace]
pack (forall a b. (Integral a, Num b) => a -> b
fi Position
availableWidth) [WidgetPlace]
places'
where
shift :: a -> WidgetPlace -> WidgetPlace
shift a
x0 WidgetPlace
place =
let rect :: Rectangle
rect = WidgetPlace -> Rectangle
wpRectangle WidgetPlace
place
rect' :: Rectangle
rect' = Rectangle
rect {rect_x :: Position
rect_x = Rectangle -> Position
rect_x Rectangle
rect forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi a
x0}
in WidgetPlace
place {wpRectangle :: Rectangle
wpRectangle = Rectangle
rect'}
pack :: Dimension -> [WidgetPlace] -> [WidgetPlace]
pack Dimension
_ [] = []
pack Dimension
available (WidgetPlace
place : [WidgetPlace]
places) =
let rect :: Rectangle
rect = WidgetPlace -> Rectangle
wpRectangle WidgetPlace
place
placeWidth :: Dimension
placeWidth = Rectangle -> Dimension
rect_width Rectangle
rect
widthToUse :: Dimension
widthToUse = forall a. Ord a => a -> a -> a
min Dimension
available Dimension
placeWidth
remaining :: Dimension
remaining = Dimension
available forall a. Num a => a -> a -> a
- Dimension
widthToUse
rect' :: Rectangle
rect' = Rectangle
rect {rect_width :: Dimension
rect_width = Dimension
widthToUse}
place' :: WidgetPlace
place' = WidgetPlace
place {wpRectangle :: Rectangle
wpRectangle = Rectangle
rect'}
in WidgetPlace
place' forall a. a -> [a] -> [a]
: Dimension -> [WidgetPlace] -> [WidgetPlace]
pack Dimension
remaining [WidgetPlace]
places
mkDrawData :: (DecorationEngine engine widget a, ThemeAttributes (Theme engine widget), HasWidgets (Theme engine) widget)
=> engine widget a
-> Theme engine widget
-> DecorationEngineState engine
-> Window
-> Rectangle
-> X (DrawData engine widget)
mkDrawData :: forall (engine :: * -> * -> *) widget a.
(DecorationEngine engine widget a,
ThemeAttributes (Theme engine widget),
HasWidgets (Theme engine) widget) =>
engine widget a
-> Theme engine widget
-> DecorationEngineState engine
-> Window
-> Rectangle
-> X (DrawData engine widget)
mkDrawData engine widget a
_ Theme engine widget
theme DecorationEngineState engine
decoState Window
origWindow Rectangle
decoRect = do
String
name <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Int -> [a] -> [a]
take Int
2048 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'\n') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) (Window -> X NamedWindow
getName Window
origWindow)
Style (Theme engine widget)
style <- forall theme.
ThemeAttributes theme =>
theme -> Window -> X (Style theme)
selectWindowStyle Theme engine widget
theme Window
origWindow
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DrawData {
ddEngineState :: DecorationEngineState engine
ddEngineState = DecorationEngineState engine
decoState,
ddStyle :: Style (Theme engine widget)
ddStyle = Style (Theme engine widget)
style,
ddOrigWindow :: Window
ddOrigWindow = Window
origWindow,
ddWindowTitle :: String
ddWindowTitle = String
name,
ddDecoRect :: Rectangle
ddDecoRect = Rectangle
decoRect,
ddWidgets :: WidgetLayout widget
ddWidgets = forall (theme :: * -> *) widget.
HasWidgets theme widget =>
theme widget -> WidgetLayout widget
themeWidgets Theme engine widget
theme,
ddWidgetPlaces :: WidgetLayout WidgetPlace
ddWidgetPlaces = forall a. [a] -> [a] -> [a] -> WidgetLayout a
WidgetLayout [] [] []
}
handleMouseFocusDrag :: (DecorationEngine engine widget a, Shrinker shrinker) => engine widget a -> Theme engine widget -> DecorationLayoutState engine -> shrinker -> Event -> X ()
handleMouseFocusDrag :: forall (engine :: * -> * -> *) widget a shrinker.
(DecorationEngine engine widget a, Shrinker shrinker) =>
engine widget a
-> Theme engine widget
-> DecorationLayoutState engine
-> shrinker
-> Event
-> X ()
handleMouseFocusDrag engine widget a
ds Theme engine widget
theme (DecorationLayoutState {[WindowDecoration]
dsDecorations :: [WindowDecoration]
dsDecorations :: forall (engine :: * -> * -> *).
DecorationLayoutState engine -> [WindowDecoration]
dsDecorations}) shrinker
_ (ButtonEvent {Window
ev_window :: Event -> Window
ev_window :: Window
ev_window, CInt
ev_x_root :: Event -> CInt
ev_x_root :: CInt
ev_x_root, CInt
ev_y_root :: Event -> CInt
ev_y_root :: CInt
ev_y_root, Dimension
ev_event_type :: Event -> Dimension
ev_event_type :: Dimension
ev_event_type, Dimension
ev_button :: Event -> Dimension
ev_button :: Dimension
ev_button})
| Dimension
ev_event_type forall a. Eq a => a -> a -> Bool
== Dimension
buttonPress
, Just (WindowDecoration {[WidgetPlace]
Maybe Window
Maybe Rectangle
Window
Rectangle
wdWidgets :: WindowDecoration -> [WidgetPlace]
wdDecoRect :: WindowDecoration -> Maybe Rectangle
wdDecoWindow :: WindowDecoration -> Maybe Window
wdOrigWinRect :: WindowDecoration -> Rectangle
wdOrigWindow :: WindowDecoration -> Window
wdWidgets :: [WidgetPlace]
wdDecoRect :: Maybe Rectangle
wdDecoWindow :: Maybe Window
wdOrigWinRect :: Rectangle
wdOrigWindow :: Window
..}) <- Window -> [WindowDecoration] -> Maybe WindowDecoration
findDecoDataByDecoWindow Window
ev_window [WindowDecoration]
dsDecorations = do
let decoRect :: Rectangle
decoRect@(Rectangle Position
dx Position
dy Dimension
_ Dimension
_) = forall a. HasCallStack => Maybe a -> a
fromJust Maybe Rectangle
wdDecoRect
x :: Int
x = forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ CInt
ev_x_root forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Position
dx
y :: Int
y = forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ CInt
ev_y_root forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Position
dy
button :: Int
button = forall a b. (Integral a, Num b) => a -> b
fi Dimension
ev_button
Bool
dealtWith <- forall (engine :: * -> * -> *) widget a.
DecorationEngine engine widget a =>
engine widget a
-> Theme engine widget
-> Rectangle
-> [Rectangle]
-> Window
-> Int
-> Int
-> Int
-> X Bool
handleDecorationClick engine widget a
ds Theme engine widget
theme Rectangle
decoRect (forall a b. (a -> b) -> [a] -> [b]
map WidgetPlace -> Rectangle
wpRectangle [WidgetPlace]
wdWidgets) Window
wdOrigWindow Int
x Int
y Int
button
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
dealtWith forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (theme :: * -> *) widget.
ClickHandler theme widget =>
theme widget -> Int -> Bool
isDraggingEnabled Theme engine widget
theme Int
button) forall a b. (a -> b) -> a -> b
$
(Position -> Position -> X ()) -> X () -> X ()
mouseDrag (\Position
dragX Position
dragY -> Window -> X ()
focus Window
wdOrigWindow forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (engine :: * -> * -> *) widget a.
DecorationEngine engine widget a =>
engine widget a
-> CInt
-> CInt
-> (Window, Rectangle)
-> Position
-> Position
-> X ()
decorationWhileDraggingHook engine widget a
ds CInt
ev_x_root CInt
ev_y_root (Window
wdOrigWindow, Rectangle
wdOrigWinRect) Position
dragX Position
dragY)
(forall (engine :: * -> * -> *) widget a.
DecorationEngine engine widget a =>
engine widget a -> (Window, Rectangle) -> Window -> X ()
decorationAfterDraggingHook engine widget a
ds (Window
wdOrigWindow, Rectangle
wdOrigWinRect) Window
ev_window)
handleMouseFocusDrag engine widget a
_ Theme engine widget
_ DecorationLayoutState engine
_ shrinker
_ Event
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
findDecoDataByDecoWindow :: Window -> [WindowDecoration] -> Maybe WindowDecoration
findDecoDataByDecoWindow :: Window -> [WindowDecoration] -> Maybe WindowDecoration
findDecoDataByDecoWindow Window
decoWin = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\WindowDecoration
dd -> WindowDecoration -> Maybe Window
wdDecoWindow WindowDecoration
dd forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Window
decoWin)
decorationHandler :: forall engine widget a.
(DecorationEngine engine widget a,
ClickHandler (Theme engine) widget)
=> engine widget a
-> Theme engine widget
-> Rectangle
-> [Rectangle]
-> Window
-> Int
-> Int
-> Int
-> X Bool
decorationHandler :: forall (engine :: * -> * -> *) widget a.
(DecorationEngine engine widget a,
ClickHandler (Theme engine) widget) =>
engine widget a
-> Theme engine widget
-> Rectangle
-> [Rectangle]
-> Window
-> Int
-> Int
-> Int
-> X Bool
decorationHandler engine widget a
_ Theme engine widget
theme Rectangle
_ [Rectangle]
widgetPlaces Window
window Int
x Int
y Int
button = do
Bool
widgetDone <- [(widget, Rectangle)] -> X Bool
go forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. WidgetLayout a -> [a]
widgetLayout forall a b. (a -> b) -> a -> b
$ forall (theme :: * -> *) widget.
HasWidgets theme widget =>
theme widget -> WidgetLayout widget
themeWidgets Theme engine widget
theme) [Rectangle]
widgetPlaces
if Bool
widgetDone
then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else case forall (theme :: * -> *) widget.
ClickHandler theme widget =>
theme widget -> Int -> Maybe (WidgetCommand widget)
onDecorationClick Theme engine widget
theme Int
button of
Just WidgetCommand widget
cmd -> do
forall cmd. WindowCommand cmd => cmd -> Window -> X Bool
executeWindowCommand WidgetCommand widget
cmd Window
window
Maybe (WidgetCommand widget)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
where
go :: [(widget, Rectangle)] -> X Bool
go :: [(widget, Rectangle)] -> X Bool
go [] = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
go ((widget
w, Rectangle
rect) : [(widget, Rectangle)]
rest) = do
if Position -> Position -> Rectangle -> Bool
pointWithin (forall a b. (Integral a, Num b) => a -> b
fi Int
x) (forall a b. (Integral a, Num b) => a -> b
fi Int
y) Rectangle
rect
then do
forall cmd. WindowCommand cmd => cmd -> Window -> X Bool
executeWindowCommand (forall widget.
DecorationWidget widget =>
widget -> Int -> WidgetCommand widget
widgetCommand widget
w Int
button) Window
window
else [(widget, Rectangle)] -> X Bool
go [(widget, Rectangle)]
rest
paintDecorationSimple :: forall engine shrinker widget.
(DecorationEngine engine widget Window,
DecorationPaintingContext engine ~ XPaintingContext,
Shrinker shrinker,
Style (Theme engine widget) ~ SimpleStyle)
=> engine widget Window
-> Window
-> Dimension
-> Dimension
-> shrinker
-> DrawData engine widget
-> Bool
-> X ()
paintDecorationSimple :: forall (engine :: * -> * -> *) shrinker widget.
(DecorationEngine engine widget Window,
DecorationPaintingContext engine ~ XPaintingContext,
Shrinker shrinker, Style (Theme engine widget) ~ SimpleStyle) =>
engine widget Window
-> Window
-> Dimension
-> Dimension
-> shrinker
-> DrawData engine widget
-> Bool
-> X ()
paintDecorationSimple engine widget Window
deco Window
win Dimension
windowWidth Dimension
windowHeight shrinker
shrinker DrawData engine widget
dd Bool
isExpose = do
Display
dpy <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
let widgets :: [widget]
widgets = forall a. WidgetLayout a -> [a]
widgetLayout forall a b. (a -> b) -> a -> b
$ forall (engine :: * -> * -> *) widget.
DrawData engine widget -> WidgetLayout widget
ddWidgets DrawData engine widget
dd
style :: Style (Theme engine widget)
style = forall (engine :: * -> * -> *) widget.
DrawData engine widget -> Style (Theme engine widget)
ddStyle DrawData engine widget
dd
Window
pixmap <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Window -> Dimension -> Dimension -> CInt -> IO Window
createPixmap Display
dpy Window
win Dimension
windowWidth Dimension
windowHeight (Screen -> CInt
defaultDepthOfScreen forall a b. (a -> b) -> a -> b
$ Display -> Screen
defaultScreenOfDisplay Display
dpy)
GC
gc <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO GC
createGC Display
dpy Window
pixmap
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> GC -> Bool -> IO ()
setGraphicsExposures Display
dpy GC
gc Bool
False
Window
bgColor <- forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display -> String -> m Window
stringToPixel Display
dpy (SimpleStyle -> String
sBgColor Style (Theme engine widget)
style)
let borderWidth :: Dimension
borderWidth = SimpleStyle -> Dimension
sDecoBorderWidth Style (Theme engine widget)
style
borderColors :: BorderColors
borderColors = SimpleStyle -> BorderColors
sDecorationBorders Style (Theme engine widget)
style
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Dimension
borderWidth forall a. Ord a => a -> a -> Bool
> Dimension
0) forall a b. (a -> b) -> a -> b
$ do
forall {m :: * -> *}.
MonadIO m =>
Display
-> Window
-> GC
-> Position
-> Position
-> Dimension
-> Dimension
-> String
-> m ()
drawLineWith Display
dpy Window
pixmap GC
gc Position
0 Position
0 Dimension
windowWidth Dimension
borderWidth (forall a. BoxBorders a -> a
bxTop BorderColors
borderColors)
forall {m :: * -> *}.
MonadIO m =>
Display
-> Window
-> GC
-> Position
-> Position
-> Dimension
-> Dimension
-> String
-> m ()
drawLineWith Display
dpy Window
pixmap GC
gc Position
0 Position
0 Dimension
borderWidth Dimension
windowHeight (forall a. BoxBorders a -> a
bxLeft BorderColors
borderColors)
forall {m :: * -> *}.
MonadIO m =>
Display
-> Window
-> GC
-> Position
-> Position
-> Dimension
-> Dimension
-> String
-> m ()
drawLineWith Display
dpy Window
pixmap GC
gc Position
0 (forall a b. (Integral a, Num b) => a -> b
fi (Dimension
windowHeight forall a. Num a => a -> a -> a
- Dimension
borderWidth)) Dimension
windowWidth Dimension
borderWidth (forall a. BoxBorders a -> a
bxBottom BorderColors
borderColors)
forall {m :: * -> *}.
MonadIO m =>
Display
-> Window
-> GC
-> Position
-> Position
-> Dimension
-> Dimension
-> String
-> m ()
drawLineWith Display
dpy Window
pixmap GC
gc (forall a b. (Integral a, Num b) => a -> b
fi (Dimension
windowWidth forall a. Num a => a -> a -> a
- Dimension
borderWidth)) Position
0 Dimension
borderWidth Dimension
windowHeight (forall a. BoxBorders a -> a
bxRight BorderColors
borderColors)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> GC -> Window -> IO ()
setForeground Display
dpy GC
gc Window
bgColor
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> GC
-> Position
-> Position
-> Dimension
-> Dimension
-> IO ()
fillRectangle Display
dpy Window
pixmap GC
gc (forall a b. (Integral a, Num b) => a -> b
fi Dimension
borderWidth) (forall a b. (Integral a, Num b) => a -> b
fi Dimension
borderWidth) (Dimension
windowWidth forall a. Num a => a -> a -> a
- (Dimension
borderWidth forall a. Num a => a -> a -> a
* Dimension
2)) (Dimension
windowHeight forall a. Num a => a -> a -> a
- (Dimension
borderWidth forall a. Num a => a -> a -> a
* Dimension
2))
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [widget]
widgets forall a b. (a -> b) -> a -> b
$ forall a. WidgetLayout a -> [a]
widgetLayout forall a b. (a -> b) -> a -> b
$ forall (engine :: * -> * -> *) widget.
DrawData engine widget -> WidgetLayout WidgetPlace
ddWidgetPlaces DrawData engine widget
dd) forall a b. (a -> b) -> a -> b
$ \(widget
widget, WidgetPlace
place) ->
forall (engine :: * -> * -> *) widget a shrinker.
(DecorationEngine engine widget a, Shrinker shrinker) =>
engine widget a
-> DecorationPaintingContext engine
-> WidgetPlace
-> shrinker
-> DrawData engine widget
-> widget
-> Bool
-> X ()
paintWidget engine widget Window
deco (Display
dpy, Window
pixmap, GC
gc) WidgetPlace
place shrinker
shrinker DrawData engine widget
dd widget
widget Bool
isExpose
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> Window
-> GC
-> Position
-> Position
-> Dimension
-> Dimension
-> Position
-> Position
-> IO ()
copyArea Display
dpy Window
pixmap Window
win GC
gc Position
0 Position
0 Dimension
windowWidth Dimension
windowHeight Position
0 Position
0
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO ()
freePixmap Display
dpy Window
pixmap
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> GC -> IO ()
freeGC Display
dpy GC
gc
where
drawLineWith :: Display
-> Window
-> GC
-> Position
-> Position
-> Dimension
-> Dimension
-> String
-> m ()
drawLineWith Display
dpy Window
pixmap GC
gc Position
x Position
y Dimension
w Dimension
h String
colorName = do
Window
color <- forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display -> String -> m Window
stringToPixel Display
dpy String
colorName
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> GC -> Window -> IO ()
setForeground Display
dpy GC
gc Window
color
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> GC
-> Position
-> Position
-> Dimension
-> Dimension
-> IO ()
fillRectangle Display
dpy Window
pixmap GC
gc Position
x Position
y Dimension
w Dimension
h