diff options
Diffstat (limited to 'protocols/Wayland/Protocols')
| -rw-r--r-- | protocols/Wayland/Protocols/Core/WLOutput.hs | 207 | ||||
| -rw-r--r-- | protocols/Wayland/Protocols/XdgShell.hs | 1 |
2 files changed, 0 insertions, 208 deletions
diff --git a/protocols/Wayland/Protocols/Core/WLOutput.hs b/protocols/Wayland/Protocols/Core/WLOutput.hs deleted file mode 100644 index 625ccd9..0000000 --- a/protocols/Wayland/Protocols/Core/WLOutput.hs +++ /dev/null @@ -1,207 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -module Wayland.Protocols.Core.WLOutput - ( Subpixel(..) - , Transform(..) - , Mode(..) - , Geometry(..) - , Request(..) - , Event(..) - , WLOutput(..) - ) where - -import Data.Data (Typeable) -import Data.Hashable (Hashable(..)) -import Wayland.Server - -newtype WLOutput = WLOutput AnyObject - deriving (Show, Eq, Ord, Hashable) - -reqRelease :: MessageDesc -reqRelease = MessageDesc { msgName = "release" - , msgArguments = [] - , msgSince = 3 - , msgIsDestructor = True - } - -evGeometry :: MessageDesc -evGeometry = MessageDesc { msgName = "geometry" - , msgArguments = [ ArgumentInt - , ArgumentInt - , ArgumentInt - , ArgumentInt - , ArgumentInt - , ArgumentString NotNull - , ArgumentString NotNull - , ArgumentInt - ] - , msgSince = 1 - , msgIsDestructor = False - } - -evMode :: MessageDesc -evMode = MessageDesc { msgName = "mode" - , msgArguments = [ ArgumentUInt - , ArgumentInt - , ArgumentInt - , ArgumentInt - ] - , msgSince = 1 - , msgIsDestructor = False - } - -evDone :: MessageDesc -evDone = MessageDesc { msgName = "done" - , msgArguments = [] - , msgSince = 2 - , msgIsDestructor = False - } - -evScale :: MessageDesc -evScale = MessageDesc { msgName = "scale" - , msgArguments = [ ArgumentInt ] - , msgSince = 2 - , msgIsDestructor = False - } - -evName :: MessageDesc -evName = MessageDesc { msgName = "name" - , msgArguments = [ ArgumentString NotNull ] - , msgSince = 4 - , msgIsDestructor = False - } - -evDescription :: MessageDesc -evDescription = MessageDesc { msgName = "description" - , msgArguments = [ ArgumentString NotNull ] - , msgSince = 4 - , msgIsDestructor = False - } - -instance Object WLOutput where - type ObjectEvent WLOutput = Event - type ObjectRequest WLOutput = Request - toAny (WLOutput o) = o - fromAny = WLOutput - describeInterface _ = InterfaceDesc { ifName = "wl_output" - , ifVersion = 4 - , ifRequests = [ reqRelease ] - , ifEvents = [ evGeometry - , evMode - , evDone - , evScale - , evName - , evDescription - ] - } - - demarshalRequest r 0 = do - pure (ReqRelease r) - demarshalRequest _ _ = error "Unknown opcode." - - marshalEvent _ (EvGeometry p) = do - marshalInt (x p) - marshalInt (y p) - marshalInt (physicalWidth p) - marshalInt (physicalHeight p) - marshalInt (fromEnum (subpixel p)) - marshalString (make p) - marshalString (model p) - marshalInt (fromEnum (transform p)) - pure 0 - marshalEvent _ (EvMode p) = do - marshalUInt (fromBitSet (flags p)) - marshalInt (width p) - marshalInt (height p) - marshalInt (refresh p) - pure 1 - marshalEvent _ EvDone = do - pure 2 - marshalEvent _ (EvScale p) = do - marshalInt p - pure 3 - marshalEvent _ (EvName p) = do - marshalString p - pure 4 - marshalEvent _ (EvDescription p) = do - marshalString p - pure 5 - - requestSignature _ (ReqRelease _) = reqRelease - - eventSignature _ (EvGeometry _) = evGeometry - eventSignature _ (EvMode _) = evMode - eventSignature _ EvDone = evDone - eventSignature _ (EvScale _) = evScale - eventSignature _ (EvName _) = evName - eventSignature _ (EvDescription _) = evDescription - -data Subpixel - = SubpixelUnknown - | SubpixelNone - | SubpixelHorizontalRgb - | SubpixelHorizontalBgr - | SubpixelVerticalRgb - | SubpixelVerticalBgr - deriving (Show, Enum) - -data Transform - = TransformNormal - | TransformNormal90 - | TransformNormal180 - | TransformNormal270 - | TransformFlipped - | TransformFlipped90 - | TransformFlipped180 - | TransformFlipped270 - deriving (Show, Enum) - -data ModeFlags - = ModeFlags { current :: Bool - , preferred :: Bool - } - deriving (Show) - -fromBitSet :: ModeFlags -> Word -fromBitSet _ = 0 - -data Mode - = Mode { flags :: ModeFlags - , width :: Int - , height :: Int - , refresh :: Int - } - deriving (Show) - -data Geometry - = Geometry { x :: Int - , y :: Int - , physicalWidth :: Int - , physicalHeight :: Int - , subpixel :: Subpixel - , make :: String - , model :: String - , transform :: Transform - } - deriving (Show) - -data Request - = ReqRelease WLOutput - deriving (Typeable, Show) - -instance MessageClass Request -instance RequestClass Request - -data Event - = EvGeometry Geometry - | EvMode Mode - | EvScale Int - | EvName String - | EvDescription String - | EvDone - deriving (Typeable, Show) - -instance MessageClass Event -instance EventClass Event diff --git a/protocols/Wayland/Protocols/XdgShell.hs b/protocols/Wayland/Protocols/XdgShell.hs deleted file mode 100644 index fcaf8f7..0000000 --- a/protocols/Wayland/Protocols/XdgShell.hs +++ /dev/null @@ -1 +0,0 @@ -module Wayland.Protocols.XdgShell () where |