bindings-wlc 0.1.0.3 → 0.1.0.5

raw patch · 10 files changed

+122/−62 lines, 10 filessetup-changed

Files

Setup.hs +1/−1
bindings-wlc.cabal +1/−1
src/Bindings/WLC.hs +6/−6
src/Bindings/WLC/Core.hsc +4/−1
src/System/WLC.hs +4/−4
src/System/WLC/Core.hs +76/−25
src/System/WLC/Geometry.hs +20/−12
src/System/WLC/Internal/Types.hs +1/−1
src/System/WLC/Types.hs +3/−4
src/System/WLC/Utilities.hs +6/−7

Setup.hs view

@@ -1,2 +1,2 @@-import Distribution.Simple+import           Distribution.Simple main = defaultMain

bindings-wlc.cabal view

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

src/Bindings/WLC.hs view

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

src/Bindings/WLC/Core.hsc view

@@ -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 <wlc_handle>+#ccall wlc_get_outputs , Ptr CSize -> IO (Ptr <wlc_handle>) -- |Get focused output. #ccall wlc_get_focused_output , IO <wlc_handle> -- |Get output name.@@ -262,6 +262,9 @@ #ccall wlc_output_set_mask , <wlc_handle> -> CUInt -> IO () -- |Get views in stack order. Returned array is a direct reference, careful when moving and destroying handles. #ccall wlc_output_get_views , <wlc_handle> -> 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 , <wlc_handle> -> Ptr <wlc_handle> -> CSize -> IO Bool+ -- |Focus output. Pass zero for no focus. #ccall wlc_output_focus , <wlc_handle> -> IO ()

src/System/WLC.hs view

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

src/System/WLC/Core.hs view

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

src/System/WLC/Geometry.hs view

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

src/System/WLC/Internal/Types.hs view

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

src/System/WLC/Types.hs view

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

src/System/WLC/Utilities.hs view

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