diff options
Diffstat (limited to 'lib/Phi/X11.hs')
| -rw-r--r-- | lib/Phi/X11.hs | 376 |
1 files changed, 185 insertions, 191 deletions
diff --git a/lib/Phi/X11.hs b/lib/Phi/X11.hs index 82809f2..cc53cea 100644 --- a/lib/Phi/X11.hs +++ b/lib/Phi/X11.hs @@ -5,16 +5,19 @@ module Phi.X11 ( XConfig(..) , runPhi ) where -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras -import Graphics.X11.Xinerama +import Graphics.XHB +import Graphics.XHB.Gen.Xinerama +import Graphics.XHB.Gen.Xproto import Graphics.Rendering.Cairo import Control.Monad -import Data.Maybe import Data.Bits import Data.Char +import Data.List +import Data.Maybe +import Data.Typeable +import Data.Word import Control.Arrow ((&&&)) import Control.Concurrent @@ -27,16 +30,18 @@ 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 import Phi.Widget hiding (Display, handleMessage) import Phi.X11.Atoms -import qualified Phi.Bindings.Util as Util -data XConfig = XConfig { phiXScreenInfo :: !(Display -> IO [Rectangle]) +data XConfig = XConfig { phiXScreenInfo :: !(Connection -> IO [RECTANGLE]) } data PhiState w s c = (Widget.Widget w s c) => PhiState { phiRootImage :: !Surface @@ -47,10 +52,10 @@ data PhiState w s c = (Widget.Widget w s c) => PhiState { phiRootImage :: !Su , phiWidgetState :: !s } -data PanelState w s c = (Widget.Widget w s c) => PanelState { panelWindow :: !Window - , panelPixmap :: !Pixmap - , panelArea :: !Rectangle - , panelScreenArea :: !Rectangle +data PanelState w s c = (Widget.Widget w s c) => PanelState { panelWindow :: !WINDOW + , panelPixmap :: !PIXMAP + , panelArea :: !RECTANGLE + , panelScreenArea :: !RECTANGLE , panelWidgetCache :: !c } @@ -76,27 +81,35 @@ runPhiX config st (PhiX a) = runPhiReader config $ runStateT a st defaultXConfig = XConfig { phiXScreenInfo = getScreenInfo } +getScreenInfo :: Connection -> IO [RECTANGLE] +getScreenInfo conn = do + exs <- queryScreens conn >>= getReply + case exs of + Right xs -> return . map screenInfoToRect $ screen_info_QueryScreensReply xs + Left _ -> getGeometry conn (fromXid . toXid $ getRoot conn) >>= getReply' "getScreenInfo: getGeometry failed" >>= + return . (\(MkGetGeometryReply _ _ x y w h _) -> [MkRECTANGLE x y w h]) + where + screenInfoToRect (MkScreenInfo x y w h) = MkRECTANGLE x y w h + runPhi :: (Widget.Widget w s c) => XConfig -> Panel.PanelConfig -> w -> IO () runPhi xconfig config widget = do - xSetErrorHandler - phi <- initPhi installHandler sigTERM (termHandler phi) Nothing installHandler sigINT (termHandler phi) Nothing installHandler sigQUIT (termHandler phi) Nothing - disp <- openDisplay [] + conn <- liftM fromJust connect + xcb <- XCB.connect - atoms <- initAtoms disp - selectInput disp (defaultRootWindow disp) $ propertyChangeMask.|.structureNotifyMask + atoms <- initAtoms conn + changeWindowAttributes conn (getRoot conn) $ toValueParam [(CWEventMask, toMask [EventMaskPropertyChange, EventMaskStructureNotify])] bg <- createImageSurface FormatRGB24 1 1 - dispmvar <- newMVar disp - screens <- liftIO $ phiXScreenInfo xconfig disp - panelWindows <- mapM (createPanelWindow disp config) screens - let dispvar = Widget.Display dispmvar atoms + screens <- liftIO $ phiXScreenInfo xconfig conn + panelWindows <- mapM (createPanelWindow conn config) screens + let dispvar = Widget.Display conn atoms widget' = widget <~> separator 0 (if weight widget > 0 then 0 else 1) screenPanels = zip screens panelWindows @@ -116,29 +129,28 @@ runPhi xconfig config widget = do , phiShutdownHold = 0 , phiWidgetState = initialState } $ do - updateRootImage disp + updateRootImage conn xcb + + panels <- mapM (\(screen, window) -> createPanel conn window screen) screenPanels + + forM_ panels $ \panel -> do + setPanelProperties conn panel + liftIO $ mapWindow conn (panelWindow panel) + + modify $ \state -> state { phiPanels = panels } + + liftIO $ forkIO $ receiveEvents phi conn - Widget.withDisplay dispvar $ \disp -> do - panels <- mapM (\(screen, window) -> createPanel disp window screen) screenPanels - - forM_ panels $ \panel -> do - setPanelProperties disp panel - liftIO $ mapWindow disp (panelWindow panel) - - modify $ \state -> state { phiPanels = panels } - - liftIO $ forkIO $ receiveEvents phi dispvar - forever $ do available <- messageAvailable phi unless available $ do repaint <- gets phiRepaint when repaint $ do - updatePanels dispvar + updatePanels conn xcb modify $ \state -> state {phiRepaint = False} message <- receiveMessage phi - handleMessage dispvar message + handleMessage conn xcb message case (fromMessage message) of Just Shutdown -> @@ -163,8 +175,8 @@ termHandler :: Phi -> Handler termHandler phi = Catch $ sendMessage phi Shutdown -handleMessage :: (Widget w s c) => Widget.Display -> Message -> PhiX w s c () -handleMessage dispvar m = do +handleMessage :: (Widget w s c) => Connection -> XCB.Connection -> Message -> PhiX w s c () +handleMessage conn xcb m = do w <- asks phiWidget modify $ \state -> state {phiWidgetState = Widget.handleMessage w (phiWidgetState state) m} @@ -173,34 +185,43 @@ handleMessage dispvar m = do modify $ \state -> state {phiRepaint = True} _ -> case (fromMessage m) of - Just event -> - Widget.withDisplay dispvar $ flip handleEvent event + Just (XEvent event) -> + handleEvent conn xcb event _ -> return () -handleEvent :: (Widget w s c) => Display -> Event -> PhiX w s c () -handleEvent disp PropertyEvent { ev_atom = atom } = do +handleEvent :: (Widget w s c) => Connection -> XCB.Connection -> SomeEvent -> PhiX w s c () +handleEvent conn xcb event = do + case (fromEvent event) of + Just e -> handlePropertyNotifyEvent conn xcb e + Nothing -> case (fromEvent event) of + Just e -> handleConfigureNotifyEvent conn e + Nothing -> return () + +handlePropertyNotifyEvent :: (Widget w s c) => Connection -> XCB.Connection -> PropertyNotifyEvent -> PhiX w s c () +handlePropertyNotifyEvent conn xcb MkPropertyNotifyEvent { atom_PropertyNotifyEvent = atom } = do phi <- asks phiPhi atoms <- asks phiAtoms panels <- gets phiPanels when (atom == atom_XROOTPMAP_ID atoms || atom == atom_XROOTMAP_ID atoms) $ do - updateRootImage disp + updateRootImage conn xcb sendMessage phi ResetBackground sendMessage phi Repaint -handleEvent disp ConfigureEvent { ev_window = window } | window == defaultRootWindow disp = do +handleConfigureNotifyEvent :: (Widget w s c) => Connection -> ConfigureNotifyEvent -> PhiX w s c () +handleConfigureNotifyEvent conn MkConfigureNotifyEvent { window_ConfigureNotifyEvent = window } | window == getRoot conn = do phi <- asks phiPhi xconfig <- asks phiXConfig config <- asks phiPanelConfig panels <- gets phiPanels let screens = map panelScreenArea panels - screens' <- liftIO $ phiXScreenInfo xconfig disp + screens' <- liftIO $ phiXScreenInfo xconfig conn when (screens /= screens') $ do liftIO $ do - mapM (freePixmap disp . panelPixmap) panels - mapM_ (destroyWindow disp . panelWindow) $ drop (length screens') panels + mapM_ (freePixmap conn . panelPixmap) panels + mapM_ (destroyWindow conn . panelWindow) $ drop (length screens') panels let panelsScreens = zip screens' $ map Just panels ++ repeat Nothing @@ -210,17 +231,21 @@ handleEvent disp ConfigureEvent { ev_window = window } | window == defaultRootWi let rect = panelBounds config screen win = panelWindow panel - liftIO $ withRectangle rect $ moveResizeWindow disp win + liftIO $ configureWindow conn win $ toValueParam [ (ConfigWindowX, fromIntegral $ x_RECTANGLE rect) + , (ConfigWindowY, fromIntegral $ y_RECTANGLE rect) + , (ConfigWindowWidth, fromIntegral $ width_RECTANGLE rect) + , (ConfigWindowHeight, fromIntegral $ height_RECTANGLE rect) + ] - panel' <- createPanel disp win screen - setPanelProperties disp panel' + panel' <- createPanel conn win screen + setPanelProperties conn panel' return panel' Nothing -> do - win <- liftIO $ createPanelWindow disp config screen - panel <- createPanel disp win screen - setPanelProperties disp panel - liftIO $ mapWindow disp $ panelWindow panel + win <- liftIO $ createPanelWindow conn config screen + panel <- createPanel conn win screen + setPanelProperties conn panel + liftIO $ mapWindow conn $ panelWindow panel return panel modify $ \state -> state { phiPanels = panels' } @@ -228,30 +253,13 @@ handleEvent disp ConfigureEvent { ev_window = window } | window == defaultRootWi sendMessage phi $ UpdateScreens $ map (panelScreenArea &&& panelWindow) panels' sendMessage phi Repaint -handleEvent _ _ = return () +receiveEvents :: Phi -> Connection -> IO () +receiveEvents phi conn = do + forever $ waitForEvent conn >>= sendMessage phi . XEvent -receiveEvents :: Phi -> Widget.Display -> IO () -receiveEvents phi dispvar = do - connection <- Widget.withDisplay dispvar $ return . Fd . connectionNumber - - allocaXEvent $ \xevent -> forever $ do - handled <- Widget.withDisplay dispvar $ \disp -> do - pend <- pending disp - if pend /= 0 then - do - liftIO $ nextEvent disp xevent - event <- liftIO $ Util.getEvent disp xevent - sendMessage phi event - - return True - else return False - - --when (not handled) $ threadWaitRead connection - when (not handled) $ threadDelay 40000 - -updatePanels :: (Widget w s c) => Widget.Display -> PhiX w s c () -updatePanels dispvar = do +updatePanels :: (Widget w s c) => Connection -> XCB.Connection -> PhiX w s c () +updatePanels conn xcb = do w <- asks phiWidget s <- gets phiWidgetState rootImage <- gets phiRootImage @@ -264,60 +272,56 @@ updatePanels dispvar = do (panelSurfaces, cache') <- liftIO $ flip runStateT (panelWidgetCache panel) $ (withDimension area $ Widget.render w s 0 0) (panelScreenArea panel) - Widget.withDisplay dispvar $ \disp -> do - let screen = defaultScreen disp - visual = defaultVisual disp screen - - xbuffer <- liftIO $ withDimension area $ Util.createXlibSurface disp pixmap visual - - liftIO $ (withDimension area $ withSimilarSurface xbuffer ContentColor) $ \buffer -> do - renderWith buffer $ do + let screen = head . roots_Setup . connectionSetup $ conn + 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 $ x_RECTANGLE area)) (-(fromIntegral $ y_RECTANGLE area)) + withPatternForSurface rootImage $ \pattern -> do + patternSetExtend pattern ExtendRepeat + setSource pattern + paint + restore + + forM_ panelSurfaces $ \(updated, SurfaceSlice x surface) -> do save - translate (-(fromIntegral $ rect_x area)) (-(fromIntegral $ rect_y area)) - withPatternForSurface rootImage $ \pattern -> do - patternSetExtend pattern ExtendRepeat - setSource pattern + translate (fromIntegral x) 0 + withPatternForSurface surface setSource 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 $ do - (withDimension area $ clearArea disp (panelWindow panel) 0 0) True - sync disp False + 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 :: Display -> PhiX w s c () -updateRootImage disp = do +updateRootImage :: Connection -> XCB.Connection -> PhiX w s c () +updateRootImage conn xcb = do atoms <- asks phiAtoms - let screen = defaultScreen disp - visual = defaultVisual disp screen - rootwin = defaultRootWindow disp - pixmap <- liftM (fromIntegral . fromMaybe 0 . listToMaybe . join . catMaybes) $ forM [atom_XROOTPMAP_ID atoms, atom_XROOTMAP_ID atoms] $ - \atom -> liftIO $ getWindowProperty32 disp atom rootwin + let screen = head . roots_Setup . connectionSetup $ conn + visualtype = fromJust $ findVisualtype screen (root_visual_SCREEN screen) + rootwin = root_SCREEN screen - (pixmapWidth, pixmapHeight) <- case pixmap of + 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) - _ -> do - (_, _, _, pixmapWidth, pixmapHeight, _, _) <- liftIO $ getGeometry disp pixmap - return (pixmapWidth, pixmapHeight) + _ -> liftIO $ getGeometry conn (fromXid . toXid $ pixmap) >>= getReply' "updateRootImage: getGeometry failed" >>= return . (width_GetGeometryReply &&& height_GetGeometryReply) -- update surface size oldBg <- gets phiRootImage @@ -330,31 +334,33 @@ updateRootImage disp = do bg <- gets phiRootImage - case pixmap of + case (fromXid . toXid $ pixmap :: Word32) of 0 -> do renderWith bg $ do setSourceRGB 0 0 0 paint _ -> do - rootSurface <- liftIO $ Util.createXlibSurface disp pixmap visual (fromIntegral pixmapWidth) (fromIntegral pixmapHeight) + 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) => Display -> Window -> Rectangle -> PhiX w s c (PanelState w s c) -createPanel disp win screenRect = do +createPanel :: (Widget w s c) => Connection -> WINDOW -> RECTANGLE -> PhiX w s c (PanelState w s c) +createPanel conn win screenRect = do config <- asks phiPanelConfig w <- asks phiWidget let rect = panelBounds config screenRect - screen = defaultScreen disp - depth = defaultDepth disp screen + screen = head . roots_Setup . connectionSetup $ conn + depth = root_depth_SCREEN screen - pixmap <- liftIO $ (withDimension rect $ createPixmap disp win) depth - liftIO $ setWindowBackgroundPixmap disp win pixmap + 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 @@ -363,96 +369,84 @@ createPanel disp win screenRect = do , panelWidgetCache = initCache w } -createPanelWindow :: Display -> Panel.PanelConfig -> Rectangle -> IO Window -createPanelWindow disp config screenRect = do +createPanelWindow :: Connection -> Panel.PanelConfig -> RECTANGLE -> IO WINDOW +createPanelWindow conn config screenRect = do let rect = panelBounds config screenRect - screen = defaultScreen disp - depth = defaultDepth disp screen - visual = defaultVisual disp screen - colormap = defaultColormap disp screen - rootwin = defaultRootWindow disp - mask = cWEventMask.|.cWColormap.|.cWBackPixel.|.cWBorderPixel - - allocaSetWindowAttributes $ \attr -> do - set_colormap attr colormap - set_background_pixel attr 0 - set_border_pixel attr 0 - set_event_mask attr exposureMask - withRectangle rect (createWindow disp rootwin) 0 depth inputOutput visual mask attr - - -setPanelProperties :: Display -> PanelState w s c -> PhiX w s c () -setPanelProperties disp panel = do + screen = head . roots_Setup . connectionSetup $ conn + 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 :: Connection -> PanelState w s c -> PhiX w s c () +setPanelProperties conn panel = do atoms <- asks phiAtoms liftIO $ do - storeName disp (panelWindow panel) "Phi" - changeProperty8 disp (panelWindow panel) (atom_NET_WM_NAME atoms) (atomUTF8_STRING atoms) propModeReplace $ map (fromIntegral . ord) "Phi" + 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 disp (panelWindow panel) (atom_NET_WM_WINDOW_TYPE atoms) aTOM propModeReplace [fromIntegral (atom_NET_WM_WINDOW_TYPE_DOCK atoms)] - changeProperty32 disp (panelWindow panel) (atom_NET_WM_DESKTOP atoms) cARDINAL propModeReplace [0xFFFFFFFF] - changeProperty32 disp (panelWindow panel) (atom_NET_WM_STATE atoms) aTOM propModeReplace [ fromIntegral (atom_NET_WM_STATE_SKIP_PAGER atoms) - , fromIntegral (atom_NET_WM_STATE_SKIP_TASKBAR atoms) - , fromIntegral (atom_NET_WM_STATE_STICKY atoms) - , fromIntegral (atom_NET_WM_STATE_BELOW atoms) - ] - setWMHints disp (panelWindow panel) WMHints { wmh_flags = fromIntegral inputHintBit - , wmh_input = False - , wmh_initial_state = 0 - , wmh_icon_pixmap = 0 - , wmh_icon_window = 0 - , wmh_icon_x = 0 - , wmh_icon_y = 0 - , wmh_icon_mask = 0 - , wmh_window_group = 0 - } - changeProperty32 disp (panelWindow panel) (atom_MOTIF_WM_HINTS atoms) (atom_MOTIF_WM_HINTS atoms) propModeReplace [ 2, 0, 0, 0, 0 ] + 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 + ] - Util.setClassHint disp (panelWindow panel) ClassHint { resName = "phi", resClass = "Phi" } + changeProperty32 conn PropModeReplace (panelWindow panel) (atom_MOTIF_WM_HINTS atoms) (atom_MOTIF_WM_HINTS atoms) [ 2, 0, 0, 0, 0 ] - setStruts disp panel + changeProperty8 conn PropModeReplace (panelWindow panel) (atomWM_CLASS atoms) (atomSTRING atoms) $ map (fromIntegral . ord) "phi\0Phi" + + setStruts conn panel -setStruts :: Display -> PanelState w s c -> PhiX w s c () -setStruts disp panel = do +setStruts :: Connection -> PanelState w s c -> PhiX w s c () +setStruts conn panel = do atoms <- asks phiAtoms config <- asks phiPanelConfig - let rootwin = defaultRootWindow disp + let rootwin = getRoot conn position = Panel.panelPosition config area = panelArea panel - (_, _, _, _, rootHeight, _, _) <- liftIO $ getGeometry disp rootwin + 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 + where + makeTopStruts 2 = (fromIntegral $ y_RECTANGLE area) + (fromIntegral $ height_RECTANGLE area) + makeTopStruts 8 = (fromIntegral $ x_RECTANGLE area) + makeTopStruts 9 = (fromIntegral $ x_RECTANGLE area) + (fromIntegral $ width_RECTANGLE area) - 1 + makeTopStruts _ = 0 + + makeBottomStruts 3 = (fromIntegral rootHeight) - (fromIntegral $ y_RECTANGLE area) + makeBottomStruts 10 = (fromIntegral $ x_RECTANGLE area) + makeBottomStruts 11 = (fromIntegral $ x_RECTANGLE area) + (fromIntegral $ width_RECTANGLE area) - 1 + makeBottomStruts _ = 0 + + makeStruts = case position of + Phi.Top -> makeTopStruts + Phi.Bottom -> makeBottomStruts liftIO $ do - changeProperty32 disp (panelWindow panel) (atom_NET_WM_STRUT atoms) cARDINAL propModeReplace $ take 4 struts - changeProperty32 disp (panelWindow panel) (atom_NET_WM_STRUT_PARTIAL atoms) cARDINAL propModeReplace struts + 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 :: Panel.PanelConfig -> RECTANGLE -> RECTANGLE panelBounds config screenBounds = case Panel.panelPosition config of - Phi.Top -> screenBounds { rect_height = fromIntegral $ Panel.panelSize config } - Phi.Bottom -> screenBounds { rect_height = fromIntegral $ Panel.panelSize config, - rect_y = (rect_y screenBounds) + (fromIntegral $ rect_height screenBounds) - (fromIntegral $ Panel.panelSize config) } + Phi.Top -> screenBounds { height_RECTANGLE = fromIntegral $ Panel.panelSize config } + Phi.Bottom -> screenBounds { height_RECTANGLE = fromIntegral $ Panel.panelSize config, + y_RECTANGLE = (y_RECTANGLE screenBounds) + (fromIntegral $ height_RECTANGLE screenBounds) - (fromIntegral $ Panel.panelSize config) } -withRectangle :: (Num x, Num y, Num w, Num h) => Rectangle -> (x -> y -> w -> h -> a) -> a +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) +withPosition :: (Num x, Num y) => RECTANGLE -> (x -> y -> a) -> a +withPosition r f = f (fromIntegral $ x_RECTANGLE r) (fromIntegral $ y_RECTANGLE r) -withDimension :: (Num w, Num h) => Rectangle -> (w -> h -> a) -> a -withDimension r f = f (fromIntegral $ rect_width r) (fromIntegral $ rect_height r) +withDimension :: (Num w, Num h) => RECTANGLE -> (w -> h -> a) -> a +withDimension r f = f (fromIntegral $ width_RECTANGLE r) (fromIntegral $ height_RECTANGLE r) |