Use Cairo for background rendering
This commit is contained in:
parent
861fa81d85
commit
55edb549a5
6 changed files with 169 additions and 72 deletions
|
@ -1,4 +1,4 @@
|
|||
{-# LANGUAGE DeriveDataTypeable, TypeFamilies #-}
|
||||
{-# LANGUAGE TypeFamilies, DeriveDataTypeable #-}
|
||||
|
||||
module Phi.Widgets.Clock ( ClockConfig(..)
|
||||
, defaultClockConfig
|
||||
|
@ -36,21 +36,28 @@ defaultClockConfig = ClockConfig "%R" (0, 0, 0, 1) 0 50
|
|||
|
||||
data Clock = Clock ClockConfig deriving Show
|
||||
|
||||
data ClockState = ClockState ZonedTime deriving Show
|
||||
|
||||
data ClockMessage = UpdateTime ZonedTime deriving (Show, Typeable)
|
||||
|
||||
instance WidgetClass Clock where
|
||||
type WidgetData Clock = ()
|
||||
type WidgetData Clock = ClockState
|
||||
|
||||
initWidget (Clock _) phi _ = do
|
||||
forkIO $ forever $ do
|
||||
time <- getZonedTime
|
||||
sendMessage phi $ UpdateTime time
|
||||
sendMessage phi Repaint
|
||||
|
||||
threadDelay $ ceiling $ 1000000*(max 1 $ 60 - (todSec . localTimeOfDay . zonedTimeToLocalTime $ time))
|
||||
return ()
|
||||
|
||||
time <- getZonedTime
|
||||
return $ ClockState time
|
||||
|
||||
|
||||
minSize (Clock config ) = clockSize config
|
||||
|
||||
render (Clock config) _ w h = do
|
||||
render (Clock config) (ClockState time) w h = do
|
||||
time <- liftIO getZonedTime
|
||||
let (r, g, b, a) = fontColor config
|
||||
str = formatTime defaultTimeLocale (clockFormat config) time
|
||||
|
@ -72,6 +79,11 @@ instance WidgetClass Clock where
|
|||
|
||||
moveTo (((fromIntegral w)/scalef - textWidth')/2) (((fromIntegral h)/scalef - textHeight')/2)
|
||||
showLayout layout
|
||||
|
||||
handleMessage _ priv m = case (fromMessage m) of
|
||||
Just (UpdateTime time) -> ClockState time
|
||||
_ -> priv
|
||||
|
||||
|
||||
clock :: ClockConfig -> Widget
|
||||
clock config = do
|
||||
|
|
55
lib/Phi/Widgets/Taskbar.hs
Normal file
55
lib/Phi/Widgets/Taskbar.hs
Normal file
|
@ -0,0 +1,55 @@
|
|||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
module Phi.Widgets.Taskbar ( TaskbarConfig(..)
|
||||
, defaultTaskbarConfig
|
||||
, taskbar
|
||||
) where
|
||||
|
||||
import Control.Concurrent
|
||||
import Control.Monad
|
||||
|
||||
import Data.Typeable
|
||||
import Data.Time.LocalTime
|
||||
import Data.Time.Format
|
||||
|
||||
import Graphics.Rendering.Cairo
|
||||
|
||||
import Graphics.Rendering.Pango.Cairo
|
||||
import Graphics.Rendering.Pango.Enums (PangoRectangle(..))
|
||||
import Graphics.Rendering.Pango.Layout
|
||||
|
||||
import System.Locale
|
||||
|
||||
import Phi.Phi
|
||||
import Phi.Types
|
||||
import Phi.Widget
|
||||
|
||||
|
||||
data TaskbarConfig = TaskbarConfig deriving Show
|
||||
|
||||
defaultTaskbarConfig :: TaskbarConfig
|
||||
defaultTaskbarConfig = TaskbarConfig
|
||||
|
||||
data Taskbar = Taskbar TaskbarConfig deriving Show
|
||||
|
||||
data TaskbarState = TaskbarState deriving Show
|
||||
|
||||
instance WidgetClass Taskbar where
|
||||
type WidgetData Taskbar = TaskbarState
|
||||
|
||||
initWidget (Taskbar _) phi dispvar = do
|
||||
--withMVar dispvar $ \disp ->
|
||||
|
||||
-- return ()
|
||||
return TaskbarState
|
||||
|
||||
|
||||
minSize _ = 0
|
||||
weight _ = 1
|
||||
|
||||
render (Taskbar config) _ w h = do
|
||||
return ()
|
||||
|
||||
taskbar :: TaskbarConfig -> Widget
|
||||
taskbar config = do
|
||||
Widget $ Taskbar config
|
Reference in a new issue