diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple +import Distribution.Simple main = defaultMain diff --git a/bindings-wlc.cabal b/bindings-wlc.cabal --- a/bindings-wlc.cabal +++ b/bindings-wlc.cabal @@ -1,5 +1,5 @@ name: bindings-wlc -version: 0.1.0.3 +version: 0.1.0.5 synopsis: Bindings against the wlc library description: Please see Readme.md homepage: http://github.com/aktowns/bindings-wlc#readme diff --git a/src/Bindings/WLC.hs b/src/Bindings/WLC.hs --- a/src/Bindings/WLC.hs +++ b/src/Bindings/WLC.hs @@ -9,10 +9,10 @@ Provides bindings to the low level WLC API's -} -module Bindings.WLC where +module Bindings.WLC(module WLCBindings) where -import Bindings.WLC.Defines -import Bindings.WLC.Geometry -import Bindings.WLC.Core -import Bindings.WLC.Render -import Bindings.WLC.Wayland +import Bindings.WLC.Core as WLCBindings +import Bindings.WLC.Defines as WLCBindings +import Bindings.WLC.Geometry as WLCBindings +import Bindings.WLC.Render as WLCBindings +import Bindings.WLC.Wayland as WLCBindings diff --git a/src/Bindings/WLC/Core.hsc b/src/Bindings/WLC/Core.hsc --- a/src/Bindings/WLC/Core.hsc +++ b/src/Bindings/WLC/Core.hsc @@ -243,7 +243,7 @@ -- * Output API -- |Get outputs. Returned array is a direct reference, careful when moving and destroying handles. -#ccall wlc_get_outputs , Ptr CSize -> IO +#ccall wlc_get_outputs , Ptr CSize -> IO (Ptr ) -- |Get focused output. #ccall wlc_get_focused_output , IO -- |Get output name. @@ -262,6 +262,9 @@ #ccall wlc_output_set_mask , -> CUInt -> IO () -- |Get views in stack order. Returned array is a direct reference, careful when moving and destroying handles. #ccall wlc_output_get_views , -> Ptr CSize -> IO (Ptr wlc_handle) +-- |Set views in stack order. This will also change mutable views. Returns false on failure. +#ccall wlc_output_set_views , -> Ptr -> CSize -> IO Bool + -- |Focus output. Pass zero for no focus. #ccall wlc_output_focus , -> IO () diff --git a/src/System/WLC.hs b/src/System/WLC.hs --- a/src/System/WLC.hs +++ b/src/System/WLC.hs @@ -9,8 +9,8 @@ Provides abstractions over the low level WLC API's -} -module System.WLC where +module System.WLC(module WLC) where -import System.WLC.Core -import System.WLC.Geometry -import System.WLC.Types +import System.WLC.Core as WLC +import System.WLC.Geometry as WLC +import System.WLC.Types as WLC diff --git a/src/System/WLC/Core.hs b/src/System/WLC/Core.hs --- a/src/System/WLC/Core.hs +++ b/src/System/WLC/Core.hs @@ -11,21 +11,25 @@ -} module System.WLC.Core where -import Bindings.WLC.Core -import System.WLC.Types -import System.WLC.Geometry -import System.WLC.Utilities -import System.WLC.Internal.Types +import Bindings.WLC +import System.WLC.Geometry +import System.WLC.Internal.Types +import System.WLC.Types +import System.WLC.Utilities (Primitive (..), apply3) -import Data.Word(Word8, Word32) -import Control.Monad(liftM2) -import Foreign.Ptr(nullPtr) -import Foreign.C.String(peekCString, withCString, newCString) -import Foreign.Marshal.Array(withArray0) -import Foreign.Marshal.Alloc(free, alloca) -import Foreign.Marshal.Utils(with) -import Data.Convertible.Base -import Data.Convertible.Instances.C +import Data.Convertible.Base +import Data.Convertible.Instances.C +import Data.Maybe (fromMaybe) +import Data.Word (Word32, Word8) +import Foreign.C.String (newCString, peekCString, + withCString) +import Foreign.C.Types (CSize (..)) +import Foreign.Marshal.Alloc (alloca, free) +import Foreign.Marshal.Array (newArray, peekArray, withArray, + withArray0) +import Foreign.Marshal.Utils (with) +import Foreign.Ptr (nullPtr) +import Foreign.Storable (peek) -- * Callback API @@ -119,8 +123,8 @@ -- |Set log handler. Can be set before initialize. logHandler :: (LogType -> String -> IO ()) -> IO () logHandler cb = mk'log_handler_cb (\typ text -> do - str <- peekCString text - cb (fromPrimitive $ WlcLogType typ) str) >>= c'wlc_log_set_handler + str <- peekCString text + cb (fromPrimitive $ WlcLogType typ) str) >>= c'wlc_log_set_handler -- |Initialize wlc. Returns false on failure. -- @@ -141,8 +145,8 @@ -- |Query backend wlc is using. getBackendType :: IO BackendType getBackendType = do - backend <- c'wlc_get_backend_type - return $ fromPrimitive (WlcBackendType backend) + backend <- c'wlc_get_backend_type + return $ fromPrimitive (WlcBackendType backend) -- |Exec program. exec :: String -> [String] -> IO () @@ -159,14 +163,62 @@ -- ** Output +-- |Get outputs. +getOutputs :: IO [Output] +getOutputs = with (CSize 0) (\cSize -> do + ptr <- c'wlc_get_outputs cSize + size <- peek cSize + handles <- peekArray (convert size) ptr + return $ map Output handles) + +-- |Get focused output. +getFocusedOutput :: IO Output +getFocusedOutput = Output <$> c'wlc_get_focused_output + +-- |Get output name. +outputGetName :: Output -> IO String +outputGetName (Output output) = c'wlc_output_get_name output >>= peekCString + +-- |Get sleep state. +outputGetSleep :: Output -> IO Bool +outputGetSleep (Output output) = c'wlc_output_get_sleep output + +-- |Wake up / sleep. +outputSetSleep :: Output -> Bool -> IO () +outputSetSleep (Output output) = c'wlc_output_set_sleep output + +-- |Get resolution. +outputGetResolution :: Output -> IO Size +outputGetResolution (Output output) = fromMaybe zeroSize <$> (c'wlc_output_get_resolution output >>= fromPrimitivePtr) + +-- | Set resolution. +outputSetResolution :: Output -> Size -> IO () +outputSetResolution (Output output) size = with (toPrimitive size) $ c'wlc_output_set_resolution output + -- |Get current visibility bitmask. outputGetMask :: Output -> IO Word32 -outputGetMask (Output view) = convert <$> c'wlc_output_get_mask view +outputGetMask (Output output) = convert <$> c'wlc_output_get_mask output -- |Set visibility bitmask. outputSetMask :: Output -> Word32 -> IO () -outputSetMask (Output view) mask = c'wlc_output_set_mask view (convert mask) +outputSetMask (Output output) mask = c'wlc_output_set_mask output (convert mask) +-- |Get views in stack order. +outputGetViews :: Output -> IO [View] +outputGetViews (Output output) = with (CSize 0) (\cSize -> do + ptr <- c'wlc_output_get_views output cSize + size <- peek cSize + handles <- peekArray (convert size) ptr + return $ map View handles) + +-- |Set views in stack order. This will also change mutable views. Returns false on failure. +outputSetViews :: Output -> [View] -> IO Bool +outputSetViews (Output output) views = withArray viewHandles (\cViews -> + c'wlc_output_set_views output cViews viewLength) + where + viewHandles = map getViewHandle views + viewLength = convert $ length views :: CSize + -- |Focus output. Pass zero for no focus. outputFocus :: Output -> IO () outputFocus (Output output) = c'wlc_output_focus output @@ -260,11 +312,10 @@ -- |Get current pointer position. pointerGetPosition :: IO Point -pointerGetPosition = - alloca (\point -> do - c'wlc_pointer_get_position point - Just pt <- fromPrimitivePtr point - return pt) +pointerGetPosition = alloca (\point -> do + c'wlc_pointer_get_position point + Just pt <- fromPrimitivePtr point + return pt) -- |Set current pointer position. pointerSetPosition :: Point -> IO () diff --git a/src/System/WLC/Geometry.hs b/src/System/WLC/Geometry.hs --- a/src/System/WLC/Geometry.hs +++ b/src/System/WLC/Geometry.hs @@ -12,33 +12,41 @@ -} module System.WLC.Geometry where -import Foreign.Ptr(Ptr) -import Data.Word(Word32) -import Data.Convertible.Base -import Data.Convertible.Instances.C +import Data.Convertible.Base +import Data.Convertible.Instances.C +import Data.Word (Word32) -import System.WLC.Utilities -import Bindings.WLC.Geometry +import Bindings.WLC +import System.WLC.Utilities (Primitive (..)) -- |Fixed 2D point data Point = Point { x :: Int, y :: Int } deriving (Eq, Show, Ord) -instance Primitive C'wlc_point Point where - fromPrimitive C'wlc_point { c'wlc_point'x = x, c'wlc_point'y = y } = Point { x = convert x, y = convert y } - toPrimitive Point { x = x, y = y } = C'wlc_point { c'wlc_point'x = convert x, c'wlc_point'y = convert y } +zeroPoint :: Point +zeroPoint = Point { x = 0, y = 0 } -- |Fixed 2D size data Size = Size { w :: Word32, h :: Word32 } deriving (Eq, Show, Ord) -instance Primitive C'wlc_size Size where - fromPrimitive C'wlc_size { c'wlc_size'w = w, c'wlc_size'h = h } = Size { w = convert w, h = convert h } - toPrimitive Size { w = w, h = h } = C'wlc_size { c'wlc_size'w = convert w, c'wlc_size'h = convert h } +zeroSize :: Size +zeroSize = Size { w = 0, h = 0 } -- |Fixed 2D point, size pair data Geometry = Geometry { origin :: Point, size :: Size } deriving (Eq, Show, Ord) + +geometryZero :: Geometry +geometryZero = Geometry { origin = zeroPoint, size = zeroSize } + +instance Primitive C'wlc_point Point where + fromPrimitive C'wlc_point { c'wlc_point'x = x, c'wlc_point'y = y } = Point { x = convert x, y = convert y } + toPrimitive Point { x = x, y = y } = C'wlc_point { c'wlc_point'x = convert x, c'wlc_point'y = convert y } + +instance Primitive C'wlc_size Size where + fromPrimitive C'wlc_size { c'wlc_size'w = w, c'wlc_size'h = h } = Size { w = convert w, h = convert h } + toPrimitive Size { w = w, h = h } = C'wlc_size { c'wlc_size'w = convert w, c'wlc_size'h = convert h } instance Primitive C'wlc_geometry Geometry where fromPrimitive C'wlc_geometry { c'wlc_geometry'size = size, c'wlc_geometry'origin = origin } = diff --git a/src/System/WLC/Internal/Types.hs b/src/System/WLC/Internal/Types.hs --- a/src/System/WLC/Internal/Types.hs +++ b/src/System/WLC/Internal/Types.hs @@ -1,7 +1,7 @@ {-# OPTIONS_HADDOCK hide #-} module System.WLC.Internal.Types where -import Bindings.WLC.Core +import Bindings.WLC.Core -- Wrappers around the type synonyms so we can add the Primitive instances. newtype WlcLogType = WlcLogType { getRawLogType :: C'wlc_log_type } deriving (Show) diff --git a/src/System/WLC/Types.hs b/src/System/WLC/Types.hs --- a/src/System/WLC/Types.hs +++ b/src/System/WLC/Types.hs @@ -13,10 +13,9 @@ -} module System.WLC.Types where -import Bindings.WLC.Defines -import Bindings.WLC.Core -import System.WLC.Utilities -import System.WLC.Internal.Types +import Bindings.WLC +import System.WLC.Internal.Types +import System.WLC.Utilities (Primitive (..)) data LogType = LogInfo | LogWarn diff --git a/src/System/WLC/Utilities.hs b/src/System/WLC/Utilities.hs --- a/src/System/WLC/Utilities.hs +++ b/src/System/WLC/Utilities.hs @@ -1,15 +1,14 @@ {-# LANGUAGE MultiParamTypeClasses #-} - module System.WLC.Utilities(checkPtr, getPtrValue, apply3, Primitive(..)) where -import Foreign.Ptr(Ptr, nullPtr) -import Foreign.Storable(Storable, peek) +import Foreign.Ptr (Ptr, nullPtr) +import Foreign.Storable (Storable, peek) class Primitive a b where - fromPrimitive :: a -> b - fromPrimitivePtr :: (Storable a) => Ptr a -> IO (Maybe b) - fromPrimitivePtr ptr = fmap fromPrimitive <$> getPtrValue ptr - toPrimitive :: b -> a + fromPrimitive :: a -> b + toPrimitive :: b -> a + fromPrimitivePtr :: (Storable a) => Ptr a -> IO (Maybe b) + fromPrimitivePtr ptr = fmap fromPrimitive <$> getPtrValue ptr checkPtr :: Ptr a -> Maybe (Ptr a) checkPtr ptr = if ptr /= nullPtr then Just ptr else Nothing