510 lines
19 KiB
Haskell
510 lines
19 KiB
Haskell
{-# LANGUAGE GeneralizedNewtypeDeriving, ExistentialQuantification, TypeFamilies, FlexibleContexts, DeriveDataTypeable #-}
|
|
|
|
module Phi.X11 ( X11(..)
|
|
, XEvent(..)
|
|
, XMessage(..)
|
|
, XConfig(..)
|
|
, defaultXConfig
|
|
, runPhi
|
|
) where
|
|
|
|
import Graphics.XHB hiding (Window)
|
|
import Graphics.XHB.Connection
|
|
import qualified Graphics.XHB.Connection.Open as CO
|
|
import Graphics.XHB.Gen.Xinerama
|
|
import Graphics.XHB.Gen.Xproto hiding (Window)
|
|
|
|
import Graphics.Rendering.Cairo
|
|
|
|
import Control.Monad
|
|
import Data.Bits
|
|
import Data.Char
|
|
import Data.List
|
|
import Data.Maybe
|
|
import Data.Typeable
|
|
import Data.Word
|
|
|
|
import Control.Arrow ((&&&))
|
|
import Control.Concurrent
|
|
import Control.Concurrent.MVar
|
|
import Control.Monad.State.Strict
|
|
import Control.Monad.Reader
|
|
import Control.Monad.Trans
|
|
|
|
import System.Exit
|
|
import System.Posix.Signals
|
|
import System.Posix.Types
|
|
|
|
import qualified Phi.Bindings.XCB as XCB
|
|
|
|
import Phi.Phi
|
|
import Phi.X11.Util
|
|
import qualified Phi.Types as Phi
|
|
import qualified Phi.Panel as Panel
|
|
import qualified Phi.Widget as Widget (handleMessage)
|
|
import Phi.Widget hiding (handleMessage)
|
|
import Phi.X11.Atoms
|
|
|
|
|
|
data X11 = X11 { x11Connection :: !Connection
|
|
, x11Atoms :: !Atoms
|
|
, x11Screen :: !SCREEN
|
|
}
|
|
|
|
instance Display X11 where
|
|
type Window X11 = WINDOW
|
|
|
|
|
|
newtype XEvent = XEvent SomeEvent deriving (Show, Typeable)
|
|
|
|
data XMessage = UpdateScreens [(Rectangle, WINDOW)] deriving (Show, Typeable)
|
|
|
|
|
|
data XConfig = XConfig { phiXScreenInfo :: !(X11 -> IO [Rectangle])
|
|
}
|
|
|
|
data PhiState w s c = (Widget w s c X11) => PhiState { phiRootImage :: !Surface
|
|
, phiPanels :: ![PanelState w s c]
|
|
, phiRepaint :: !Bool
|
|
, phiShutdown :: !Bool
|
|
, phiShutdownHold :: !Int
|
|
, phiWidgetState :: !s
|
|
}
|
|
|
|
data PanelState w s c = (Widget w s c X11) => PanelState { panelWindow :: !WINDOW
|
|
, panelPixmap :: !PIXMAP
|
|
, panelArea :: !Rectangle
|
|
, panelScreenArea :: !Rectangle
|
|
, panelWidgetCache :: !c
|
|
}
|
|
|
|
data PhiConfig w s c = PhiConfig { phiPhi :: !Phi
|
|
, phiPanelConfig :: !Panel.PanelConfig
|
|
, phiXConfig :: !XConfig
|
|
, phiX11 :: !X11
|
|
, phiXCB :: !XCB.Connection
|
|
, phiWidget :: !w
|
|
}
|
|
|
|
newtype PhiReader w s c a = PhiReader (ReaderT (PhiConfig w s c) IO a)
|
|
deriving (Monad, MonadReader (PhiConfig w s c), MonadIO)
|
|
|
|
runPhiReader :: PhiConfig w s c -> PhiReader w s c a -> IO a
|
|
runPhiReader config (PhiReader a) = runReaderT a config
|
|
|
|
newtype PhiX w s c a = PhiX (StateT (PhiState w s c) (PhiReader w s c) a)
|
|
deriving (Monad, MonadState (PhiState w s c), MonadReader (PhiConfig w s c), MonadIO)
|
|
|
|
runPhiX :: PhiConfig w s c -> PhiState w s c -> PhiX w s c a -> IO (a, PhiState w s c)
|
|
runPhiX config st (PhiX a) = runPhiReader config $ runStateT a st
|
|
|
|
defaultXConfig = XConfig { phiXScreenInfo = getScreenInfo
|
|
}
|
|
|
|
getScreenInfo :: X11 -> IO [Rectangle]
|
|
getScreenInfo x11 = do
|
|
let conn = x11Connection x11
|
|
screen = x11Screen x11
|
|
exs <- queryScreens conn >>= getReply
|
|
case exs of
|
|
Right xs -> return . map screenInfoToRect $ screen_info_QueryScreensReply xs
|
|
Left _ -> getGeometry conn (fromXid . toXid $ root_SCREEN screen) >>= getReply' "getScreenInfo: getGeometry failed" >>=
|
|
return . (\(MkGetGeometryReply _ _ x y w h _) -> [Rectangle (fi x) (fi y) (fi w) (fi h)])
|
|
where
|
|
screenInfoToRect (MkScreenInfo x y w h) = Rectangle (fi x) (fi y) (fi w) (fi h)
|
|
|
|
fi :: (Integral a, Num b) => a -> b
|
|
fi = fromIntegral
|
|
|
|
runPhi :: (Widget w s c X11) => XConfig -> Panel.PanelConfig -> w -> IO ()
|
|
runPhi xconfig config widget = do
|
|
phi <- initPhi
|
|
|
|
installHandler sigTERM (termHandler phi) Nothing
|
|
installHandler sigINT (termHandler phi) Nothing
|
|
installHandler sigQUIT (termHandler phi) Nothing
|
|
|
|
conn <- liftM fromJust connect
|
|
xcb <- XCB.connect
|
|
|
|
let dispname = displayInfo conn
|
|
screen = (roots_Setup . connectionSetup $ conn) !! CO.screen dispname
|
|
|
|
atoms <- initAtoms conn
|
|
changeWindowAttributes conn (root_SCREEN screen) $ toValueParam [(CWEventMask, toMask [EventMaskPropertyChange, EventMaskStructureNotify])]
|
|
|
|
bg <- createImageSurface FormatRGB24 1 1
|
|
|
|
let x11 = X11 conn atoms screen
|
|
|
|
screens <- liftIO $ phiXScreenInfo xconfig x11
|
|
panelWindows <- mapM (createPanelWindow conn screen config) screens
|
|
|
|
let widget' = widget <~> separator 0 (if weight widget > 0 then 0 else 1)
|
|
screenPanels = zip screens panelWindows
|
|
|
|
initialState <- initWidget widget' phi x11 screenPanels
|
|
|
|
runPhiX
|
|
PhiConfig { phiPhi = phi
|
|
, phiXConfig = xconfig
|
|
, phiPanelConfig = config
|
|
, phiX11 = x11
|
|
, phiXCB = xcb
|
|
, phiWidget = widget'
|
|
}
|
|
PhiState { phiRootImage = bg
|
|
, phiPanels = []
|
|
, phiRepaint = False
|
|
, phiShutdown = False
|
|
, phiShutdownHold = 0
|
|
, phiWidgetState = initialState
|
|
} $ do
|
|
updateRootImage
|
|
|
|
panels <- mapM (\(screen, window) -> createPanel window screen) screenPanels
|
|
|
|
forM_ panels setPanelProperties
|
|
|
|
modify $ \state -> state { phiPanels = panels }
|
|
|
|
updatePanels
|
|
|
|
forM_ panels $ liftIO . mapWindow conn . panelWindow
|
|
|
|
liftIO $ forkIO $ receiveEvents phi conn
|
|
|
|
forever $ do
|
|
available <- messageAvailable phi
|
|
repaint <- gets phiRepaint
|
|
when (not available && repaint) $ liftIO $ threadDelay 30000
|
|
|
|
available <- messageAvailable phi
|
|
when (not available && repaint) $ do
|
|
updatePanels
|
|
modify $ \state -> state {phiRepaint = False}
|
|
|
|
message <- receiveMessage phi
|
|
handleMessage message
|
|
|
|
|
|
case (fromMessage message) of
|
|
Just Shutdown ->
|
|
modify $ \state -> state { phiShutdown = True }
|
|
Just HoldShutdown ->
|
|
modify $ \state -> state { phiShutdownHold = phiShutdownHold state + 1 }
|
|
Just ReleaseShutdown ->
|
|
modify $ \state -> state { phiShutdownHold = phiShutdownHold state - 1 }
|
|
_ ->
|
|
return ()
|
|
|
|
shutdown <- gets phiShutdown
|
|
shutdownHold <- gets phiShutdownHold
|
|
|
|
when (shutdown && (shutdownHold == 0)) $
|
|
liftIO $ exitSuccess
|
|
|
|
return ()
|
|
|
|
|
|
termHandler :: Phi -> Handler
|
|
termHandler phi = Catch $ sendMessage phi Shutdown
|
|
|
|
|
|
handleMessage :: (Widget w s c X11) => Message -> PhiX w s c ()
|
|
handleMessage m = do
|
|
w <- asks phiWidget
|
|
modify $ \state -> state {phiWidgetState = Widget.handleMessage w (phiWidgetState state) m}
|
|
|
|
case (fromMessage m) of
|
|
Just Repaint ->
|
|
modify $ \state -> state {phiRepaint = True}
|
|
_ ->
|
|
case (fromMessage m) of
|
|
Just (XEvent event) ->
|
|
handleEvent event
|
|
_ ->
|
|
return ()
|
|
|
|
handleEvent :: (Widget w s c X11) => SomeEvent -> PhiX w s c ()
|
|
handleEvent event =
|
|
case (fromEvent event) of
|
|
Just e -> handlePropertyNotifyEvent e
|
|
Nothing -> case (fromEvent event) of
|
|
Just e -> handleConfigureNotifyEvent e
|
|
Nothing -> return ()
|
|
|
|
handlePropertyNotifyEvent :: (Widget w s c X11) => PropertyNotifyEvent -> PhiX w s c ()
|
|
handlePropertyNotifyEvent MkPropertyNotifyEvent { atom_PropertyNotifyEvent = atom } = do
|
|
phi <- asks phiPhi
|
|
atoms <- asks (x11Atoms . phiX11)
|
|
panels <- gets phiPanels
|
|
|
|
when (atom == atom_XROOTPMAP_ID atoms || atom == atom_XROOTMAP_ID atoms) $ do
|
|
updateRootImage
|
|
sendMessage phi ResetBackground
|
|
sendMessage phi Repaint
|
|
|
|
handleConfigureNotifyEvent :: (Widget w s c X11) => ConfigureNotifyEvent -> PhiX w s c ()
|
|
handleConfigureNotifyEvent MkConfigureNotifyEvent { window_ConfigureNotifyEvent = window } = do
|
|
x11 <- asks phiX11
|
|
let conn = x11Connection x11
|
|
screen = x11Screen x11
|
|
rootWindow = root_SCREEN screen
|
|
when (window == rootWindow) $ do
|
|
phi <- asks phiPhi
|
|
xconfig <- asks phiXConfig
|
|
config <- asks phiPanelConfig
|
|
panels <- gets phiPanels
|
|
let screens = map panelScreenArea panels
|
|
screens' <- liftIO $ phiXScreenInfo xconfig x11
|
|
|
|
when (screens /= screens') $ do
|
|
liftIO $ do
|
|
mapM_ (freePixmap conn . panelPixmap) panels
|
|
mapM_ (destroyWindow conn . panelWindow) $ drop (length screens') panels
|
|
|
|
let panelsScreens = zip screens' $ map Just panels ++ repeat Nothing
|
|
|
|
panels' <- forM panelsScreens $ \(screenarea, mpanel) ->
|
|
case mpanel of
|
|
Just panel -> do
|
|
let rect = panelBounds config screenarea
|
|
win = panelWindow panel
|
|
|
|
liftIO $ configureWindow conn $ MkConfigureWindow win (toMask [ConfigWindowX, ConfigWindowY, ConfigWindowWidth, ConfigWindowHeight]) $
|
|
toValueParam [ (ConfigWindowX, fromIntegral $ rect_x rect)
|
|
, (ConfigWindowY, fromIntegral $ rect_y rect)
|
|
, (ConfigWindowWidth, fromIntegral $ rect_width rect)
|
|
, (ConfigWindowHeight, fromIntegral $ rect_height rect)
|
|
]
|
|
|
|
panel' <- createPanel win screenarea
|
|
setPanelProperties panel'
|
|
|
|
return panel'
|
|
Nothing -> do
|
|
win <- liftIO $ createPanelWindow conn screen config screenarea
|
|
panel <- createPanel win screenarea
|
|
setPanelProperties panel
|
|
liftIO $ mapWindow conn $ panelWindow panel
|
|
return panel
|
|
|
|
modify $ \state -> state { phiPanels = panels' }
|
|
|
|
sendMessage phi $ UpdateScreens $ map (panelScreenArea &&& panelWindow) panels'
|
|
sendMessage phi Repaint
|
|
|
|
|
|
maybeReceiveEvents' :: Connection -> IO [XEvent]
|
|
maybeReceiveEvents' conn = do
|
|
yield
|
|
mevent <- pollForEvent conn
|
|
case mevent of
|
|
Just event ->
|
|
liftM2 (:) (return . XEvent $ event) (maybeReceiveEvents' conn)
|
|
Nothing ->
|
|
return []
|
|
|
|
|
|
receiveEvents' :: Connection -> IO [XEvent]
|
|
receiveEvents' conn = do
|
|
liftM2 (:) (liftM XEvent $ waitForEvent conn) (maybeReceiveEvents' conn)
|
|
|
|
|
|
receiveEvents :: Phi -> Connection -> IO ()
|
|
receiveEvents phi conn =
|
|
forever $ receiveEvents' conn >>= sendMessages phi
|
|
|
|
updatePanels :: (Widget w s c X11) => PhiX w s c ()
|
|
updatePanels = do
|
|
X11 conn _ screen <- asks phiX11
|
|
xcb <- asks phiXCB
|
|
w <- asks phiWidget
|
|
s <- gets phiWidgetState
|
|
rootImage <- gets phiRootImage
|
|
panels <- gets phiPanels
|
|
|
|
panels' <- forM panels $ \panel -> do
|
|
let pixmap = panelPixmap panel
|
|
area = panelArea panel
|
|
|
|
(panelSurfaces, cache') <- liftIO $ flip runStateT (panelWidgetCache panel) $
|
|
(withDimension area $ render w s 0 0) (panelScreenArea panel)
|
|
|
|
let visualtype = fromJust $ findVisualtype screen (root_visual_SCREEN screen)
|
|
|
|
xbuffer <- liftIO $ withDimension area $ XCB.createXCBSurface xcb (fromXid . toXid $ pixmap) visualtype
|
|
|
|
liftIO $ (withDimension area $ withSimilarSurface xbuffer ContentColor) $ \buffer -> do
|
|
renderWith buffer $ do
|
|
save
|
|
translate (-(fromIntegral $ rect_x area)) (-(fromIntegral $ rect_y area))
|
|
withPatternForSurface rootImage $ \pattern -> do
|
|
patternSetExtend pattern ExtendRepeat
|
|
setSource pattern
|
|
paint
|
|
restore
|
|
|
|
forM_ panelSurfaces $ \(updated, SurfaceSlice x surface) -> do
|
|
save
|
|
translate (fromIntegral x) 0
|
|
withPatternForSurface surface setSource
|
|
paint
|
|
restore
|
|
|
|
renderWith xbuffer $ do
|
|
withPatternForSurface buffer setSource
|
|
paint
|
|
|
|
surfaceFinish xbuffer
|
|
|
|
-- update window
|
|
liftIO $ withDimension area $ XCB.clearArea xcb True (panelWindow panel) 0 0
|
|
|
|
return $ panel { panelWidgetCache = cache' }
|
|
|
|
modify $ \state -> state { phiPanels = panels' }
|
|
|
|
|
|
updateRootImage :: PhiX w s c ()
|
|
updateRootImage = do
|
|
X11 conn atoms screen <- asks phiX11
|
|
xcb <- asks phiXCB
|
|
|
|
let visualtype = fromJust $ findVisualtype screen (root_visual_SCREEN screen)
|
|
rootwin = root_SCREEN screen
|
|
|
|
pixmap <- liftM (fromXid . toXid . fromMaybe 0 . listToMaybe . join . catMaybes) $ forM [atom_XROOTPMAP_ID atoms, atom_XROOTMAP_ID atoms] $
|
|
\atom -> liftIO $ getProperty32 conn rootwin atom
|
|
|
|
(pixmapWidth, pixmapHeight) <- case (fromXid . toXid $ (pixmap :: PIXMAP) :: Word32) of
|
|
0 -> return (1, 1)
|
|
_ -> liftIO $ getGeometry conn (fromXid . toXid $ pixmap) >>= getReply' "updateRootImage: getGeometry failed" >>= return . (width_GetGeometryReply &&& height_GetGeometryReply)
|
|
|
|
-- update surface size
|
|
oldBg <- gets phiRootImage
|
|
imageWidth <- liftM fromIntegral $ imageSurfaceGetWidth oldBg
|
|
imageHeight <- liftM fromIntegral $ imageSurfaceGetHeight oldBg
|
|
when (imageWidth /= pixmapWidth || imageHeight /= pixmapHeight) $ do
|
|
surfaceFinish oldBg
|
|
newBg <- liftIO $ createImageSurface FormatRGB24 (fromIntegral pixmapWidth) (fromIntegral pixmapHeight)
|
|
modify $ \state -> state { phiRootImage = newBg }
|
|
|
|
bg <- gets phiRootImage
|
|
|
|
case (fromXid . toXid $ pixmap :: Word32) of
|
|
0 -> do
|
|
renderWith bg $ do
|
|
setSourceRGB 0 0 0
|
|
paint
|
|
_ -> do
|
|
rootSurface <- liftIO $ XCB.createXCBSurface xcb (fromXid . toXid $ pixmap) visualtype (fromIntegral pixmapWidth) (fromIntegral pixmapHeight)
|
|
|
|
renderWith bg $ withPatternForSurface rootSurface $ \pattern -> do
|
|
setSource pattern
|
|
paint
|
|
|
|
surfaceFinish rootSurface
|
|
return ()
|
|
|
|
|
|
createPanel :: (Widget w s c X11) => WINDOW -> Rectangle -> PhiX w s c (PanelState w s c)
|
|
createPanel win screenRect = do
|
|
(conn, screen) <- asks $ (x11Connection &&& x11Screen) . phiX11
|
|
config <- asks phiPanelConfig
|
|
w <- asks phiWidget
|
|
let rect = panelBounds config screenRect
|
|
depth = root_depth_SCREEN screen
|
|
|
|
pixmap <- liftIO $ newResource conn
|
|
liftIO $ createPixmap conn $ withDimension rect $ MkCreatePixmap depth pixmap (fromXid . toXid $ win)
|
|
liftIO $ changeWindowAttributes conn win $ toValueParam [(CWBackPixmap, fromXid . toXid $ pixmap)]
|
|
|
|
return PanelState { panelWindow = win
|
|
, panelPixmap = pixmap
|
|
, panelArea = rect
|
|
, panelScreenArea = screenRect
|
|
, panelWidgetCache = initCache w
|
|
}
|
|
|
|
createPanelWindow :: Connection -> SCREEN -> Panel.PanelConfig -> Rectangle -> IO WINDOW
|
|
createPanelWindow conn screen config screenRect = do
|
|
let rect = panelBounds config screenRect
|
|
depth = root_depth_SCREEN screen
|
|
rootwin = root_SCREEN screen
|
|
visual = root_visual_SCREEN screen
|
|
win <- liftIO $ newResource conn
|
|
createWindow conn $ (withRectangle rect $ MkCreateWindow depth win rootwin) 0 WindowClassInputOutput visual $
|
|
toValueParam [(CWEventMask, toMask [EventMaskExposure]), (CWBackPixel, 0), (CWBorderPixel, 0)]
|
|
return win
|
|
|
|
|
|
setPanelProperties :: PanelState w s c -> PhiX w s c ()
|
|
setPanelProperties panel = do
|
|
(conn, atoms) <- asks $ (x11Connection &&& x11Atoms) . phiX11
|
|
liftIO $ do
|
|
let name = map (fromIntegral . ord) "Phi"
|
|
changeProperty8 conn PropModeReplace (panelWindow panel) (atomWM_NAME atoms) (atomSTRING atoms) name
|
|
changeProperty8 conn PropModeReplace (panelWindow panel) (atom_NET_WM_NAME atoms) (atomUTF8_STRING atoms) name
|
|
|
|
changeProperty32 conn PropModeReplace (panelWindow panel) (atom_NET_WM_WINDOW_TYPE atoms) (atomATOM atoms) [fromXid . toXid $ atom_NET_WM_WINDOW_TYPE_DOCK atoms]
|
|
changeProperty32 conn PropModeReplace (panelWindow panel) (atom_NET_WM_DESKTOP atoms) (atomCARDINAL atoms) [0xFFFFFFFF]
|
|
changeProperty32 conn PropModeReplace (panelWindow panel) (atom_NET_WM_STATE atoms) (atomATOM atoms) $
|
|
map (fromXid . toXid) [ atom_NET_WM_STATE_SKIP_PAGER atoms
|
|
, atom_NET_WM_STATE_SKIP_TASKBAR atoms
|
|
, atom_NET_WM_STATE_STICKY atoms
|
|
, atom_NET_WM_STATE_BELOW atoms
|
|
]
|
|
|
|
changeProperty32 conn PropModeReplace (panelWindow panel) (atom_MOTIF_WM_HINTS atoms) (atom_MOTIF_WM_HINTS atoms) [ 2, 0, 0, 0, 0 ]
|
|
|
|
changeProperty8 conn PropModeReplace (panelWindow panel) (atomWM_CLASS atoms) (atomSTRING atoms) $ map (fromIntegral . ord) "phi\0Phi"
|
|
|
|
setStruts panel
|
|
|
|
|
|
setStruts :: PanelState w s c -> PhiX w s c ()
|
|
setStruts panel = do
|
|
X11 conn atoms screen <- asks phiX11
|
|
config <- asks phiPanelConfig
|
|
let rootwin = root_SCREEN screen
|
|
position = Panel.panelPosition config
|
|
area = panelArea panel
|
|
rootHeight <- liftIO $ getGeometry conn (fromXid . toXid $ rootwin) >>= getReply' "setStruts: getGeometry failed" >>= return . height_GetGeometryReply
|
|
|
|
let struts = [makeStruts i | i <- [0..11]]
|
|
where
|
|
makeTopStruts 2 = (fromIntegral $ rect_y area) + (fromIntegral $ rect_height area)
|
|
makeTopStruts 8 = (fromIntegral $ rect_x area)
|
|
makeTopStruts 9 = (fromIntegral $ rect_x area) + (fromIntegral $ rect_width area) - 1
|
|
makeTopStruts _ = 0
|
|
|
|
makeBottomStruts 3 = (fromIntegral rootHeight) - (fromIntegral $ rect_y area)
|
|
makeBottomStruts 10 = (fromIntegral $ rect_x area)
|
|
makeBottomStruts 11 = (fromIntegral $ rect_x area) + (fromIntegral $ rect_width area) - 1
|
|
makeBottomStruts _ = 0
|
|
|
|
makeStruts = case position of
|
|
Phi.Top -> makeTopStruts
|
|
Phi.Bottom -> makeBottomStruts
|
|
|
|
liftIO $ do
|
|
changeProperty32 conn PropModeReplace (panelWindow panel) (atom_NET_WM_STRUT atoms) (atomCARDINAL atoms) $ take 4 struts
|
|
changeProperty32 conn PropModeReplace (panelWindow panel) (atom_NET_WM_STRUT_PARTIAL atoms) (atomCARDINAL atoms) struts
|
|
|
|
|
|
panelBounds :: Panel.PanelConfig -> Rectangle -> Rectangle
|
|
panelBounds config screenBounds = case Panel.panelPosition config of
|
|
Phi.Top -> screenBounds { rect_height = Panel.panelSize config }
|
|
Phi.Bottom -> screenBounds { rect_height = Panel.panelSize config,
|
|
rect_y = rect_y screenBounds + rect_height screenBounds - Panel.panelSize config }
|
|
|
|
withRectangle :: (Num x, Num y, Num w, Num h) => Rectangle -> (x -> y -> w -> h -> a) -> a
|
|
withRectangle r = withDimension r . withPosition r
|
|
|
|
withPosition :: (Num x, Num y) => Rectangle -> (x -> y -> a) -> a
|
|
withPosition r f = f (fromIntegral $ rect_x r) (fromIntegral $ rect_y r)
|
|
|
|
withDimension :: (Num w, Num h) => Rectangle -> (w -> h -> a) -> a
|
|
withDimension r f = f (fromIntegral $ rect_width r) (fromIntegral $ rect_height r)
|