Copyright | (c) 2007 Andrea Rossato 2009 Jan Vornberger 2023 Ilya Portnov |
---|---|
License | BSD-style (see xmonad/LICENSE) |
Maintainer | portnov84@rambler.ru |
Stability | unstable |
Portability | unportable |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
This module defines DecorationEngine
type class, and default implementation for it.
Synopsis
- 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)
- getShrinkedWindowName :: Shrinker shrinker => engine widget a -> shrinker -> DecorationEngineState engine -> String -> Dimension -> Dimension -> X String
- decorationXEventMask :: engine widget a -> EventMask
- propsToRepaintDecoration :: engine widget a -> X [Atom]
- decorationEventHookEx :: Shrinker shrinker => engine widget a -> Theme engine widget -> DecorationLayoutState engine -> shrinker -> Event -> X ()
- handleDecorationClick :: engine widget a -> Theme engine widget -> Rectangle -> [Rectangle] -> Window -> Int -> Int -> Int -> X Bool
- decorationWhileDraggingHook :: engine widget a -> CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()
- decorationAfterDraggingHook :: engine widget a -> (Window, Rectangle) -> Window -> X ()
- 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 ()
- data DrawData engine widget = DrawData {
- ddEngineState :: !(DecorationEngineState engine)
- ddStyle :: !(Style (Theme engine widget))
- ddOrigWindow :: !Window
- ddWindowTitle :: !String
- ddDecoRect :: !Rectangle
- ddWidgets :: !(WidgetLayout widget)
- ddWidgetPlaces :: !(WidgetLayout WidgetPlace)
- data DecorationLayoutState engine = DecorationLayoutState {
- dsStyleState :: !(DecorationEngineState engine)
- dsDecorations :: ![WindowDecoration]
- class (Read s, Show s) => Shrinker s where
- shrinkText :: DefaultShrinker
- 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)
- 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 ()
DecorationEngine class
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 Source #
Decoration engines type class. Decoration engine is responsible for drawing something inside decoration rectangle. It is also responsible for handling X11 events (such as clicks) which happen within decoration rectangle. Decoration rectangles are defined by DecorationGeometry implementation.
describeEngine, initializeState, releaseStateResources, calcWidgetPlace, paintDecoration, paintWidget
type Theme engine :: Type -> Type Source #
Type of themes used by decoration engine. This type must be parameterized over a widget type, because a theme will contain a list of widgets.
type DecorationPaintingContext engine Source #
Type of data used by engine as a context during painting; for plain X11-based implementation this is Display, Pixmap and GC.
type DecorationEngineState engine Source #
Type of state used by the decoration engine. This can contain some resources that should be initialized and released at time, such as X11 fonts.
describeEngine :: engine widget a -> String Source #
Give a name to decoration engine.
:: engine widget a | Decoration engine instance |
-> geom a | Decoration geometry instance |
-> Theme engine widget | Theme to be used |
-> X (DecorationEngineState engine) |
Initialize state of the engine.
releaseStateResources Source #
:: engine widget a | Decoration engine instance |
-> DecorationEngineState engine | Engine state |
-> X () |
Release resources held in engine state.
:: engine widget a | Decoration engine instance |
-> DrawData engine widget | Information about window and decoration |
-> widget | Widget to be placed |
-> X WidgetPlace |
Calculate place which will be occupied by one widget. NB: X coordinate of the returned rectangle will be ignored, because the rectangle will be moved to the right or to the left for proper alignment of widgets.
:: Shrinker shrinker | |
=> engine widget a | Decoration engine instance |
-> Theme engine widget | Theme to be used |
-> shrinker | Strings shrinker |
-> DecorationEngineState engine | Current state of the engine |
-> Rectangle | Decoration rectangle |
-> Window | Original window to be decorated |
-> WidgetLayout widget | Widgets layout |
-> X (WidgetLayout WidgetPlace) |
Place widgets along the decoration bar.
getShrinkedWindowName Source #
:: Shrinker shrinker | |
=> engine widget a | Decoration engine instance |
-> shrinker | Strings shrinker |
-> DecorationEngineState engine | State of decoration engine |
-> String | Original window title |
-> Dimension | Width of rectangle in which the title should fit |
-> Dimension | Height of rectangle in which the title should fit |
-> X String |
Shrink window title so that it would fit in decoration.
default getShrinkedWindowName :: (Shrinker shrinker, DecorationEngineState engine ~ XMonadFont) => engine widget a -> shrinker -> DecorationEngineState engine -> String -> Dimension -> Dimension -> X String Source #
decorationXEventMask :: engine widget a -> EventMask Source #
Mask of X11 events on which the decoration engine should do something.
exposureMask
should be included here so that decoration engine could
repaint decorations when they are shown on screen.
buttonPressMask
should be included so that decoration engine could
response to mouse clicks.
Other events can be added to custom implementations of DecorationEngine.
propsToRepaintDecoration :: engine widget a -> X [Atom] Source #
List of X11 window property atoms of original (client) windows,
change of which should trigger repainting of decoration.
For example, if WM_NAME
changes it means that we have to redraw
window title.
decorationEventHookEx :: Shrinker shrinker => engine widget a -> Theme engine widget -> DecorationLayoutState engine -> shrinker -> Event -> X () Source #
Generic event handler, which recieves X11 events on decoration window. Default implementation handles mouse clicks and drags.
handleDecorationClick Source #
:: engine widget a | Decoration engine instance |
-> Theme engine widget | Decoration theme |
-> Rectangle | Decoration rectangle |
-> [Rectangle] | Rectangles where widgets are placed |
-> Window | Original (client) window |
-> Int | Mouse click X coordinate |
-> Int | Mouse click Y coordinate |
-> Int | Mouse button number |
-> X Bool |
Event handler for clicks on decoration window. This is called from default implementation of "decorationEventHookEx". This should return True, if the click was handled (something happened because of that click). If this returns False, the click can be considered as a beginning of mouse drag.
decorationWhileDraggingHook Source #
:: engine widget a | Decoration engine instance |
-> CInt | Event X coordinate |
-> CInt | Event Y coordinate |
-> (Window, Rectangle) | Original window and it's rectangle |
-> Position | X coordinate of new pointer position during dragging |
-> Position | Y coordinate of new pointer position during dragging |
-> X () |
Event handler which is called during mouse dragging. This is called from default implementation of "decorationEventHookEx".
decorationAfterDraggingHook Source #
:: engine widget a | Decoration engine instance |
-> (Window, Rectangle) | Original window and its rectangle |
-> Window | Decoration window |
-> X () |
This hoook is called after a window has been dragged using the decoration. This is called from default implementation of "decorationEventHookEx".
:: Shrinker shrinker | |
=> engine widget a | Decoration engine instance |
-> a | Decoration window |
-> Dimension | Decoration window width |
-> Dimension | Decoration window height |
-> shrinker | Strings shrinker instance |
-> DrawData engine widget | Details about what to draw |
-> Bool | True when this method is called during Expose event |
-> X () |
Draw everything required on the decoration window.
This method should draw background (flat or gradient or whatever),
borders, and call paintWidget
method to draw window widgets
(buttons and title).
:: Shrinker shrinker | |
=> engine widget a | Decoration engine instance |
-> DecorationPaintingContext engine | Decoration painting context |
-> WidgetPlace | Place (rectangle) where the widget should be drawn |
-> shrinker | Strings shrinker instance |
-> DrawData engine widget | Details about window decoration |
-> widget | Widget to be drawn |
-> Bool | True when this method is called during Expose event |
-> X () |
Paint one widget on the decoration window.
Instances
Auxiliary data types
data DrawData engine widget Source #
Auxiliary type for data which are passed from decoration layout modifier to decoration engine.
DrawData | |
|
data DecorationLayoutState engine Source #
State of decoration engine
DecorationLayoutState | |
|
Re-exports from X.L.Decoration
class (Read s, Show s) => Shrinker s where Source #
Instances
Shrinker CustomShrink Source # | |
Defined in XMonad.Config.Droundy | |
Shrinker DefaultShrinker Source # | |
Defined in XMonad.Layout.Decoration |
Utility functions
:: (DecorationEngine engine widget a, ThemeAttributes (Theme engine widget), HasWidgets (Theme engine) widget) | |
=> engine widget a | |
-> Theme engine widget | Decoration theme |
-> DecorationEngineState engine | State of decoration engine |
-> Window | Original window (to be decorated) |
-> Rectangle | Decoration rectangle |
-> X (DrawData engine widget) |
Build an instance of DrawData
type.
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 () Source #
Simple implementation of paintDecoration
method.
This is used by TextEngine
and can be re-used by other decoration
engines.