Use Cairo for background rendering

This commit is contained in:
Matthias Schiffer 2011-07-14 22:50:03 +02:00
parent 861fa81d85
commit 55edb549a5
6 changed files with 169 additions and 72 deletions

View file

@ -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

View 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