diff options
Diffstat (limited to 'protocols/Wayland/Protocols')
| -rw-r--r-- | protocols/Wayland/Protocols/Core/WLOutput.hs | 55 |
1 files changed, 28 insertions, 27 deletions
diff --git a/protocols/Wayland/Protocols/Core/WLOutput.hs b/protocols/Wayland/Protocols/Core/WLOutput.hs index d6adda2..3c4a8f5 100644 --- a/protocols/Wayland/Protocols/Core/WLOutput.hs +++ b/protocols/Wayland/Protocols/Core/WLOutput.hs @@ -9,26 +9,26 @@ module Wayland.Protocols.Core.WLOutput , Geometry(..) , Request(..) , Event(..) - , Handle(..) + , WLOutput(..) ) where import Data.Data (Typeable) -import Wayland.Server (ResourceClass(..), RequestClass, InterfaceDesc(..), MessageDesc(..), ArgumentDesc(..), Nullability(..), ObjectID, EventClass, marshalInt, marshalString, marshalUInt) +import Wayland.Server (Object(..), RequestClass, InterfaceDesc(..), MessageDesc(..), ArgumentDesc(..), Nullability(..), AnyObject, EventClass, marshalInt, marshalString, marshalUInt) import Data.Hashable (Hashable(..)) -newtype Handle = Handle ObjectID +newtype WLOutput = WLOutput AnyObject deriving (Show, Eq, Ord, Hashable) reqRelease :: MessageDesc reqRelease = MessageDesc { msgName = "release" - , msgSignature = [] + , msgArguments = [] , msgSince = 3 , msgIsDestructor = True } evGeometry :: MessageDesc evGeometry = MessageDesc { msgName = "geometry" - , msgSignature = [ ArgumentInt + , msgArguments = [ ArgumentInt , ArgumentInt , ArgumentInt , ArgumentInt @@ -43,7 +43,7 @@ evGeometry = MessageDesc { msgName = "geometry" evMode :: MessageDesc evMode = MessageDesc { msgName = "mode" - , msgSignature = [ ArgumentUInt + , msgArguments = [ ArgumentUInt , ArgumentInt , ArgumentInt , ArgumentInt @@ -54,51 +54,52 @@ evMode = MessageDesc { msgName = "mode" evDone :: MessageDesc evDone = MessageDesc { msgName = "done" - , msgSignature = [] + , msgArguments = [] , msgSince = 2 , msgIsDestructor = False } evScale :: MessageDesc evScale = MessageDesc { msgName = "scale" - , msgSignature = [ ArgumentInt ] + , msgArguments = [ ArgumentInt ] , msgSince = 2 , msgIsDestructor = False } evName :: MessageDesc evName = MessageDesc { msgName = "name" - , msgSignature = [ ArgumentString NotNull ] + , msgArguments = [ ArgumentString NotNull ] , msgSince = 4 , msgIsDestructor = False } evDescription :: MessageDesc evDescription = MessageDesc { msgName = "description" - , msgSignature = [ ArgumentString NotNull ] + , msgArguments = [ ArgumentString NotNull ] , msgSince = 4 , msgIsDestructor = False } -instance ResourceClass Handle where - type ResourceEvent Handle = Event - type ResourceRequest Handle = Request - objectID (Handle h) = h - fromID = Handle - interface _ = InterfaceDesc { ifName = "wl_output" - , ifVersion = 4 - , ifRequests = [ reqRelease ] - , ifEvents = [ evGeometry - , evMode - , evDone - , evScale - , evName - , evDescription ] - } +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 _ _ = fail "Unknown opcode." + demarshalRequest _ _ = error "Unknown opcode." marshalEvent _ (EvGeometry p) = do marshalInt (x p) @@ -187,7 +188,7 @@ data Geometry deriving (Show) data Request - = ReqRelease Handle + = ReqRelease WLOutput deriving (Typeable, Show) instance RequestClass Request where |