Use CacheArrow for rendering
Extremely hacky at the moment, for now the caching isn't used at all...
This commit is contained in:
parent
15bccc001a
commit
028c4243a8
8 changed files with 98 additions and 80 deletions
|
|
@ -1,4 +1,4 @@
|
|||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
|
||||
module Phi.Widgets.AlphaBox ( alphaBox
|
||||
) where
|
||||
|
|
@ -11,13 +11,12 @@ import Control.Monad
|
|||
import Graphics.Rendering.Cairo
|
||||
|
||||
|
||||
data AlphaBoxState = AlphaBoxState ![WidgetState] deriving Show
|
||||
data AlphaBoxState = AlphaBoxState ![WidgetState] deriving Eq
|
||||
|
||||
data AlphaBox = AlphaBox !Double ![Widget] deriving Show
|
||||
data AlphaBox = AlphaBox !Double ![Widget] deriving (Show, Eq)
|
||||
|
||||
|
||||
instance WidgetClass AlphaBox where
|
||||
type WidgetData AlphaBox = AlphaBoxState
|
||||
instance WidgetClass AlphaBox AlphaBoxState where
|
||||
initWidget (AlphaBox _ widgets) phi disp = liftM AlphaBoxState $ mapM (createWidgetState phi disp) widgets
|
||||
|
||||
minSize (AlphaBox _ _) (AlphaBoxState widgetStates) height screen =
|
||||
|
|
@ -27,10 +26,10 @@ instance WidgetClass AlphaBox where
|
|||
|
||||
layout (AlphaBox _ _) (AlphaBoxState widgetStates) width height screen = AlphaBoxState $ layoutWidgets widgetStates 0 0 width height screen
|
||||
|
||||
render (AlphaBox alpha _) (AlphaBoxState widgetStates) w h screen = do
|
||||
render (AlphaBox alpha _) (AlphaBoxState widgetStates) x y w h screen = do
|
||||
renderWithSimilarSurface ContentColorAlpha w h $ \surface -> do
|
||||
renderWith surface $ do
|
||||
renderWidgets widgetStates screen
|
||||
renderWidgets widgetStates screen x y
|
||||
|
||||
setOperator OperatorDestIn
|
||||
setSourceRGBA 0 0 0 alpha
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
{-# LANGUAGE TypeFamilies, DeriveDataTypeable #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable #-}
|
||||
|
||||
module Phi.Widgets.Clock ( ClockConfig(..)
|
||||
, defaultClockConfig
|
||||
|
|
@ -29,20 +29,21 @@ data ClockConfig = ClockConfig { clockFormat :: !String
|
|||
, fontColor :: !Color
|
||||
, lineSpacing :: !Double
|
||||
, clockSize :: !Int
|
||||
} deriving Show
|
||||
} deriving (Show, Eq)
|
||||
|
||||
defaultClockConfig :: ClockConfig
|
||||
defaultClockConfig = ClockConfig "%R" (0, 0, 0, 1) 0 50
|
||||
|
||||
data Clock = Clock !ClockConfig deriving Show
|
||||
data Clock = Clock !ClockConfig deriving (Show, Eq)
|
||||
|
||||
data ClockState = ClockState !ZonedTime deriving Show
|
||||
instance Eq ZonedTime where
|
||||
(ZonedTime localTime timezone) == (ZonedTime localTime' timezone') = (localTime == localTime') && (timezone == timezone')
|
||||
|
||||
data ClockState = ClockState !ZonedTime deriving (Show, Eq)
|
||||
|
||||
data ClockMessage = UpdateTime !ZonedTime deriving (Show, Typeable)
|
||||
|
||||
instance WidgetClass Clock where
|
||||
type WidgetData Clock = ClockState
|
||||
|
||||
instance WidgetClass Clock ClockState where
|
||||
initWidget (Clock _) phi _ = do
|
||||
forkIO $ forever $ do
|
||||
time <- getZonedTime
|
||||
|
|
@ -57,8 +58,7 @@ instance WidgetClass Clock where
|
|||
|
||||
minSize (Clock config) _ _ _ = clockSize config
|
||||
|
||||
render (Clock config) (ClockState time) w h _ = do
|
||||
time <- liftIO getZonedTime
|
||||
render (Clock config) (ClockState time) _ _ w h _ = do
|
||||
let (r, g, b, a) = fontColor config
|
||||
str = formatTime defaultTimeLocale (clockFormat config) time
|
||||
setSourceRGBA r g b a
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
{-# LANGUAGE TypeFamilies, DeriveDataTypeable #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable #-}
|
||||
|
||||
module Phi.Widgets.Systray ( systray
|
||||
) where
|
||||
|
|
@ -48,16 +48,16 @@ instance Show (IORef a) where
|
|||
data SystrayIconState = SystrayIconState !Window !Window deriving Show
|
||||
|
||||
data SystrayState = SystrayState !Phi !Rectangle !Int !(IORef Int) ![SystrayIconState] deriving Show
|
||||
instance Eq SystrayState where
|
||||
_ == _ = False
|
||||
|
||||
data Systray = Systray deriving Show
|
||||
data Systray = Systray deriving (Show, Eq)
|
||||
|
||||
data SystrayMessage = AddIcon !Window !Window | RemoveIcon !Window | RenderIcon !Window !Window !Int !Int !Int !Int !Bool
|
||||
deriving (Show, Typeable)
|
||||
|
||||
|
||||
instance WidgetClass Systray where
|
||||
type WidgetData Systray = SystrayState
|
||||
|
||||
instance WidgetClass Systray SystrayState where
|
||||
initWidget (Systray) phi dispvar = do
|
||||
phi' <- dupPhi phi
|
||||
forkIO $ systrayRunner phi' dispvar
|
||||
|
|
@ -71,15 +71,13 @@ instance WidgetClass Systray where
|
|||
|
||||
weight _ = 0
|
||||
|
||||
render Systray (SystrayState phi systrayScreen reset lastResetRef icons) w h screen = case True of
|
||||
render Systray (SystrayState phi systrayScreen reset lastResetRef icons) x y w h screen = case True of
|
||||
_ | screen == systrayScreen -> do
|
||||
lastReset <- liftIO $ readIORef lastResetRef
|
||||
liftIO $ writeIORef lastResetRef reset
|
||||
Matrix _ _ _ _ dx dy <- getMatrix
|
||||
forM_ (zip [0..] icons) $ \(i, SystrayIconState midParent window) -> do
|
||||
let x = round dx + i*(h+2)
|
||||
y = round dy
|
||||
sendMessage phi $ RenderIcon midParent window x y h h (lastReset /= reset)
|
||||
let x' = x + i*(h+2)
|
||||
sendMessage phi $ RenderIcon midParent window x' y h h (lastReset /= reset)
|
||||
|
||||
| otherwise -> return ()
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
{-# LANGUAGE TypeFamilies, DeriveDataTypeable, TypeSynonymInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances #-}
|
||||
|
||||
module Phi.Widgets.Taskbar ( IconStyle
|
||||
, idIconStyle
|
||||
|
|
@ -50,6 +50,8 @@ import Phi.X11.Atoms
|
|||
type IconStyle = Surface -> Render ()
|
||||
instance Show IconStyle where
|
||||
show _ = "IconStyle <?>"
|
||||
instance Eq IconStyle where
|
||||
_ == _ = True
|
||||
|
||||
idIconStyle :: IconStyle
|
||||
idIconStyle = flip withPatternForSurface setSource
|
||||
|
|
@ -103,20 +105,20 @@ data TaskStyle = TaskStyle { taskFont :: !String
|
|||
, taskColor :: !Color
|
||||
, taskBorder :: !BorderConfig
|
||||
, taskIconStyle :: !IconStyle
|
||||
} deriving Show
|
||||
} deriving (Show, Eq)
|
||||
|
||||
data DesktopStyle = DesktopStyle { desktopFont :: !String
|
||||
, desktopLabelWidth :: !Int
|
||||
, desktopLabelGap :: !Int
|
||||
, desktopColor :: !Color
|
||||
, desktopBorder :: !BorderConfig
|
||||
} deriving Show
|
||||
} deriving (Show, Eq)
|
||||
|
||||
data TaskbarConfig = TaskbarConfig { taskMaxSize :: !Int
|
||||
, normalTaskStyle :: !TaskStyle
|
||||
, activeTaskStyle :: !TaskStyle
|
||||
, desktopStyle :: !(Maybe (DesktopStyle, DesktopStyle))
|
||||
} deriving Show
|
||||
} deriving (Show, Eq)
|
||||
|
||||
defaultStyle :: TaskStyle
|
||||
defaultStyle = TaskStyle { taskFont = "Sans 8"
|
||||
|
|
@ -132,7 +134,7 @@ defaultTaskbarConfig = TaskbarConfig { taskMaxSize = 200
|
|||
, desktopStyle = Nothing
|
||||
}
|
||||
|
||||
data Taskbar = Taskbar TaskbarConfig deriving Show
|
||||
data Taskbar = Taskbar TaskbarConfig deriving (Show, Eq)
|
||||
|
||||
instance Show Surface where
|
||||
show _ = "Surface <?>"
|
||||
|
|
@ -146,6 +148,8 @@ data TaskbarState = TaskbarState { taskbarActiveWindow :: !Window
|
|||
, taskbarWindowScaledIcons :: !(M.Map Window (IORef (Maybe (Int, Surface))))
|
||||
, taskbarWindowScreens :: !(M.Map Window Xlib.Rectangle)
|
||||
} deriving Show
|
||||
instance Eq TaskbarState where
|
||||
_ == _ = False
|
||||
|
||||
data WindowState = WindowState { windowTitle :: !String
|
||||
, windowDesktop :: !Int
|
||||
|
|
@ -161,9 +165,7 @@ data TaskbarMessage = WindowListUpdate ![Xlib.Window] !(M.Map Window WindowState
|
|||
instance Show (IORef a) where
|
||||
show _ = "IORef <?>"
|
||||
|
||||
instance WidgetClass Taskbar where
|
||||
type WidgetData Taskbar = TaskbarState
|
||||
|
||||
instance WidgetClass Taskbar TaskbarState where
|
||||
initWidget (Taskbar _) phi dispvar = do
|
||||
phi' <- dupPhi phi
|
||||
forkIO $ taskbarRunner phi' dispvar
|
||||
|
|
@ -182,7 +184,7 @@ instance WidgetClass Taskbar where
|
|||
, taskbarWindowIcons = windowIcons
|
||||
, taskbarWindowScaledIcons = windowScaledIcons
|
||||
, taskbarWindowScreens = windowScreens
|
||||
} w h screen = do
|
||||
} _ _ w h screen = do
|
||||
let screenWindows = filter ((== Just screen) . flip M.lookup windowScreens) windows
|
||||
desktopNumbers = take desktopCount [0..]
|
||||
desktops = map (\desktop -> (desktop, filter (fromMaybe False . fmap (windowOnDesktop desktop) . flip M.lookup windowStates) screenWindows)) desktopNumbers
|
||||
|
|
|
|||
Reference in a new issue