├── .envrc ├── .gitignore ├── .hlint.yaml ├── CHANGELOG.md ├── LICENSE ├── README.md ├── Setup.hs ├── flake.lock ├── flake.nix ├── src ├── PIXMAN │ └── Pixman.hsc ├── Time │ └── Time.hsc ├── WL │ ├── Client.hs │ ├── Global.hs │ ├── Keyboard.hsc │ ├── ServerCore.hsc │ ├── ServerProtocol.hsc │ ├── Utils.hsc │ └── Version.hs └── WLR │ ├── Backend.hsc │ ├── Render │ ├── Allocator.hsc │ ├── DrmFormatSet.hsc │ ├── Interface.hs-boot │ ├── Interface.hsc │ ├── Renderer.hsc │ ├── Swapchain.hsc │ └── Texture.hsc │ ├── Types │ ├── Buffer.hs-boot │ ├── Buffer.hsc │ ├── Compositor.hsc │ ├── DamageRing.hsc │ ├── DataDevice.hs-boot │ ├── DataDevice.hsc │ ├── InputDevice.hsc │ ├── Keyboard.hs-boot │ ├── Keyboard.hsc │ ├── KeyboardGroup.hsc │ ├── Output.hsc │ ├── OutputLayer.hsc │ ├── Pointer.hsc │ ├── PrimarySelection.hsc │ └── Seat.hsc │ ├── Util │ ├── Addon.hsc │ ├── Box.hsc │ ├── Edges.hsc │ └── Log.hsc │ └── Version.hs └── wlhs-bindings.cabal /.envrc: -------------------------------------------------------------------------------- 1 | use flake 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | dist*/ 3 | *~ 4 | .direnv 5 | -------------------------------------------------------------------------------- /.hlint.yaml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bradrn/wlhs/a5761da1191a7abd4a5604354578d82e391f8b70/.hlint.yaml -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for wlhs 2 | 3 | ## Unreleased changes 4 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2024, Brad Neimann 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Brad Neimann nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # wlhs 2 | 3 | This project aims to develop a set of Haskell bindings for `wlroots` 4 | (and some parts of `libwayland`) 5 | At the moment it focusses on low-level bindings, in the `wlhs-bindings` package. 6 | 7 | **Warning: this project has just begun!** 8 | Currently, the bindings are highly incomplete. 9 | Please feel free to help us expand them! 10 | 11 | # Development 12 | 13 | **We currently target wlroots version `0.17.1`.** 14 | 15 | There is a Nix development flake available, which may be accessed via `nix develop`. 16 | For [direnv][ghub:direnv] users, an `.envrc` file is also provided. 17 | 18 | [ghub:direnv]: https://github.com/direnv/direnv 19 | 20 | ## hsc2hs extensions 21 | 22 | `wlhs-bindings` contains a custom `Setup.hs`, 23 | which extends [hsc2hs](https://github.com/haskell/hsc2hs) files with some custom syntax. 24 | This is probably best illustrated by example: 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 42 | 52 | 53 | 67 | 94 | 95 | 96 | 107 | 120 | 121 |
Macro callEquivalent to
33 | 34 | ``` 35 | {{ struct 36 | include.h, 37 | wl_type_name 38 | }} 39 | ``` 40 | 41 | 43 | 44 | ```hs 45 | data {-# CTYPE "include.h" "struct wl_type_name" #-} WL_type_name 46 | deriving (Show) 47 | ``` 48 | 49 | (Note: requires `{-# LANGUAGE EmptyDataDeriving #-}`) 50 | 51 |
54 | 55 | ``` 56 | {{ struct 57 | include.h, 58 | wl_type_name, 59 | field1, Type1, 60 | field2, Type2, 61 | nested field, Type2, 62 | arrayfield, [3]Type3 63 | }} 64 | ``` 65 | 66 | 68 | 69 | ```hs 70 | data {-# CTYPE "include.h" "struct wl_type_name" #-} WL_type_name 71 | = WL_type_name 72 | { wl_type_name_field1 :: Type1 73 | , wl_type_name_field2 :: Type2 74 | , wl_type_name_nested_field :: Type2 75 | , wl_type_name_arrayfield :: [Type3] 76 | } deriving (Show) 77 | 78 | instance Storable WL_type_name where 79 | alignment _ = #alignment struct wl_type_name 80 | sizeOf _ = #size struct wl_type_name 81 | peek ptr = WL_type_name 82 | <$> (#peek struct wl_type_name, field1) ptr 83 | <*> (#peek struct wl_type_name, field2) ptr 84 | <*> (#peek struct wl_type_name, nested.field) ptr 85 | <*> peekArray 3 ((#ptr struct wl_type_name, arrayfield) ptr) 86 | poke ptr t = do 87 | (#poke struct wl_type_name, field1) ptr (wl_type_name_field1 t) 88 | (#poke struct wl_type_name, field2) ptr (wl_type_name_field2 t) 89 | (#poke struct wl_type_name, nested.field) ptr (wl_type_name_nested_field t) 90 | pokeArray ((#ptr struct wl_type_name, nested.field) ptr) (wl_type_name_nested_field t) 91 | ``` 92 | 93 |
97 | 98 | ``` 99 | {{ enum 100 | WL_type_name, 101 | WLR_ENUM_VALUE_1, 102 | WLR_ENUM_VALUE_2 103 | }} 104 | ``` 105 | 106 | 108 | 109 | ```hs 110 | type WL_type_name = CInt 111 | 112 | pattern WLR_ENUM_VALUE_1 :: (Eq a, Num a) => a 113 | pattern WLR_ENUM_VALUE_1 = #const WLR_ENUM_VALUE_1 114 | 115 | pattern WLR_ENUM_VALUE_2 :: (Eq a, Num a) => a 116 | pattern WLR_ENUM_VALUE_2 = #const WLR_ENUM_VALUE_2 117 | ``` 118 | 119 |
122 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE ViewPatterns #-} 4 | 5 | module Main where 6 | 7 | import Data.Char (isSpace) 8 | import Data.Functor ((<&>)) 9 | import Data.Text (Text) 10 | import Distribution.Simple 11 | import Distribution.Simple.PreProcess 12 | import Distribution.Simple.Utils 13 | import Distribution.Types.BuildInfo (BuildInfo) 14 | import Distribution.Types.LocalBuildInfo (LocalBuildInfo) 15 | import Distribution.Types.ComponentLocalBuildInfo (ComponentLocalBuildInfo) 16 | import System.Directory (getTemporaryDirectory) 17 | import System.IO (hClose) 18 | 19 | import qualified Data.Text as T 20 | import qualified Data.Text.IO as T 21 | 22 | main :: IO () 23 | main = defaultMainWithHooks simpleUserHooks 24 | { -- override existing extension so Cabal has a file extension it knows already 25 | hookedPreProcessors = [("hsc", ppHscJinja)] 26 | } 27 | 28 | ppHscJinja :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor 29 | ppHscJinja bi lbi clbi = PreProcessor 30 | { platformIndependent = False 31 | , ppOrdering = unsorted 32 | , runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity -> do 33 | source <- T.readFile inFile 34 | case process source of 35 | Left err -> do 36 | die' verbosity $ "in file " ++ inFile ++ ": " ++ err 37 | Right result -> do 38 | -- put result into a temporary file, then run existing 39 | -- hsc2hs preprocessor on that 40 | tmp <- getTemporaryDirectory 41 | withTempFile tmp (asTemplate inFile) $ \tmpFile handle -> do 42 | debug verbosity $ "HscJinja: got temporary file: " ++ tmpFile 43 | T.hPutStr handle result 44 | hClose handle -- make sure to finalise everything before hsc2hs reads it 45 | runSimplePreProcessor 46 | (ppHsc2hs bi lbi clbi) 47 | tmpFile outFile verbosity 48 | } 49 | 50 | asTemplate :: String -> String 51 | asTemplate = fmap $ \case 52 | '/' -> '-' 53 | '\\' -> '-' 54 | c -> c 55 | 56 | process :: Text -> Either String Text 57 | process = fmap T.concat . traverse go . T.splitOn "{{" 58 | where 59 | go :: Text -> Either String Text 60 | go t = case T.breakOn "}}" t of 61 | (directive, after) 62 | | T.null after -> Right t -- before the first {{ 63 | | otherwise -> 64 | let (macro, args) = T.break isSpace $ T.strip directive 65 | args' = T.strip <$> T.splitOn "," args 66 | result = case T.strip macro of 67 | "struct" -> Right $ mkStruct args' 68 | "enum" -> Right $ mkEnum args' 69 | m -> Left $ T.unpack $ "unknown macro: " <> m 70 | after' = T.drop 2 after -- get rid of }} 71 | in (<> after') <$> result 72 | 73 | mkStruct :: [Text] -> Text 74 | mkStruct args = dataDecl <> storableDecl 75 | where 76 | (cfile:ctype:fields') = args 77 | fields = pairs $ fields' 78 | 79 | hstype = 80 | let (prefix, t) = T.break (=='_') ctype 81 | in T.toUpper prefix <> t 82 | 83 | asHsField n = ctype <> "_" <> asField "_" n 84 | asCField n = asField "." n 85 | 86 | splitFieldType :: Text -> (Maybe Text, Text) 87 | splitFieldType (T.stripPrefix "[" -> Just t') = 88 | let (n, T.stripPrefix "]" -> Just t) = T.break (==']') t' 89 | in (Just n, "[" <> t <> "]") 90 | splitFieldType t = (Nothing, t) 91 | 92 | dataDecl = 93 | T.concat [ "data {-# CTYPE \"" , cfile , "\" \"struct ", ctype, "\" #-} " , hstype] 94 | <> (if (null fields') 95 | then "" 96 | else T.concat [" = ", hstype, " { ", recordFields, " }"]) 97 | <> " deriving Show" 98 | 99 | recordFields = T.intercalate ", " $ 100 | fields <&> \(n, t) -> asHsField n <> " :: " <> snd (splitFieldType t) 101 | 102 | storableDecl 103 | | null fields' = "" 104 | | otherwise = 105 | "\n\ninstance Storable " <> hstype 106 | <> " where\n alignment _ = #alignment struct " <> ctype 107 | <> "\n sizeOf _ = #size struct " <> ctype 108 | <> "\n peek ptr = " <> hstype <> " <$> " <> peekImpl 109 | <> "\n poke ptr t = " <> pokeImpl 110 | 111 | peekImpl = T.intercalate " <*> " $ 112 | fields <&> \(n, t) -> case splitFieldType t of 113 | (Nothing, _) -> "(#peek struct " <> ctype <> ", " <> asCField n <> ") ptr" 114 | (Just m, _) -> "peekArray " <> m <> "((#ptr struct " <> ctype <> ", " <> asCField n <> ") ptr)" 115 | 116 | pokeImpl = T.intercalate " >> " $ 117 | fields <&> \(n, t) -> case splitFieldType t of 118 | (Nothing, _) -> 119 | "(#poke struct " <> ctype <> ", " <> asCField n 120 | <> ") ptr (" <> asHsField n <> " t)" 121 | (Just _, _) -> 122 | "pokeArray ((#ptr struct " <> ctype <> ", " <> asCField n 123 | <> ") ptr) (" <> asHsField n <> " t)" 124 | 125 | 126 | mkEnum :: [Text] -> Text 127 | mkEnum args = enumType <> "\n" <> enumPatterns 128 | where 129 | (hstype:rest) = args 130 | 131 | enumType = "type " <> hstype <> " = CInt" 132 | 133 | enumPatterns = T.unlines $ 134 | rest >>= \val -> 135 | [ "pattern " <> val <> " :: (Eq a, Num a) => a" 136 | , "pattern " <> val <> " = #const " <> val 137 | ] 138 | 139 | 140 | pairs :: [a] -> [(a, a)] 141 | pairs (a:b:as) = (a,b) : pairs as 142 | pairs _ = [] 143 | 144 | asField :: Text -> Text -> Text 145 | asField sep = T.intercalate sep . T.words 146 | -------------------------------------------------------------------------------- /flake.lock: -------------------------------------------------------------------------------- 1 | { 2 | "nodes": { 3 | "flake-utils": { 4 | "inputs": { 5 | "systems": "systems" 6 | }, 7 | "locked": { 8 | "lastModified": 1701680307, 9 | "narHash": "sha256-kAuep2h5ajznlPMD9rnQyffWG8EM/C73lejGofXvdM8=", 10 | "owner": "numtide", 11 | "repo": "flake-utils", 12 | "rev": "4022d587cbbfd70fe950c1e2083a02621806a725", 13 | "type": "github" 14 | }, 15 | "original": { 16 | "owner": "numtide", 17 | "repo": "flake-utils", 18 | "type": "github" 19 | } 20 | }, 21 | "nixpkgs": { 22 | "locked": { 23 | "lastModified": 1704008649, 24 | "narHash": "sha256-rGPSWjXTXTurQN9beuHdyJhB8O761w1Zc5BqSSmHvoM=", 25 | "owner": "NixOS", 26 | "repo": "nixpkgs", 27 | "rev": "d44d59d2b5bd694cd9d996fd8c51d03e3e9ba7f7", 28 | "type": "github" 29 | }, 30 | "original": { 31 | "owner": "NixOS", 32 | "ref": "nixpkgs-unstable", 33 | "repo": "nixpkgs", 34 | "type": "github" 35 | } 36 | }, 37 | "root": { 38 | "inputs": { 39 | "flake-utils": "flake-utils", 40 | "nixpkgs": "nixpkgs" 41 | } 42 | }, 43 | "systems": { 44 | "locked": { 45 | "lastModified": 1681028828, 46 | "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", 47 | "owner": "nix-systems", 48 | "repo": "default", 49 | "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", 50 | "type": "github" 51 | }, 52 | "original": { 53 | "owner": "nix-systems", 54 | "repo": "default", 55 | "type": "github" 56 | } 57 | } 58 | }, 59 | "root": "root", 60 | "version": 7 61 | } 62 | -------------------------------------------------------------------------------- /flake.nix: -------------------------------------------------------------------------------- 1 | { 2 | inputs = { 3 | nixpkgs.url = "github:NixOS/nixpkgs/nixpkgs-unstable"; 4 | flake-utils.url = "github:numtide/flake-utils"; 5 | }; 6 | 7 | outputs = { self, nixpkgs, flake-utils }: 8 | flake-utils.lib.eachDefaultSystem (system: 9 | let 10 | pkgs = nixpkgs.legacyPackages.${system}.extend (final: prev: { 11 | wlroots = prev.wlroots.overrideAttrs (old: rec { 12 | version = "0.17.1"; 13 | src = pkgs.fetchFromGitLab { 14 | domain = "gitlab.freedesktop.org"; 15 | owner = "wlroots"; 16 | repo = "wlroots"; 17 | rev = version; 18 | hash = "sha256-Z0gWM7AQqJOSr2maUtjdgk/MF6pyeyFMMTaivgt+RMI="; 19 | }; 20 | patches = []; # Commit fe53ec693789afb44c899cad8c2df70c8f9f9023 is in 0.17.1. 21 | }); 22 | }); 23 | haskellPackages = pkgs.haskellPackages.extend (final: prev: { 24 | wlhs-bindings = prev.callCabal2nix "wlhs-bindings" ./. { }; 25 | }); 26 | in { 27 | devShells.default = haskellPackages.shellFor { 28 | packages = p: [ p.wlhs-bindings ]; 29 | buildInputs = with haskellPackages; [ 30 | cabal-install 31 | haskell-language-server 32 | ]; 33 | }; 34 | } 35 | ); 36 | } 37 | -------------------------------------------------------------------------------- /src/PIXMAN/Pixman.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDeriving, PatternSynonyms #-} 2 | 3 | module PIXMAN.Pixman where 4 | 5 | #include 6 | 7 | import Foreign 8 | import Foreign.C.Types 9 | 10 | type PIXMAN_region32_t = PIXMAN_region32 11 | type PIXMAN_region32_data_t = PIXMAN_region32_data 12 | type PIXMAN_box32_t = PIXMAN_box32 13 | 14 | {{ struct 15 | pixman.h, 16 | pixman_region32, 17 | extents, PIXMAN_box32_t, 18 | data, Ptr PIXMAN_region32_data_t 19 | }} 20 | 21 | {{ struct 22 | pixman.h, 23 | pixman_region32_data, 24 | size, CLong, 25 | numRects, CLong 26 | }} 27 | 28 | {{ struct 29 | pixman.h, 30 | pixman_box32, 31 | x1, Word32, 32 | y1, Word32, 33 | x2, Word32, 34 | y2, Word32 35 | }} 36 | -------------------------------------------------------------------------------- /src/Time/Time.hsc: -------------------------------------------------------------------------------- 1 | module Time.Time where 2 | 3 | import Foreign.C.Types (CLong, CTime) 4 | import Foreign.Storable (Storable(..)) 5 | 6 | #include 7 | 8 | {{ struct 9 | time.h, 10 | timespec, 11 | tv_sec, CTime, 12 | tv_nsec, CLong 13 | }} 14 | -------------------------------------------------------------------------------- /src/WL/Client.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDecls #-} 2 | module WL.Client where 3 | 4 | data WL_client 5 | -------------------------------------------------------------------------------- /src/WL/Global.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDecls #-} 2 | module WL.Global where 3 | 4 | data WL_global 5 | -------------------------------------------------------------------------------- /src/WL/Keyboard.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE PatternSynonyms #-} 2 | module WL.Keyboard where 3 | 4 | #include 5 | 6 | import Foreign.C.Types (CInt) 7 | 8 | {{ 9 | enum 10 | WL_keyboard_key_state, 11 | WL_KEYBOARD_KEY_STATE_RELEASED, 12 | WL_KEYBOARD_KEY_STATE_PRESSED 13 | }} 14 | -------------------------------------------------------------------------------- /src/WL/ServerCore.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDeriving #-} 2 | 3 | module WL.ServerCore where 4 | 5 | #include 6 | 7 | import Foreign 8 | import Foreign.C.String 9 | import Foreign.Ptr (FunPtr) 10 | 11 | import WL.Utils 12 | import WL.ServerProtocol 13 | 14 | -- Opaque objects 15 | {{ struct wayland-server-core.h, wl_event_source }} 16 | {{ struct wayland-server-core.h, wl_global }} 17 | {{ struct wayland-server-core.h, wl_resource }} 18 | 19 | type WL_notify_func_t 20 | = WL_listener 21 | -> Ptr () 22 | -> IO () 23 | 24 | {{ struct 25 | wayland-server-core.h, 26 | wl_listener, 27 | link, Ptr WL_list, 28 | notify, FunPtr WL_notify_func_t 29 | }} 30 | 31 | {{ struct 32 | wayland-server-core.h, 33 | wl_signal, 34 | listener_list, WL_list 35 | }} 36 | 37 | foreign import capi "wayland-server-core.h wl_signal_init" 38 | wl_signal_init :: Ptr WL_signal -> IO () 39 | 40 | foreign import capi "wayland-server-core.h wl_signal_add" 41 | wl_signal_add :: Ptr WL_signal -> Ptr WL_listener -> IO () 42 | 43 | foreign import capi "wayland-server-core.h wl_signal_get" 44 | wl_signal_get :: Ptr WL_signal -> FunPtr WL_notify_func_t -> IO () 45 | 46 | foreign import capi "wayland-server-core.h wl_signal_emit" 47 | wl_signal_emit :: Ptr WL_signal -> Ptr () -> IO () 48 | 49 | foreign import capi "wayland-server-core.h wl_display_create" 50 | wl_display_create :: IO (Ptr WL_display) 51 | 52 | foreign import capi "wayland-server-core.h wl_display_destroy" 53 | wl_display_destroy :: Ptr WL_display -> IO () 54 | 55 | foreign import capi "wayland-server-core.h wl_display_add_socket_auto" 56 | wl_display_add_socket_auto :: Ptr WL_display -> IO CString 57 | 58 | foreign import capi "wayland-server-core.h wl_display_run" 59 | wl_display_run :: Ptr WL_display -> IO () 60 | 61 | foreign import capi "wayland-server-core.h wl_display_destroy_clients" 62 | wl_display_destroy_clients :: Ptr WL_display -> IO () 63 | 64 | type WL_resource_destroy_func_t = FunPtr (Ptr WL_resource -> IO ()) 65 | --typedef void (*wl_resource_destroy_func_t)(struct wl_resource *resource); 66 | -------------------------------------------------------------------------------- /src/WL/ServerProtocol.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE PatternSynonyms #-} 2 | module WL.ServerProtocol where 3 | 4 | import Foreign.C.Types (CInt) 5 | 6 | #include 7 | 8 | {{ enum 9 | WL_data_device_manager_dnd_action, 10 | WL_DATA_DEVICE_MANAGER_DND_ACTION_NONE, 11 | WL_DATA_DEVICE_MANAGER_DND_ACTION_COPY, 12 | WL_DATA_DEVICE_MANAGER_DND_ACTION_MOVE, 13 | WL_DATA_DEVICE_MANAGER_DND_ACTION_ASK 14 | }} 15 | 16 | data {-# CTYPE "wayland-server-protocol.h" "struct wl_display" #-} WL_display 17 | 18 | {{ enum 19 | WL_output_subpixel, 20 | WL_OUTPUT_SUBPIXEL_UNKNOWN, 21 | WL_OUTPUT_SUBPIXEL_NONE, 22 | WL_OUTPUT_SUBPIXEL_HORIZONTAL_RGB, 23 | WL_OUTPUT_SUBPIXEL_HORIZONTAL_BGR, 24 | WL_OUTPUT_SUBPIXEL_VERTICAL_RGB, 25 | WL_OUTPUT_SUBPIXEL_VERTICAL_BGR 26 | }} 27 | 28 | {{ enum 29 | WL_output_transform, 30 | WL_OUTPUT_TRANSFORM_NORMAL, 31 | WL_OUTPUT_TRANSFORM_90, 32 | WL_OUTPUT_TRANSFORM_180, 33 | WL_OUTPUT_TRANSFORM_270, 34 | WL_OUTPUT_TRANSFORM_FLIPPED, 35 | WL_OUTPUT_TRANSFORM_FLIPPED_90, 36 | WL_OUTPUT_TRANSFORM_FLIPPED_180, 37 | WL_OUTPUT_TRANSFORM_FLIPPED_270 38 | }} 39 | -------------------------------------------------------------------------------- /src/WL/Utils.hsc: -------------------------------------------------------------------------------- 1 | module WL.Utils where 2 | 3 | #include 4 | 5 | import Foreign 6 | import Foreign.C.Types 7 | import Foreign.C.String (CString) 8 | 9 | {{ struct 10 | wayland-util.h, 11 | wl_list, 12 | prev, Ptr WL_list, 13 | next, Ptr WL_list 14 | }} 15 | 16 | foreign import capi "wayland-util.h wl_list_init" 17 | wl_list_init :: Ptr WL_list -> IO () 18 | 19 | foreign import capi "wayland-util.h wl_list_insert" 20 | wl_list_insert :: Ptr WL_list -> Ptr WL_list -> IO () 21 | 22 | foreign import capi "wayland-util.h wl_list_remove" 23 | wl_list_remove :: Ptr WL_list -> IO () 24 | 25 | foreign import capi "wayland-util.h wl_list_length" 26 | wl_list_length :: Ptr WL_list -> IO CInt 27 | 28 | foreign import capi "wayland-util.h wl_list_empty" 29 | wl_list_empty :: Ptr WL_list -> IO CInt 30 | 31 | {{ struct 32 | wayland-util.h, 33 | wl_message, 34 | name, CString, 35 | signature, CString, 36 | types, Ptr (Ptr WL_interface), 37 | }} 38 | 39 | {{ struct 40 | wayland-util.h, 41 | wl_interface, 42 | name, Ptr CChar, 43 | version, CInt, 44 | method_count, CInt, 45 | methods, Ptr WL_message, 46 | event_count, CInt, 47 | events, Ptr WL_message 48 | }} 49 | 50 | {{ struct 51 | wayland-util.h, 52 | wl_array, 53 | size, CSize, 54 | alloc, CSize, 55 | data, Ptr () 56 | }} 57 | -------------------------------------------------------------------------------- /src/WL/Version.hs: -------------------------------------------------------------------------------- 1 | module WL.Version where 2 | 3 | import Foreign.C.String 4 | 5 | foreign import capi "wayland-version.h value WAYLAND_VERSION" wayland_version :: CString 6 | -------------------------------------------------------------------------------- /src/WLR/Backend.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDeriving #-} 2 | 3 | module WLR.Backend where 4 | 5 | #define WLR_USE_UNSTABLE 6 | #include 7 | 8 | import Foreign 9 | import Foreign.C.Types 10 | 11 | import WL.ServerCore 12 | import WL.ServerProtocol 13 | 14 | {{ struct wlr/backend.h, wlr_session }} 15 | {{ struct wlr/backend.h, wlr_backend_impl }} 16 | 17 | {{ struct 18 | wlr/backend.h, 19 | wlr_backend, 20 | impl, Ptr WLR_backend_impl, 21 | events destroy, WL_signal, 22 | events new_input, WL_signal, 23 | events new_output, WL_signal 24 | }} 25 | 26 | foreign import capi "wlr/backend.h wlr_backend_autocreate" 27 | wlr_backend_autocreate :: Ptr WL_display -> Ptr (Ptr WLR_session) -> IO (Ptr WLR_backend) 28 | 29 | foreign import capi "wlr/backend.h wlr_backend_start" 30 | wlr_backend_start :: Ptr WLR_backend -> IO CBool 31 | 32 | foreign import capi "wlr/backend.h wlr_backend_destroy" 33 | wlr_backend_destroy :: Ptr WLR_backend -> IO () 34 | -------------------------------------------------------------------------------- /src/WLR/Render/Allocator.hsc: -------------------------------------------------------------------------------- 1 | module WLR.Render.Allocator where 2 | 3 | #define WLR_USE_UNSTABLE 4 | #include 5 | 6 | import Foreign 7 | import Foreign.C.Types 8 | 9 | import WL.ServerCore 10 | import WLR.Backend 11 | import WLR.Render.DrmFormatSet 12 | import WLR.Render.Renderer 13 | import WLR.Types.Buffer 14 | 15 | type WLR_allocator_interface_create_buffer 16 | = Ptr WLR_allocator 17 | -> CInt 18 | -> CInt 19 | -> Ptr WLR_drm_format 20 | -> IO (Ptr WLR_buffer) 21 | 22 | type WLR_allocator_interface_destroy 23 | = Ptr WLR_allocator 24 | -> IO () 25 | 26 | {{ struct 27 | wlr/render/allocator.h, 28 | wlr_allocator_interface, 29 | create_buffer, FunPtr WLR_allocator_interface_create_buffer, 30 | destroy, FunPtr WLR_allocator_interface_destroy 31 | }} 32 | 33 | {{ struct 34 | wlr/render/allocator.h, 35 | wlr_allocator, 36 | impl, Ptr WLR_allocator_interface, 37 | buffer_caps, Word32, 38 | events destroy, WL_signal 39 | }} 40 | 41 | foreign import capi "wlr/render/allocator.h wlr_allocator_autocreate" 42 | wlr_allocator_autocreate :: Ptr WLR_backend -> Ptr WLR_renderer -> IO (Ptr WLR_allocator) 43 | -------------------------------------------------------------------------------- /src/WLR/Render/DrmFormatSet.hsc: -------------------------------------------------------------------------------- 1 | module WLR.Render.DrmFormatSet where 2 | 3 | #define WLR_USE_UNSTABLE 4 | #include 5 | 6 | import Foreign 7 | import Foreign.C.Types 8 | 9 | {{ struct 10 | wlr/render/drm_format_set.h, 11 | wlr_drm_format, 12 | format, Word32, 13 | len, CSize, 14 | capacity, CSize, 15 | modifiers, Ptr Word64 16 | }} 17 | 18 | {{ struct 19 | wlr/render/drm_format_set.h, 20 | wlr_drm_format_set, 21 | len, CSize, 22 | capacity, CSize, 23 | formats, Ptr WLR_drm_format 24 | }} 25 | -------------------------------------------------------------------------------- /src/WLR/Render/Interface.hs-boot: -------------------------------------------------------------------------------- 1 | module WLR.Render.Interface where 2 | data WLR_texture_impl 3 | -------------------------------------------------------------------------------- /src/WLR/Render/Interface.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDeriving, PatternSynonyms #-} 2 | 3 | module WLR.Render.Interface where 4 | 5 | #define WLR_USE_UNSTABLE 6 | #include 7 | 8 | import Foreign 9 | import Foreign.C.Types 10 | 11 | import WLR.Render.Texture 12 | 13 | {{ struct 14 | wlr/render/interface.h, 15 | wlr_texture_impl, 16 | update_from_buffer, FunPtr FunUpdateFromBuffer, 17 | destroy, FunPtr (Ptr WLR_texture -> IO ()) 18 | }} 19 | 20 | {{ struct 21 | wlr/render/interface.h, 22 | wlr_render_timer, 23 | impl, Ptr WLR_render_timer_impl 24 | }} 25 | 26 | {{ struct 27 | wlr/render/interface.h, 28 | wlr_render_timer_impl, 29 | get_duration_ns, FunPtr (WLR_render_timer -> IO CInt), 30 | destroy, FunPtr (WLR_render_timer -> IO ()) 31 | }} 32 | -------------------------------------------------------------------------------- /src/WLR/Render/Renderer.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDeriving #-} 2 | 3 | module WLR.Render.Renderer where 4 | 5 | #define WLR_USE_UNSTABLE 6 | #include 7 | 8 | import Foreign 9 | import Foreign.C.Types 10 | 11 | import WL.ServerCore 12 | import WL.ServerProtocol 13 | import WLR.Backend 14 | 15 | {{ struct wlr/render/wlr_renderer.h, wlr_renderer_impl }} 16 | 17 | {{ struct 18 | wlr/render/wlr_renderer.h, 19 | wlr_renderer, 20 | events destroy, WL_signal, 21 | events lost, WL_signal, 22 | impl, Ptr WLR_renderer_impl, 23 | rendering, CBool, 24 | rendering_with_buffer, CBool 25 | }} 26 | 27 | foreign import capi "wlr/render/wlr_renderer.h wlr_renderer_autocreate" 28 | wlr_renderer_autocreate :: Ptr WLR_backend -> IO (Ptr WLR_renderer) 29 | 30 | foreign import capi "wlr/render/wlr_renderer.h wlr_renderer_init_wl_display" 31 | wlr_renderer_init_wl_display :: Ptr WLR_renderer -> Ptr WL_display -> IO CBool 32 | -------------------------------------------------------------------------------- /src/WLR/Render/Swapchain.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDeriving, PatternSynonyms #-} 2 | 3 | module WLR.Render.Swapchain where 4 | 5 | #define WLR_USE_UNSTABLE 6 | #include 7 | 8 | import Foreign 9 | import Foreign.C.Types 10 | 11 | import WL.ServerCore 12 | import WLR.Render.Allocator 13 | import WLR.Render.DrmFormatSet 14 | import WLR.Types.Buffer 15 | 16 | {{ struct 17 | wlr/render/swapchain.h, 18 | wlr_swapchain_slot, 19 | buffer, Ptr WLR_buffer, 20 | acquired, CBool, 21 | age, CInt, 22 | release, WL_listener 23 | }} 24 | 25 | {{ struct 26 | wlr/render/swapchain.h, 27 | wlr_swapchain, 28 | allocator, Ptr WLR_allocator, 29 | width, CInt, 30 | height, CInt, 31 | format, WLR_drm_format, 32 | slots, [(#const WLR_SWAPCHAIN_CAP)]WLR_swapchain_slot, 33 | allocator_destroy, WL_listener 34 | }} 35 | -------------------------------------------------------------------------------- /src/WLR/Render/Texture.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDeriving, PatternSynonyms #-} 2 | 3 | module WLR.Render.Texture where 4 | 5 | #define WLR_USE_UNSTABLE 6 | #include 7 | 8 | import Foreign 9 | import Foreign.C.Types 10 | 11 | import PIXMAN.Pixman 12 | import WLR.Render.Renderer 13 | import {-# SOURCE #-} WLR.Types.Buffer (WLR_buffer) 14 | import {-# SOURCE #-} WLR.Render.Interface (WLR_texture_impl) 15 | 16 | {{ struct 17 | wlr/render/wlr_texture.h, 18 | wlr_texture, 19 | impl, Ptr WLR_texture_impl, 20 | width, Word32, 21 | height, Word32, 22 | renderer, Ptr WLR_renderer 23 | }} 24 | 25 | type FunUpdateFromBuffer 26 | = Ptr WLR_texture 27 | -> Ptr WLR_buffer 28 | -> Ptr PIXMAN_region32_t 29 | -> IO (CBool) 30 | -------------------------------------------------------------------------------- /src/WLR/Types/Buffer.hs-boot: -------------------------------------------------------------------------------- 1 | module WLR.Types.Buffer where 2 | data WLR_buffer 3 | data WLR_client_buffer 4 | -------------------------------------------------------------------------------- /src/WLR/Types/Buffer.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDeriving #-} 2 | 3 | module WLR.Types.Buffer where 4 | 5 | #define WLR_USE_UNSTABLE 6 | #include 7 | 8 | import Foreign 9 | import Foreign.C.Types 10 | 11 | import WL.ServerCore 12 | 13 | import WLR.Util.Addon 14 | import WLR.Render.Texture (WLR_texture) 15 | 16 | {{ struct wlr/types/wlr_buffer.h, wlr_buffer_impl }} 17 | 18 | {{ struct 19 | wlr/types/wlr_buffer.h, 20 | wlr_buffer, 21 | impl, Ptr WLR_buffer_impl, 22 | width, CInt, 23 | height, CInt, 24 | dropped, CBool, 25 | n_locks, CSize, 26 | accessing_data_ptr, CBool, 27 | events destroy, WL_signal, 28 | events release, WL_signal, 29 | addons, WLR_addon_set 30 | }} 31 | 32 | {{ struct 33 | wlr/types/wlr_buffer.h, 34 | wlr_client_buffer, 35 | base, WLR_buffer, 36 | texture, WLR_texture, 37 | source, WLR_buffer, 38 | source_destroy, WL_listener, 39 | n_ignore_locks, CSize, 40 | }} 41 | -------------------------------------------------------------------------------- /src/WLR/Types/Compositor.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE PatternSynonyms #-} 2 | module WLR.Types.Compositor where 3 | 4 | import Foreign (Word32, Int32) 5 | import Foreign.C.Types (CBool, CInt, CSize) 6 | import Foreign.C.String (CString) 7 | import Foreign.Storable (Storable(..)) 8 | import Foreign.Ptr (Ptr, FunPtr) 9 | 10 | import WL.Utils (WL_list) 11 | import WL.ServerCore (WL_resource, WL_signal, WL_listener) 12 | import WL.ServerProtocol (WL_output_transform) 13 | 14 | import WLR.Types.Buffer (WLR_client_buffer, WLR_buffer) 15 | import WLR.Render.Renderer (WLR_renderer) 16 | import WLR.Util.Box (WLR_fbox) 17 | import WLR.Util.Addon (WLR_addon_set) 18 | 19 | import PIXMAN.Pixman (PIXMAN_region32) 20 | 21 | #define WLR_USE_UNSTABLE 22 | #include 23 | 24 | -- not exactly sure what int32_t should map to, but I think it's just CInt 25 | -- some of the fields in wlr_surface had this `int32_t` type 26 | 27 | --WLR_surface 28 | -- the 'resource' field had a source comment, "//may be NULL" 29 | {{ struct 30 | wlr/types/wlr_compositor.h, 31 | wlr_surface, 32 | resource, Ptr WL_resource, 33 | renderer, Ptr WLR_renderer, 34 | buffer, WLR_client_buffer, 35 | buffer_damage, PIXMAN_region32, 36 | external_damage, PIXMAN_region32, 37 | opaque_region, PIXMAN_region32, 38 | input_region, PIXMAN_region32, 39 | current, WLR_surface_state, 40 | pending, WLR_surface_state, 41 | cached, WL_list, 42 | mapped, CBool, 43 | role, Ptr WLR_surface_role, 44 | role_resource, Ptr WL_resource, 45 | events client_commit, WL_signal, 46 | events precommit, WL_signal, 47 | events commit, WL_signal, 48 | events map, WL_signal, 49 | events unmap, WL_signal, 50 | events new_subsurface, WL_signal, 51 | events destroy, WL_signal, 52 | current_outputs, WL_list, 53 | addons, WLR_addon_set, 54 | renderer_destroy, WL_listener, 55 | role_resource_destroy, WL_listener, 56 | previous scale, Int32, 57 | previous transform, WL_output_transform, 58 | previous width, CInt, 59 | previous height, CInt, 60 | previous buffer_width, CInt, 61 | previous buffer_height, CInt, 62 | unmap_commit, CBool, 63 | opaque, CBool, 64 | has_buffer, CBool, 65 | preferred_buffer_scale, Int32, 66 | preferred_buffer_transform_sent, CBool, 67 | preferred_buffer_transform, WL_output_transform 68 | }} 69 | 70 | {{ struct 71 | wlr/types/wlr_compositor.h, 72 | wlr_surface_state, 73 | committed, Word32, 74 | seq, Word32, 75 | buffer, Ptr WLR_buffer, 76 | dx, Int32, 77 | dy, Int32, 78 | surface_damage, PIXMAN_region32, 79 | buffer_damage, PIXMAN_region32, 80 | opaque, PIXMAN_region32, 81 | input, PIXMAN_region32, 82 | transform, WL_output_transform, 83 | scale, Int32, 84 | frame_callback_list, WL_list, 85 | width, CInt, 86 | height, CInt, 87 | buffer_width, CInt, 88 | buffer_height, CInt, 89 | subsurfaces_below, WL_list, 90 | subsurfaces_above, WL_list, 91 | viewport has_src, CBool, 92 | viewport has_dst, CBool, 93 | viewport src, WLR_fbox, 94 | viewport dst_width, CInt, 95 | viewport dst_height, CInt, 96 | cached_state_locks, CSize, 97 | cached_state_link, WL_list 98 | }} 99 | 100 | {{ struct 101 | wlr/types/wlr_compositor.h, 102 | wlr_surface_role, 103 | name, CString, 104 | no_object, CBool, 105 | commit, FunPtr (Ptr WLR_surface -> IO ()), 106 | unmap, FunPtr (Ptr WLR_surface -> IO ()), 107 | destroy, FunPtr (Ptr WLR_surface -> IO()) 108 | }} 109 | -------------------------------------------------------------------------------- /src/WLR/Types/DamageRing.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE PatternSynonyms #-} 2 | module WLR.Types.DamageRing where 3 | 4 | #define WLR_USE_UNSTABLE 5 | #include 6 | 7 | import Foreign.Ptr (Ptr, plusPtr) 8 | import Foreign (Storable(..), Int32, peekArray, pokeArray) 9 | import Foreign.C.Types (CInt(..), CBool(..), CSize) 10 | 11 | import WLR.Util.Box (WLR_box) 12 | import PIXMAN.Pixman (PIXMAN_region32) 13 | 14 | -- | For triple buffering, a history of two frames is required. 15 | pattern WLR_DAMAGE_RING_PREVIOUS_LEN :: (Eq a, Num a) => a 16 | pattern WLR_DAMAGE_RING_PREVIOUS_LEN = 2 17 | 18 | -- | current - Difference between the current buffer and the previous one 19 | -- | previous and previous_idx are private state 20 | {{ struct wlr/types/wlr_damage_ring.h, 21 | wlr_damage_ring, 22 | width, Int32, 23 | height, Int32, 24 | current, PIXMAN_region32, 25 | previous, [WLR_DAMAGE_RING_PREVIOUS_LEN] PIXMAN_region32, 26 | previous_idx, CSize 27 | }} 28 | 29 | foreign import capi "wlr/types/wlr_damage_ring.h wlr_damage_ring_init" 30 | wlr_damage_ring_init :: Ptr WLR_damage_ring -> IO () 31 | 32 | foreign import capi "wlr/types/wlr_damage_ring.h wlr_damage_ring_finish" 33 | wlr_damage_ring_finish :: Ptr WLR_damage_ring -> IO () 34 | 35 | {- | 36 | - ring -> width -> height -> void 37 | - Set ring bounds and damage the ring fully. 38 | - 39 | - Next time damage will be added, it will be cropped to the ring bounds. 40 | - If at least one of the dimensions is 0, bounds are removed. 41 | - 42 | - By default, a damage ring doesn't have bounds. 43 | -} 44 | foreign import capi "wlr/types/wlr_damage_ring.h wlr_damage_ring_set_bounds" 45 | wlr_damage_ring_set_bounds :: Ptr WLR_damage_ring -> Int32 -> Int32 -> IO () 46 | 47 | {- | 48 | - Add a region to the current damage. 49 | - 50 | - Returns true if the region intersects the ring bounds, false otherwise. 51 | -} 52 | foreign import capi "wlr/types/wlr_damage_ring.h wlr_damage_ring_add" 53 | wlr_damage_ring_add :: Ptr WLR_damage_ring -> Ptr PIXMAN_region32 -> IO (CBool) 54 | 55 | {- | 56 | - Add a box to the current damage. 57 | - 58 | - Returns true if the box intersects the ring bounds, false otherwise. 59 | -} 60 | foreign import capi "wlr/types/wlr_damage_ring.h wlr_damage_ring_add_box" 61 | wlr_damage_ring_add_box :: Ptr WLR_damage_ring -> Ptr WLR_box -> IO (CBool) 62 | 63 | {- 64 | - Damage the ring fully. 65 | -} 66 | foreign import capi "wlr/types/wlr_damage_ring.h wlr_damage_ring_add_whole" 67 | wlr_damage_ring_add_whole :: Ptr WLR_damage_ring -> IO () 68 | 69 | {- 70 | - Rotate the damage ring. This needs to be called after using the accumulated 71 | - damage, e.g. after rendering to an output's back buffer. 72 | -} 73 | foreign import capi "wlr/types/wlr_damage_ring.h wlr_damage_ring_rotate" 74 | wlr_damage_ring_rotate :: Ptr WLR_damage_ring -> IO () 75 | 76 | {- 77 | - Get accumulated damage, which is the difference between the current buffer 78 | - and the buffer with age of buffer_age; in context of rendering, this is 79 | - the region that needs to be redrawn. 80 | -} 81 | foreign import capi "wlr/types/wlr_damage_ring.h wlr_damage_ring_get_buffer_damage" 82 | wlr_damage_ring_get_buffer_damage :: Ptr WLR_damage_ring -> CInt -> Ptr PIXMAN_region32 -> IO () 83 | -------------------------------------------------------------------------------- /src/WLR/Types/DataDevice.hs-boot: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDecls #-} 2 | module WLR.Types.DataDevice ( 3 | WLR_drag 4 | , WLR_data_source 5 | ) where 6 | 7 | data WLR_drag 8 | data WLR_data_source 9 | -------------------------------------------------------------------------------- /src/WLR/Types/DataDevice.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDeriving #-} 2 | {-# LANGUAGE PatternSynonyms #-} 3 | module WLR.Types.DataDevice where 4 | 5 | #define WLR_USE_UNSTABLE 6 | #include 7 | 8 | import Foreign (Word32, Int32) 9 | import Foreign.Ptr (Ptr) 10 | import Foreign.C.Types (CUInt, CBool, CInt) 11 | import Foreign.Storable (Storable(..)) 12 | 13 | import WL.Utils (WL_array) 14 | import WL.ServerProtocol (WL_data_device_manager_dnd_action) 15 | import WL.ServerCore (WL_signal, WL_listener) 16 | 17 | import WLR.Types.Compositor (WLR_surface) 18 | 19 | import WLR.Types.Seat ( 20 | WLR_seat_keyboard_grab 21 | , WLR_seat_pointer_grab 22 | , WLR_seat_touch_grab 23 | , WLR_seat_client 24 | , WLR_seat 25 | ) 26 | 27 | {{ struct 28 | wlr/types/wlr_data_device.h, 29 | wlr_drag_icon, 30 | drag, Ptr WLR_drag, 31 | surface, Ptr WLR_surface, 32 | events destroy, WL_signal, 33 | surface_destroy, WL_listener, 34 | data, Ptr (), 35 | }} 36 | 37 | {{ struct wlr/types/wlr_data_device.h, wlr_data_source_impl }} 38 | 39 | {{ struct 40 | wlr/types/wlr_data_device.h, 41 | wlr_data_source, 42 | impl, Ptr WLR_data_source_impl, 43 | mime_types, WL_array, 44 | actions, Word32, 45 | accepted, CBool, 46 | current_dnd_action, WL_data_device_manager_dnd_action, 47 | compositor_action, Word32, 48 | events destroy, WL_signal 49 | }} 50 | 51 | {{ enum 52 | WLR_drag_grab_type, 53 | WLR_DRAG_GRAB_KEYBOARD, 54 | WLR_DRAG_GRAB_KEYBOARD_POINTER, 55 | WLR_DRAG_GRAB_KEYBOARD_TOUCH 56 | }} 57 | 58 | {{ struct 59 | wlr/types/wlr_data_device.h, 60 | wlr_drag, 61 | grab_type, WLR_drag_grab_type, 62 | keyboard_grab, WLR_seat_keyboard_grab, 63 | pointer_grab, WLR_seat_pointer_grab, 64 | touch_grab, WLR_seat_touch_grab, 65 | seat, Ptr WLR_seat, 66 | seat_client, Ptr WLR_seat_client, 67 | focus_client, Ptr WLR_seat_client, 68 | icon, Ptr WLR_drag_icon, 69 | focus, Ptr WLR_surface, 70 | source, Ptr WLR_data_source, 71 | started, CBool, 72 | dropped, CBool, 73 | cancelling, CBool, 74 | grab_touch_id, Int32, 75 | touch_id, CUInt, 76 | events focus, WL_signal, 77 | events motion, WL_signal, 78 | events drop, WL_signal, 79 | events destroy, WL_signal, 80 | source_destroy, WL_listener, 81 | seat_client_destroy, WL_listener, 82 | icon_destroy, WL_listener, 83 | data, Ptr () 84 | }} 85 | -------------------------------------------------------------------------------- /src/WLR/Types/InputDevice.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDeriving #-} 2 | {-# LANGUAGE PatternSynonyms #-} 3 | 4 | module WLR.Types.InputDevice where 5 | 6 | #define WLR_USE_UNSTABLE 7 | #include 8 | 9 | import Foreign 10 | import Foreign.C.Types 11 | 12 | import WL.ServerCore 13 | 14 | {{ enum 15 | WLR_input_device_type, 16 | WLR_INPUT_DEVICE_KEYBOARD, 17 | WLR_INPUT_DEVICE_POINTER, 18 | WLR_INPUT_DEVICE_TOUCH, 19 | WLR_INPUT_DEVICE_TABLET_TOOL, 20 | WLR_INPUT_DEVICE_TABLET_PAD, 21 | WLR_INPUT_DEVICE_SWITCH 22 | }} 23 | 24 | {{ struct 25 | wlr/types/wlr_input_device.h, 26 | wlr_input_device, 27 | type, WLR_input_device_type, 28 | vendor, CUInt, 29 | product, CUInt, 30 | name, CChar, 31 | events destroy, WL_signal, 32 | data, Ptr () 33 | }} 34 | -------------------------------------------------------------------------------- /src/WLR/Types/Keyboard.hs-boot: -------------------------------------------------------------------------------- 1 | -- there is an import cycle in the C: wlr_keyboard <-> wlr_keyboard_group 2 | -- so I either needed to move all of the keyboard group definitions into the 3 | -- Keyboard.hsc file (yuck), or declare an hs-boot file for Keyboard and 4 | -- use the SOURCE pragma when keyboard group imports it 5 | -- I chose the latter, because other work arounds would be less similar to the C source 6 | module WLR.Types.Keyboard where 7 | data WLR_keyboard 8 | -------------------------------------------------------------------------------- /src/WLR/Types/Keyboard.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDeriving, PatternSynonyms #-} 2 | 3 | module WLR.Types.Keyboard where 4 | 5 | #define WLR_USE_UNSTABLE 6 | #include 7 | 8 | import Foreign (Storable(..), Word32, peekArray, pokeArray, plusPtr) 9 | import Foreign.C.Types (CSize(..), CInt(..), CBool(..), CUInt) 10 | import Foreign.C.String (CString) 11 | import Foreign.Ptr (Ptr) 12 | 13 | import WLR.Types.InputDevice (WLR_input_device) 14 | import WLR.Types.KeyboardGroup (WLR_keyboard_group) 15 | 16 | import WL.ServerCore (WL_signal) 17 | import WL.Keyboard (WL_keyboard_key_state) 18 | 19 | pattern WLR_LED_COUNT :: (Eq a, Num a) => a 20 | pattern WLR_LED_COUNT = #const WLR_LED_COUNT 21 | 22 | type WLR_keyboard_led = CInt 23 | -- enum wlr_keyboard_led 24 | --WLR_LED_NUM_LOCK = 1 << 0, 25 | pattern WLR_LED_NUM_LOCK :: (Eq a, Num a) => a 26 | pattern WLR_LED_NUM_LOCK = 1 27 | --WLR_LED_CAPS_LOCK = 1 << 1, 28 | pattern WLR_LED_CAPS_LOCK :: (Eq a, Num a) => a 29 | pattern WLR_LED_CAPS_LOCK = 2 30 | --WLR_LED_SCROLL_LOCK = 1 << 2, 31 | pattern WLR_LED_SCROLL_LOCK :: (Eq a, Num a) => a 32 | pattern WLR_LED_SCROLL_LOCK = 4 33 | 34 | pattern WLR_MODIFIER_COUNT :: (Eq a, Num a) => a 35 | pattern WLR_MODIFIER_COUNT = 8 36 | 37 | type WLR_keyboard_modifier = CInt 38 | -- enum wlr_keyboard_modifier { 39 | -- WLR_MODIFIER_SHIFT = 1 << 0, 40 | pattern WLR_MODIFIER_SHIFT :: (Eq a, Num a) => a 41 | pattern WLR_MODIFIER_SHIFT = 1 42 | -- WLR_MODIFIER_CAPS = 1 << 1, 43 | pattern WLR_MODIFIER_CAPS :: (Eq a, Num a) => a 44 | pattern WLR_MODIFIER_CAPS = 2 45 | -- WLR_MODIFIER_CTRL = 1 << 2, 46 | pattern WLR_MODIFIER_CTRL :: (Eq a, Num a) => a 47 | pattern WLR_MODIFIER_CTRL = 4 48 | -- WLR_MODIFIER_ALT = 1 << 3, 49 | pattern WLR_MODIFIER_ALT :: (Eq a, Num a) => a 50 | pattern WLR_MODIFIER_ALT = 8 51 | -- WLR_MODIFIER_MOD2 = 1 << 4, 52 | pattern WLR_MODIFIER_MOD2 :: (Eq a, Num a) => a 53 | pattern WLR_MODIFIER_MOD2 = 16 54 | -- WLR_MODIFIER_MOD3 = 1 << 5, 55 | pattern WLR_MODIFIER_MOD3 :: (Eq a, Num a) => a 56 | pattern WLR_MODIFIER_MOD3 = 32 57 | -- WLR_MODIFIER_LOGO = 1 << 6, 58 | pattern WLR_MODIFIER_LOGO :: (Eq a, Num a) => a 59 | pattern WLR_MODIFIER_LOGO = 64 60 | -- WLR_MODIFIER_MOD5 = 1 << 7, 61 | pattern WLR_MODIFIER_MOD5 :: (Eq a, Num a) => a 62 | pattern WLR_MODIFIER_MOD5 = 128 63 | 64 | pattern WLR_KEYBOARD_KEYS_CAP :: (Eq a, Num a) => a 65 | pattern WLR_KEYBOARD_KEYS_CAP = 32 66 | 67 | data {-# CTYPE "wlr/types/wlr_keyboard.h" "struct wlr_keyboard impl" #-} WLR_keyboard_impl 68 | deriving (Show) 69 | 70 | -- xkbd_mod_mask_t is a type alias for uint32_t 71 | 72 | {{ struct 73 | wlr/types/wlr_keyboard.h, 74 | wlr_keyboard_modifiers, 75 | depressed, CUInt, 76 | latched, CUInt, 77 | locked, CUInt, 78 | group, CUInt 79 | }} 80 | 81 | -- cannot import these types from libxcommon because of their fields which have 82 | -- internal types that aren't exported 83 | data XKB_keymap 84 | data XKB_state 85 | 86 | {{ struct 87 | wlr/types/wlr_keyboard.h, 88 | wlr_keyboard, 89 | base, Ptr WLR_input_device, 90 | impl, Ptr WLR_keyboard_impl, 91 | group , Ptr WLR_keyboard_group, 92 | keymap_string, CString, 93 | keymap_size, CSize, 94 | keymap_fd, CInt, 95 | keymap, Ptr XKB_keymap, 96 | xkb_state, Ptr XKB_state, 97 | led_indexes, [(#const WLR_LED_COUNT)]Word32, 98 | mod_indexes, [(#const WLR_MODIFIER_COUNT)]Word32, 99 | leds, CInt, 100 | keycodes, [(#const WLR_KEYBOARD_KEYS_CAP)]Word32, 101 | num_keycodes, CSize, 102 | modifiers, WLR_keyboard_modifiers, 103 | repeat_info rate, CUInt, 104 | repeat_info delay, CUInt, 105 | events key, WL_signal, 106 | events modifiers, WL_signal, 107 | events keymap, WL_signal, 108 | events repeat_info, WL_signal, 109 | data, Ptr () 110 | }} 111 | 112 | {{ struct 113 | wlr/types/wlr_keyboard.h, 114 | wlr_keyboard_key_event, 115 | time_msec, CUInt, 116 | keycode, CUInt, 117 | update_state, CBool, 118 | state, WL_keyboard_key_state 119 | }} 120 | 121 | {- 122 | - Get a struct wlr_keyboard from a struct wlr_input_device. 123 | - 124 | - Asserts that the input device is a keyboard. 125 | -} 126 | foreign import capi "wlr/types/wlr_keyboard.h wlr_keyboard_from_input_device" 127 | wlr_keyboard_from_input_device :: Ptr WLR_input_device -> IO (Ptr WLR_keyboard) 128 | 129 | foreign import capi "wlr/types/wlr_keyboard.h wlr_keyboard_set_keymap" 130 | wlr_keyboard_set_keymap :: Ptr WLR_keyboard -> Ptr XKB_keymap -> CBool 131 | 132 | foreign import capi "wlr/types/wlr_keyboard.h wlr_keyboard_keymaps_match" 133 | wlr_keyboard_keymaps_match :: Ptr XKB_keymap -> Ptr XKB_keymap -> CBool 134 | 135 | {- 136 | - Set the keyboard repeat info. 137 | - 138 | - rate is in key repeats/second and delay is in milliseconds. 139 | - 140 | - keyboard -> rate -> delay 141 | -} 142 | foreign import capi "wlr/types/wlr_keyboard.h wlr_keyboard_set_repeat_info" 143 | wlr_keyboard_set_repeat_info :: Ptr WLR_keyboard -> CInt -> CInt -> IO () 144 | 145 | {- 146 | - Update the LEDs on the device, if any. 147 | - 148 | - leds is a bitmask of enum wlr_keyboard_led. 149 | - 150 | - If the device doesn't have the provided LEDs, this function is a no-op. 151 | -} 152 | 153 | foreign import capi "wlr/types/wlr_keyboard.h wlr_keyboard_led_update" 154 | wlr_keyboard_led_update :: Ptr WLR_keyboard -> CInt -> IO () 155 | 156 | {- 157 | - Get the set of currently depressed or latched modifiers. 158 | - 159 | - A bitmask of enum wlr_keyboard_modifier is returned. 160 | -} 161 | foreign import capi "wlr/types/wlr_keyboard.h wlr_keyboard_get_modifiers" 162 | wlr_keyboard_get_modifiers :: Ptr WLR_keyboard -> IO (WLR_keyboard_modifier) 163 | -------------------------------------------------------------------------------- /src/WLR/Types/KeyboardGroup.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDeriving, PatternSynonyms #-} 2 | 3 | module WLR.Types.KeyboardGroup where 4 | 5 | #define WLR_USE_UNSTABLE 6 | #include 7 | 8 | import Foreign.Ptr (Ptr) 9 | import Foreign.Storable (Storable(..)) 10 | 11 | import WL.Utils (WL_list) 12 | import WL.ServerCore (WL_signal) 13 | import {-# SOURCE #-} WLR.Types.Keyboard (WLR_keyboard) 14 | 15 | -- devices :: WL_list keyboard_group_device.link 16 | -- keys :: WL_list keyboard_group_key.link 17 | 18 | -- events enter 19 | {- 20 | - Sent when a keyboard has entered the group with keys currently 21 | - pressed that are not pressed by any other keyboard in the group. The 22 | - data for this signal will be a struct wl_array containing the key 23 | - codes. This should be used to update the compositor's internal state. 24 | - Bindings should not be triggered based off of these key codes and 25 | - they should also not notify any surfaces of the key press. 26 | -} 27 | 28 | -- events leave 29 | {- 30 | - Sent when a keyboard has left the group with keys currently pressed 31 | - that are not pressed by any other keyboard in the group. The data for 32 | - this signal will be a struct wl_array containing the key codes. This 33 | - should be used to update the compositor's internal state. Bindings 34 | - should not be triggered based off of these key codes. Additionally, 35 | - surfaces should only be notified if they received a corresponding key 36 | - press for the key code. 37 | -} 38 | {{ struct 39 | wlr/types/wlr_keyboard_group.h, 40 | wlr_keyboard_group, 41 | keyboard, Ptr WLR_keyboard, 42 | devices, WL_list, 43 | keys, WL_list, 44 | events enter, WL_signal, 45 | events leave, WL_signal, 46 | data, Ptr () 47 | }} 48 | 49 | foreign import capi "wlr/types/wlr_keyboard_group.h wlr_keyboard_group_create" 50 | wlr_keyboard_group_create :: IO (Ptr WLR_keyboard_group) 51 | 52 | foreign import capi "wlr/types/wlr_keyboard_group.h wlr_keyboard_group_from_wlr_keyboard" 53 | wlr_keyboard_group_from_wlr_keyboard :: Ptr WLR_keyboard -> Ptr WLR_keyboard_group 54 | 55 | foreign import capi "wlr/types/wlr_keyboard_group.h wlr_keyboard_group_add_keyboard" 56 | wlr_keyboard_group_add_keyboard :: Ptr WLR_keyboard_group -> Ptr WLR_keyboard -> IO (Bool) 57 | 58 | foreign import capi "wlr/types/wlr_keyboard_group.h wlr_keyboard_group_remove_keyboard" 59 | wlr_keyboard_group_remove_keyboard :: Ptr WLR_keyboard_group -> Ptr WLR_keyboard -> IO () 60 | 61 | foreign import capi "wlr/types/wlr_keyboard_group.h wlr_keyboard_group_destroy" 62 | wlr_keyboard_group_destroy :: Ptr WLR_keyboard_group -> IO () 63 | -------------------------------------------------------------------------------- /src/WLR/Types/Output.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDeriving, PatternSynonyms #-} 2 | 3 | module WLR.Types.Output where 4 | 5 | #define WLR_USE_UNSTABLE 6 | #include 7 | 8 | import Foreign 9 | import Foreign.C.Types 10 | 11 | import PIXMAN.Pixman 12 | import WL.ServerCore 13 | import WL.ServerProtocol 14 | import WL.Utils 15 | import WLR.Backend 16 | import WLR.Render.Allocator 17 | import WLR.Render.DrmFormatSet 18 | import WLR.Render.Interface 19 | import WLR.Render.Renderer 20 | import WLR.Render.Swapchain 21 | import WLR.Render.Texture 22 | import WLR.Types.Buffer 23 | import WLR.Types.OutputLayer 24 | import WLR.Util.Addon 25 | import WLR.Util.Box 26 | 27 | -- A struct from . I think this should only be handled by 28 | -- standard library code. 29 | {{ struct time.h, timespec }} 30 | 31 | {{ enum 32 | WLR_output_mode_aspect_ratio, 33 | WLR_OUTPUT_MODE_ASPECT_RATIO_NONE, 34 | WLR_OUTPUT_MODE_ASPECT_RATIO_4_3, 35 | WLR_OUTPUT_MODE_ASPECT_RATIO_16_9, 36 | WLR_OUTPUT_MODE_ASPECT_RATIO_64_27, 37 | WLR_OUTPUT_MODE_ASPECT_RATIO_256_135 38 | }} 39 | 40 | {{ struct 41 | wlr/types/wlr_output.h, 42 | wlr_output_mode, 43 | width, Int32, 44 | height, Int32, 45 | refresh, Int32, 46 | preferred, CBool, 47 | picture_aspect_ratio, WLR_output_mode_aspect_ratio, 48 | link, WL_list 49 | }} 50 | 51 | {{ struct 52 | wlr/types/wlr_output.h, 53 | wlr_output_cursor, 54 | output, Ptr WLR_output, 55 | x, CDouble, 56 | y, CDouble, 57 | enabled, CBool, 58 | visible, CBool, 59 | width, Word32, 60 | height, Word32, 61 | src_box, WLR_fbox, 62 | transform, WL_output_transform, 63 | hotspot_x, Int32, 64 | hotspot_y, Int32, 65 | texture, Ptr WLR_texture, 66 | own_texture, CBool, 67 | link, WL_list 68 | }} 69 | 70 | {{ enum 71 | WLR_output_adaptive_sync_status, 72 | WLR_OUTPUT_ADAPTIVE_SYNC_DISABLED, 73 | WLR_OUTPUT_ADAPTIVE_SYNC_ENABLED 74 | }} 75 | 76 | {{ enum 77 | WLR_output_state_field, 78 | WLR_OUTPUT_STATE_BUFFER, 79 | WLR_OUTPUT_STATE_DAMAGE, 80 | WLR_OUTPUT_STATE_MODE, 81 | WLR_OUTPUT_STATE_ENABLED, 82 | WLR_OUTPUT_STATE_SCALE, 83 | WLR_OUTPUT_STATE_TRANSFORM, 84 | WLR_OUTPUT_STATE_ADAPTIVE_SYNC_ENABLED, 85 | WLR_OUTPUT_STATE_GAMMA_LUT, 86 | WLR_OUTPUT_STATE_RENDER_FORMAT, 87 | WLR_OUTPUT_STATE_SUBPIXEL, 88 | WLR_OUTPUT_STATE_LAYERS 89 | }} 90 | 91 | {{ enum 92 | WLR_output_state_mode_type, 93 | WLR_OUTPUT_STATE_MODE_FIXED, 94 | WLR_OUTPUT_STATE_MODE_CUSTOM 95 | }} 96 | 97 | {{ struct 98 | wlr/types/wlr_output.h, 99 | wlr_output_state, 100 | committed, Word32, 101 | allow_reconfiguration, CBool, 102 | damage, PIXMAN_region32_t, 103 | enabled, CBool, 104 | scale, CFloat, 105 | transform, WL_output_transform, 106 | adaptive_sync_enabled, CBool, 107 | render_format, Word32, 108 | subpixel, WL_output_subpixel, 109 | buffer, Ptr WLR_buffer, 110 | tearing_page_flip, CBool, 111 | mode_type, WLR_output_state_mode_type, 112 | mode, Ptr WLR_output_mode, 113 | custom_mode width, Int32, 114 | custom_mode height, Int32, 115 | custom_mode refresh, Int32, 116 | gamma_lut, Ptr Word16, 117 | gamma_lut_size, CSize, 118 | layers, Ptr WLR_output_layer_state, 119 | layers_len, CSize 120 | }} 121 | 122 | {{ struct 123 | wlr/types/wlr_output.h, 124 | wlr_output_impl 125 | }} 126 | 127 | {{ struct 128 | wlr/types/wlr_output.h, 129 | wlr_render_pass 130 | }} 131 | 132 | {{ struct 133 | wlr/types/wlr_output.h, 134 | wlr_output, 135 | impl, Ptr WLR_output_impl, 136 | backend, Ptr WLR_backend, 137 | display, Ptr WL_display, 138 | global, Ptr WL_global, 139 | resources, WL_list, 140 | name, Ptr CChar, 141 | description, Ptr CChar, 142 | make, Ptr CChar, 143 | model, Ptr CChar, 144 | serial, Ptr CChar, 145 | phys_width, Int32, 146 | phys_height, Int32, 147 | modes, WL_list, 148 | current_mode, Ptr WLR_output_mode, 149 | width, Int32, 150 | height, Int32, 151 | refresh, Int32, 152 | enabled, CBool, 153 | scale, CFloat, 154 | subpixel, WL_output_subpixel, 155 | transform, WL_output_transform, 156 | adaptive_sync_status, WLR_output_adaptive_sync_status, 157 | render_format, Word32, 158 | needs_frame, CBool, 159 | frame_pending, CBool, 160 | transform_matrix, [9]CFloat, 161 | non_desktop, CBool, 162 | pending, WLR_output_state, 163 | commit_seq, Word32, 164 | events frame, WL_signal, 165 | events damage, WL_signal, 166 | events needs_frame, WL_signal, 167 | events precommit, WL_signal, 168 | events commit, WL_signal, 169 | events present, WL_signal, 170 | events bind, WL_signal, 171 | events description, WL_signal, 172 | events request_state, WL_signal, 173 | events destroy, WL_signal, 174 | idle_frame, Ptr WL_event_source, 175 | idle_done, Ptr WL_event_source, 176 | attach_render_locks, CInt, 177 | cursors, WL_list, 178 | hardware_cursor, Ptr WLR_output_cursor, 179 | cursor_swapchain, Ptr WLR_swapchain, 180 | cursor_front_buffer, Ptr WLR_buffer, 181 | software_cursor_locks, CInt, 182 | layers, WL_list, 183 | allocator, Ptr WLR_allocator, 184 | renderer, Ptr WLR_renderer, 185 | swapchain, Ptr WLR_swapchain, 186 | back_buffer, Ptr WLR_buffer, 187 | display_destroy, WL_listener, 188 | addons, WLR_addon_set, 189 | data, Ptr () 190 | }} 191 | 192 | {{ struct 193 | wlr/types/wlr_output.h, 194 | wlr_output_event_damage, 195 | output, Ptr WLR_output, 196 | damage, Ptr PIXMAN_region32_t 197 | }} 198 | 199 | 200 | {{ struct 201 | wlr/types/wlr_output.h, 202 | wlr_output_event_precommit, 203 | output, Ptr WLR_output, 204 | when, Ptr TIMESPEC, 205 | state, Ptr WLR_output_state 206 | }} 207 | 208 | {{ struct 209 | wlr/types/wlr_output.h, 210 | wlr_output_event_commit, 211 | output, Ptr WLR_output, 212 | when, Ptr TIMESPEC, 213 | state, Ptr WLR_output_state, 214 | }} 215 | 216 | {{ enum 217 | WLR_output_present_flag, 218 | WLR_OUTPUT_PRESENT_VSYNC, 219 | WLR_OUTPUT_PRESENT_HW_CLOCK, 220 | WLR_OUTPUT_PRESENT_HW_COMPLETION, 221 | WLR_OUTPUT_PRESENT_ZERO_COPY 222 | }} 223 | 224 | {{ struct 225 | wlr/types/wlr_output.h, 226 | wlr_output_event_present, 227 | output, Ptr WLR_output, 228 | commit_seq, Word32, 229 | presented, CBool, 230 | when, Ptr TIMESPEC, 231 | seq, CUInt, 232 | refresh, CInt, 233 | flags, Word32 234 | }} 235 | 236 | {{ struct 237 | wlr/types/wlr_output.h, 238 | wlr_output_event_bind, 239 | output, Ptr WLR_output, 240 | resource, Ptr WL_resource 241 | }} 242 | 243 | {{ struct 244 | wlr/types/wlr_output.h, 245 | wlr_output_event_request_state, 246 | output, Ptr WLR_output, 247 | state, Ptr WLR_output_state 248 | }} 249 | 250 | foreign import capi "wlr/types/wlr_output.h wlr_output_enable" 251 | wlr_output_enable :: Ptr WLR_output -> CBool -> IO () 252 | 253 | foreign import capi "wlr/types/wlr_output.h wlr_output_create_global" 254 | wlr_output_create_global :: Ptr WLR_output -> IO () 255 | 256 | foreign import capi "wlr/types/wlr_output.h wlr_output_destroy_global" 257 | wlr_output_destroy_global :: Ptr WLR_output -> IO () 258 | 259 | foreign import capi "wlr/types/wlr_output.h wlr_output_init_render" 260 | wlr_output_init_render :: Ptr WLR_output -> Ptr WLR_allocator -> Ptr WLR_renderer -> IO (CBool) 261 | 262 | foreign import capi "wlr/types/wlr_output.h wlr_output_preferred_mode" 263 | wlr_output_preferred_mode :: Ptr WLR_output -> IO (Ptr WLR_output_mode) 264 | 265 | foreign import capi "wlr/types/wlr_output.h wlr_output_set_mode" 266 | wlr_output_set_mode :: Ptr WLR_output -> Ptr WLR_output_mode -> IO () 267 | 268 | foreign import capi "wlr/types/wlr_output.h wlr_output_set_custom_mode" 269 | wlr_output_set_custom_mode :: Ptr WLR_output -> Int32 -> Int32 -> Int32 -> IO () 270 | 271 | foreign import capi "wlr/types/wlr_output.h wlr_output_set_transform" 272 | wlr_output_set_transform :: Ptr WLR_output -> WL_output_transform -> IO () 273 | 274 | foreign import capi "wlr/types/wlr_output.h wlr_output_enable_adaptive_sync" 275 | wlr_output_enable_adaptive_sync :: Ptr WLR_output -> CBool -> IO () 276 | 277 | foreign import capi "wlr/types/wlr_output.h wlr_output_set_render_format" 278 | wlr_output_set_render_format :: Ptr WLR_output -> Word32 -> IO () 279 | 280 | foreign import capi "wlr/types/wlr_output.h wlr_output_set_scale" 281 | wlr_output_set_scale :: Ptr WLR_output -> CFloat -> IO () 282 | 283 | foreign import capi "wlr/types/wlr_output.h wlr_output_set_subpixel" 284 | wlr_output_set_subpixel :: Ptr WLR_output -> WL_output_subpixel -> IO () 285 | 286 | foreign import capi "wlr/types/wlr_output.h wlr_output_set_name" 287 | wlr_output_set_name :: Ptr WLR_output -> Ptr CChar -> IO () 288 | 289 | foreign import capi "wlr/types/wlr_output.h wlr_output_set_description" 290 | wlr_output_set_description :: Ptr WLR_output -> Ptr CChar -> IO () 291 | 292 | foreign import capi "wlr/types/wlr_output.h wlr_output_schedule_done" 293 | wlr_output_schedule_done :: Ptr WLR_output -> IO () 294 | 295 | foreign import capi "wlr/types/wlr_output.h wlr_output_destroy" 296 | wlr_output_destroy :: Ptr WLR_output -> IO () 297 | 298 | foreign import capi "wlr/types/wlr_output.h wlr_output_transformed_resolution" 299 | wlr_output_transformed_resolution :: Ptr WLR_output -> Ptr CInt -> Ptr CInt -> IO () 300 | 301 | foreign import capi "wlr/types/wlr_output.h wlr_output_effective_resolution" 302 | wlr_output_effective_resolution :: Ptr WLR_output -> Ptr CInt -> Ptr CInt -> IO () 303 | 304 | foreign import capi "wlr/types/wlr_output.h wlr_output_attach_render" 305 | wlr_output_attach_render :: Ptr WLR_output -> Ptr CInt -> IO (CBool) 306 | 307 | foreign import capi "wlr/types/wlr_output.h wlr_output_attach_buffer" 308 | wlr_output_attach_buffer :: Ptr WLR_output -> Ptr WLR_buffer -> IO () 309 | 310 | foreign import capi "wlr/types/wlr_output.h wlr_output_preferred_read_format" 311 | wlr_output_preferred_read_format :: Ptr WLR_output -> IO (Word32) 312 | 313 | foreign import capi "wlr/types/wlr_output.h wlr_output_set_damage" 314 | wlr_output_set_damage :: Ptr WLR_output -> Ptr PIXMAN_region32_t -> IO () 315 | 316 | foreign import capi "wlr/types/wlr_output.h wlr_output_set_layers" 317 | wlr_output_set_layers :: Ptr WLR_output -> Ptr WLR_output_layer_state -> CSize -> IO () 318 | 319 | foreign import capi "wlr/types/wlr_output.h wlr_output_test" 320 | wlr_output_test :: Ptr WLR_output -> IO (CBool) 321 | 322 | foreign import capi "wlr/types/wlr_output.h wlr_output_commit" 323 | wlr_output_commit :: Ptr WLR_output -> IO (CBool) 324 | 325 | foreign import capi "wlr/types/wlr_output.h wlr_output_rollback" 326 | wlr_output_rollback :: Ptr WLR_output -> IO () 327 | 328 | foreign import capi "wlr/types/wlr_output.h wlr_output_test_state" 329 | wlr_output_test_state :: Ptr WLR_output -> Ptr WLR_output_state -> IO (CBool) 330 | 331 | foreign import capi "wlr/types/wlr_output.h wlr_output_commit_state" 332 | wlr_output_commit_state :: Ptr WLR_output -> Ptr WLR_output_state -> IO (CBool) 333 | 334 | foreign import capi "wlr/types/wlr_output.h wlr_output_schedule_frame" 335 | wlr_output_schedule_frame :: Ptr WLR_output -> IO () 336 | 337 | foreign import capi "wlr/types/wlr_output.h wlr_output_get_gamma_size" 338 | wlr_output_get_gamma_size :: Ptr WLR_output -> IO (CSize) 339 | 340 | foreign import capi "wlr/types/wlr_output.h wlr_output_set_gamma" 341 | wlr_output_set_gamma :: Ptr WLR_output -> CSize -> Ptr Word16 -> Ptr Word16 -> Ptr Word16 -> IO () 342 | 343 | foreign import capi "wlr/types/wlr_output.h wlr_output_from_resource" 344 | wlr_output_from_resource :: Ptr WL_resource -> IO (Ptr WLR_output) 345 | 346 | foreign import capi "wlr/types/wlr_output.h wlr_output_lock_attach_render" 347 | wlr_output_lock_attach_render :: Ptr WLR_output -> CBool -> IO () 348 | 349 | foreign import capi "wlr/types/wlr_output.h wlr_output_lock_software_cursors" 350 | wlr_output_lock_software_cursors :: Ptr WLR_output -> CBool -> IO () 351 | 352 | foreign import capi "wlr/types/wlr_output.h wlr_output_render_software_cursors" 353 | wlr_output_render_software_cursors :: Ptr WLR_output -> Ptr PIXMAN_region32_t -> IO () 354 | 355 | foreign import capi "wlr/types/wlr_output.h wlr_output_add_software_cursors_to_render_pass" 356 | wlr_output_add_software_cursors_to_render_pass :: Ptr WLR_output -> Ptr WLR_render_pass -> Ptr PIXMAN_region32_t -> IO () 357 | 358 | foreign import capi "wlr/types/wlr_output.h wlr_output_get_primary_formats" 359 | wlr_output_get_primary_formats :: Ptr WLR_output -> Word32 -> IO (Ptr WLR_drm_format_set) 360 | 361 | foreign import capi "wlr/types/wlr_output.h wlr_output_is_direct_scanout_allowed" 362 | wlr_output_is_direct_scanout_allowed :: Ptr WLR_output -> IO (CBool) 363 | 364 | foreign import capi "wlr/types/wlr_output.h wlr_output_cursor_create" 365 | wlr_output_cursor_create :: Ptr WLR_output -> IO (Ptr WLR_output_cursor) 366 | 367 | foreign import capi "wlr/types/wlr_output.h wlr_output_cursor_set_buffer" 368 | wlr_output_cursor_set_buffer :: Ptr WLR_output_cursor -> Ptr WLR_buffer -> Int32-> Int32 -> IO (CBool) 369 | 370 | foreign import capi "wlr/types/wlr_output.h wlr_output_cursor_move" 371 | wlr_output_cursor_move :: Ptr WLR_output_cursor -> CDouble -> CDouble -> IO (CBool) 372 | 373 | foreign import capi "wlr/types/wlr_output.h wlr_output_cursor_destroy" 374 | wlr_output_cursor_destroy :: Ptr WLR_output_cursor -> IO () 375 | 376 | foreign import capi "wlr/types/wlr_output.h wlr_output_state_init" 377 | wlr_output_state_init :: Ptr WLR_output_state -> IO () 378 | 379 | foreign import capi "wlr/types/wlr_output.h wlr_output_state_finish" 380 | wlr_output_state_finish :: Ptr WLR_output_state -> IO () 381 | 382 | foreign import capi "wlr/types/wlr_output.h wlr_output_state_set_enabled" 383 | wlr_output_state_set_enabled :: Ptr WLR_output_state -> CBool -> IO () 384 | 385 | foreign import capi "wlr/types/wlr_output.h wlr_output_state_set_mode" 386 | wlr_output_state_set_mode :: Ptr WLR_output_state -> Ptr WLR_output_mode -> IO () 387 | 388 | foreign import capi "wlr/types/wlr_output.h wlr_output_state_set_custom_mode" 389 | wlr_output_state_set_custom_mode :: Ptr WLR_output_state -> Int32 -> Int32 -> Int32 -> IO () 390 | 391 | foreign import capi "wlr/types/wlr_output.h wlr_output_state_set_scale" 392 | wlr_output_state_set_scale :: Ptr WLR_output_state -> CFloat -> IO () 393 | 394 | foreign import capi "wlr/types/wlr_output.h wlr_output_state_set_transform" 395 | wlr_output_state_set_transform :: Ptr WLR_output_state -> WL_output_transform -> IO () 396 | 397 | foreign import capi "wlr/types/wlr_output.h wlr_output_state_set_adaptive_sync_enabled" 398 | wlr_output_state_set_adaptive_sync_enabled :: Ptr WLR_output_state -> CBool -> IO () 399 | 400 | foreign import capi "wlr/types/wlr_output.h wlr_output_state_set_render_format" 401 | wlr_output_state_set_render_format :: Ptr WLR_output_state -> Word32 -> IO () 402 | 403 | foreign import capi "wlr/types/wlr_output.h wlr_output_state_set_subpixel" 404 | wlr_output_state_set_subpixel :: Ptr WLR_output_state -> WL_output_subpixel -> IO () 405 | 406 | foreign import capi "wlr/types/wlr_output.h wlr_output_state_set_buffer" 407 | wlr_output_state_set_buffer :: Ptr WLR_output_state -> Ptr WLR_buffer -> IO () 408 | 409 | foreign import capi "wlr/types/wlr_output.h wlr_output_state_set_gamma_lut" 410 | wlr_output_state_set_gamma_lut :: Ptr WLR_output_state -> CSize -> Ptr Word16 -> Ptr Word16 -> Ptr Word16 -> IO (CBool) 411 | 412 | foreign import capi "wlr/types/wlr_output.h wlr_output_state_set_damage" 413 | wlr_output_state_set_damage :: Ptr WLR_output_state -> Ptr PIXMAN_region32_t -> IO () 414 | 415 | foreign import capi "wlr/types/wlr_output.h wlr_output_state_set_layers" 416 | wlr_output_state_set_layers :: Ptr WLR_output_state -> Ptr WLR_output_layer_state -> CSize -> IO () 417 | 418 | foreign import capi "wlr/types/wlr_output.h wlr_output_state_copy" 419 | wlr_output_state_copy :: Ptr WLR_output_state -> Ptr WLR_output_state -> IO (CBool) 420 | 421 | foreign import capi "wlr/types/wlr_output.h wlr_output_configure_primary_swapchain" 422 | wlr_output_configure_primary_swapchain :: Ptr WLR_output -> Ptr WLR_output_state -> Ptr (Ptr WLR_swapchain) -> IO (CBool) 423 | 424 | foreign import capi "wlr/types/wlr_output.h wlr_output_begin_render_pass" 425 | wlr_output_begin_render_pass :: Ptr WLR_output -> Ptr WLR_output_state -> Ptr CInt -> Ptr WLR_render_timer -> IO (Ptr WLR_render_pass) 426 | 427 | foreign import capi "wlr/types/wlr_output.h wlr_output_transform_invert" 428 | wlr_output_transform_invert :: WL_output_transform -> IO (WL_output_transform) 429 | 430 | foreign import capi "wlr/types/wlr_output.h wlr_output_transform_compose" 431 | wlr_output_transform_compose :: WL_output_transform -> WL_output_transform -> IO (WL_output_transform) 432 | -------------------------------------------------------------------------------- /src/WLR/Types/OutputLayer.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDeriving #-} 2 | 3 | module WLR.Types.OutputLayer where 4 | 5 | #define WLR_USE_UNSTABLE 6 | #include 7 | 8 | import Foreign 9 | import Foreign.C.Types 10 | 11 | import PIXMAN.Pixman 12 | import WL.ServerCore 13 | import WL.Utils 14 | import WLR.Types.Buffer 15 | import WLR.Util.Addon 16 | import WLR.Util.Box 17 | 18 | {{ struct 19 | wlr/types/wlr_output_layer.h, 20 | wlr_output_layer, 21 | link, WL_list, 22 | addons, WLR_addon_set, 23 | events feedback, WL_signal, 24 | data, Ptr (), 25 | src_box, WLR_fbox, 26 | dst_box, WLR_box 27 | }} 28 | 29 | {{ struct 30 | wlr/types/wlr_output_layer.h, 31 | wlr_output_layer_state, 32 | layer, Ptr WLR_output_layer, 33 | buffer, Ptr WLR_buffer, 34 | src_box, WLR_fbox, 35 | dst_box, WLR_box, 36 | damage, Ptr PIXMAN_region32_t, 37 | accepted, CBool 38 | }} 39 | -------------------------------------------------------------------------------- /src/WLR/Types/Pointer.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDeriving, PatternSynonyms #-} 2 | 3 | module WLR.Types.Pointer where 4 | 5 | #define WLR_USE_UNSTABLE 6 | #include 7 | 8 | import Foreign (Word32) 9 | import Foreign.C.Types (CDouble, CInt, CBool) 10 | import Foreign.C.String (CString) 11 | import Foreign.Ptr (Ptr) 12 | import Foreign.Storable (Storable(..)) 13 | 14 | import WLR.Types.InputDevice (WLR_input_device) 15 | import WL.ServerCore (WL_signal) 16 | 17 | {{ struct wlr/types/wlr_pointer.h, wlr_pointer_impl }} 18 | 19 | {{ struct 20 | wlr/types/wlr_pointer.h, 21 | wlr_pointer, 22 | base, WLR_input_device, 23 | impl, Ptr WLR_pointer_impl, 24 | output_name, CString, 25 | events motion, WL_signal, 26 | events motion_absolute, WL_signal, 27 | events button, WL_signal, 28 | events axis, WL_signal, 29 | events frame, WL_signal, 30 | events swipe_begin, WL_signal, 31 | events swipe_update, WL_signal, 32 | events swipe_end, WL_signal, 33 | events pinch_begin, WL_signal, 34 | events pinch_update, WL_signal, 35 | events pinch_end, WL_signal, 36 | events hold_begin, WL_signal, 37 | events hold_end, WL_signal 38 | }} 39 | 40 | {{ struct 41 | wlr/types/wlr_pointer.h, 42 | wlr_pointer_motion_event, 43 | pointer, Ptr WLR_pointer, 44 | time_msec, Word32, 45 | delta_x, CDouble, 46 | delta_y, CDouble, 47 | unaccel_dx, CDouble, 48 | unaccel_dy, CDouble 49 | }} 50 | 51 | {{ struct 52 | wlr/types/wlr_pointer.h, 53 | wlr_pointer_motion_absolute_event, 54 | pointer, Ptr WLR_pointer, 55 | time_msec, Word32, 56 | x, CDouble, 57 | y, CDouble, 58 | }} 59 | 60 | {{ struct 61 | wlr/types/wlr_pointer.h, 62 | wlr_pointer_button_event, 63 | pointer, Ptr WLR_pointer, 64 | time_msec, Word32, 65 | button, Word32, 66 | state, WLR_button_state_type 67 | }} 68 | 69 | {{ enum 70 | WLR_button_state_type, 71 | WLR_BUTTON_RELEASED, 72 | WLR_BUTTON_PRESSED 73 | }} 74 | 75 | {{ enum 76 | WLR_axis_source_type, 77 | WLR_AXIS_SOURCE_WHEEL, 78 | WLR_AXIS_SOURCE_FINGER, 79 | WLR_AXIS_SOURCE_CONTINUOUS, 80 | WLR_AXIS_SOURCE_WHEEL_TILT 81 | }} 82 | 83 | {{ enum 84 | WLR_axis_orientation_type, 85 | WLR_AXIS_ORIENTATION_VERTICAL, 86 | WLR_AXIS_ORIENTATION_HORIZONTAL 87 | }} 88 | 89 | pattern WLR_POINTER_AXIS_DISCRETE_STEP :: (Eq a, Num a) => a 90 | pattern WLR_POINTER_AXIS_DISCRETE_STEP = #const WLR_POINTER_AXIS_DISCRETE_STEP 91 | 92 | {{ struct 93 | wlr/types/wlr_pointer.h, 94 | wlr_pointer_axis_event, 95 | pointer, Ptr WLR_pointer, 96 | time_msec, Word32, 97 | source, WLR_axis_source_type, 98 | orientation, WLR_axis_orientation_type, 99 | delta, CDouble, 100 | delta_discrete, Word32 101 | }} 102 | 103 | {{ struct 104 | wlr/types/wlr_pointer.h, 105 | wlr_pointer_swipe_begin_event, 106 | pointer, Ptr WLR_pointer, 107 | time_msec, Word32, 108 | fingers, Word32 109 | }} 110 | 111 | {{ struct 112 | wlr/types/wlr_pointer.h, 113 | wlr_pointer_swipe_update_event, 114 | pointer, Ptr WLR_pointer, 115 | time_msec, Word32, 116 | fingers, Word32, 117 | dx, CDouble, 118 | dy, CDouble 119 | }} 120 | 121 | {{ struct 122 | wlr/types/wlr_pointer.h, 123 | wlr_pointer_swipe_end_event, 124 | pointer, Ptr WLR_pointer, 125 | time_msec, Word32, 126 | cancelled, CBool 127 | }} 128 | 129 | {{ struct 130 | wlr/types/wlr_pointer.h, 131 | wlr_pointer_pinch_begin_event, 132 | pointer, Ptr WLR_pointer, 133 | time_msec, Word32, 134 | fingers, Word32 135 | }} 136 | 137 | {{ struct 138 | wlr/types/wlr_pointer.h, 139 | wlr_pointer_pinch_update_event, 140 | pointer, Ptr WLR_pointer, 141 | time_msec, Word32, 142 | fingers, Word32, 143 | dx, CDouble, 144 | dy, CDouble, 145 | scale, CDouble, 146 | rotation, CDouble 147 | }} 148 | 149 | {{ struct 150 | wlr/types/wlr_pointer.h, 151 | wlr_pointer_pinch_end_event, 152 | pointer, Ptr WLR_pointer, 153 | time_msec, Word32, 154 | cancelled, CBool 155 | }} 156 | 157 | {{ struct 158 | wlr/types/wlr_pointer.h, 159 | wlr_pointer_hold_begin_event, 160 | pointer, Ptr WLR_pointer, 161 | time_msec, Word32, 162 | fingers, Word32 163 | }} 164 | 165 | {{ struct 166 | wlr/types/wlr_pointer.h, 167 | wlr_pointer_hold_end_event, 168 | pointer, Ptr WLR_pointer, 169 | time_msec, Word32, 170 | cancelled, CBool 171 | }} 172 | 173 | foreign import capi "wlr/types/wlr_pointer.h wlr_pointer_from_input_device" 174 | wlr_pointer_from_input_device :: Ptr WLR_input_device -> IO (Ptr WLR_pointer) 175 | -------------------------------------------------------------------------------- /src/WLR/Types/PrimarySelection.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDeriving #-} 2 | 3 | module WLR.Types.PrimarySelection where 4 | 5 | #define WLR_USE_UNSTABLE 6 | #include 7 | 8 | import Foreign.Ptr (Ptr) 9 | import Foreign.Storable (Storable(..)) 10 | 11 | import WL.Utils (WL_array) 12 | import WL.ServerCore (WL_signal) 13 | 14 | {{ struct wlr/types/wlr_primary_selection.h, wlr_primary_selection_source_impl }} 15 | 16 | {{ struct 17 | wlr/types/wlr_primary_selection.h, 18 | wlr_primary_selection_source, 19 | impl, Ptr WLR_primary_selection_source_impl, 20 | mime_types, WL_array, 21 | events destroy, WL_signal, 22 | data, Ptr () 23 | }} 24 | -------------------------------------------------------------------------------- /src/WLR/Types/Seat.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE PatternSynonyms #-} 2 | module WLR.Types.Seat where 3 | 4 | 5 | #define WLR_USE_UNSTABLE 6 | #include 7 | #include 8 | 9 | import Foreign.C.String (CString) 10 | import Foreign.C.Types (CDouble(..), CInt(..), CBool, CSize, CBool(..)) 11 | -- if we upgrade our base libraries we can use this 12 | -- https://github.com/haskell/core-libraries-committee/issues/118 13 | -- import Foreign.C.ConstPtr 14 | import Foreign.Ptr (Ptr, FunPtr) 15 | import Foreign (peekArray, pokeArray, plusPtr, Word32, Int32) 16 | import Foreign.Storable (Storable(..)) 17 | 18 | import WL.ServerProtocol (WL_display) 19 | import WL.ServerCore (WL_signal, WL_listener) 20 | import WL.Global (WL_global) 21 | import WL.Client (WL_client) 22 | import WL.Utils (WL_list) 23 | 24 | import Time.Time (TIMESPEC) 25 | import {-# SOURCE #-} WLR.Types.DataDevice ( 26 | WLR_drag 27 | , WLR_data_source 28 | ) 29 | import WLR.Types.PrimarySelection (WLR_primary_selection_source) 30 | import WLR.Types.Compositor (WLR_surface) 31 | import WLR.Types.Pointer ( 32 | WLR_axis_source_type 33 | , WLR_button_state_type 34 | , WLR_axis_orientation_type 35 | ) 36 | import WLR.Types.Keyboard (WLR_keyboard, WLR_keyboard_modifiers) 37 | 38 | {{ struct 39 | wlr/types/wlr_seat.h, 40 | wlr_serial_range, 41 | min_incl, Word32, 42 | max_incl, Word32 43 | }} 44 | 45 | pattern WLR_SERIAL_RINGSET_SIZE :: (Eq a, Num a) => a 46 | pattern WLR_SERIAL_RINGSET_SIZE = 128 47 | 48 | {{ struct 49 | wlr/types/wlr_seat.h, 50 | wlr_serial_ringset, 51 | data, [WLR_SERIAL_RINGSET_SIZE] WLR_serial_range, 52 | end, CInt, 53 | count, CInt 54 | }} 55 | 56 | {{ struct 57 | wlr/types/wlr_seat.h, 58 | wlr_seat_client, 59 | client, Ptr WL_client, 60 | seat, Ptr WLR_seat, 61 | link, WL_list, 62 | resources, WL_list, 63 | pointers, WL_list, 64 | keyboards, WL_list, 65 | touches, WL_list, 66 | data_devices, WL_list, 67 | events destroy, WL_signal, 68 | serials, WLR_serial_ringset, 69 | needs_touch_frame, CBool, 70 | value120 acc_discrete, [2] Int32, 71 | value120 last_discrete, [2] Int32, 72 | value120 acc_axis, [2] CDouble, 73 | }} 74 | 75 | {{ struct 76 | wlr/types/seat.h, 77 | wlr_pointer_grab_interface, 78 | enter, FunPtr (Ptr WLR_seat_pointer_grab -> Ptr WLR_surface -> CDouble -> CDouble -> IO ()), 79 | clear_focus, FunPtr (Ptr WLR_seat_pointer_grab -> IO ()), 80 | motion, FunPtr (Ptr WLR_seat_pointer_grab -> Word32 -> CDouble -> CDouble -> ()), 81 | button, FunPtr (Ptr WLR_seat_pointer_grab -> Word32 -> Word32 -> WLR_button_state_type -> IO (Word32)), 82 | axis, FunPtr (Ptr WLR_seat_pointer_grab -> Word32 -> WLR_axis_orientation_type -> CDouble -> Int32 -> WLR_axis_source_type -> IO ()), 83 | frame, FunPtr (Ptr WLR_seat_pointer_grab -> IO ()), 84 | cancel, FunPtr (Ptr WLR_seat_pointer_grab -> IO ()) 85 | }} 86 | 87 | {{ struct 88 | wlr/types/wlr_seat.h, 89 | wlr_seat_pointer_grab, 90 | interface, Ptr WLR_pointer_grab_interface, 91 | seat, Ptr WLR_seat, 92 | data, Ptr () 93 | }} 94 | 95 | pattern WLR_POINTER_BUTTONS_CAP :: (Eq a, Num a) => a 96 | pattern WLR_POINTER_BUTTONS_CAP = 16 97 | 98 | {{ struct 99 | wlr/types/wlr_seat.h, 100 | wlr_seat_pointer_state, 101 | seat, Ptr WLR_seat, 102 | focused_client, Ptr WLR_seat_client, 103 | focused_surface, Ptr WLR_surface, 104 | sx, CDouble, 105 | sy, CDouble, 106 | grab, Ptr WLR_seat_pointer_grab, 107 | default_grab, Ptr WLR_seat_pointer_grab, 108 | sent_axis_source, CBool, 109 | cached_axis_source, WLR_axis_source_type, 110 | buttons, [WLR_POINTER_BUTTONS_CAP] Word32, 111 | button_count, CSize, 112 | grab_button, Word32, 113 | grab_serial, Word32, 114 | grab_time, Word32, 115 | surface_destroy, WL_listener, 116 | events focus_change, WL_signal, 117 | }} 118 | 119 | {{ struct 120 | wlr/types/wlr_seat.h, 121 | wlr_seat_keyboard_state, 122 | seat, Ptr WLR_seat, 123 | keyboard, Ptr WLR_keyboard, 124 | focused_client, Ptr WLR_seat_client, 125 | focused_surface, Ptr WLR_surface, 126 | keyboard_destroy, WL_listener, 127 | keyboard_keymap, WL_listener, 128 | keyboard_repeat_info, WL_listener, 129 | surface_destroy, WL_listener, 130 | grab, Ptr WLR_seat_keyboard_grab, 131 | default_grab, Ptr WLR_seat_keyboard_grab, 132 | events focus_change, WL_signal, 133 | }} 134 | 135 | {{ struct 136 | wlr/types/wlr_seat.h, 137 | wlr_seat_touch_state, 138 | seat, Ptr WLR_seat, 139 | touch_points, WL_list, 140 | grab_serial, Word32, 141 | grab_id, Word32, 142 | grab, Ptr WLR_seat_touch_grab, 143 | default_grab, Ptr WLR_seat_touch_grab, 144 | }} 145 | 146 | {{ struct 147 | wlr/types/wlr_seat.h, 148 | wlr_seat, 149 | global, Ptr WL_global, 150 | display, Ptr WL_display, 151 | clients, Ptr WL_list, 152 | name, CString, 153 | capabilities, Word32, 154 | accumulated_capabilities, Word32, 155 | last_event, TIMESPEC, 156 | selection_source, Ptr WLR_data_source, 157 | selection_serial, Word32, 158 | selection_offers, WL_list, 159 | primary_selection_source, Ptr WLR_primary_selection_source, 160 | primary_selection_serial, Word32, 161 | drag, Ptr WLR_drag, 162 | drag_source, Ptr WLR_data_source, 163 | drag_serial, Word32, 164 | drag_offers, WL_list, 165 | pointer_state, WLR_seat_pointer_state, 166 | keyboard_state, WLR_seat_keyboard_state, 167 | touch_state, WLR_seat_touch_state, 168 | display_destroy, WL_listener, 169 | selection_source_destroy, WL_listener, 170 | primary_selection_source_destroy, WL_listener, 171 | drag_source_destroy, WL_listener, 172 | events pointer_grab_begin, WL_signal, 173 | events pointer_grab_end, WL_signal, 174 | events keyboard_grab_begin, WL_signal, 175 | events keyboard_grab_end, WL_signal, 176 | events touch_grab_begin, WL_signal, 177 | events touch_grab_end, WL_signal, 178 | events request_set_cursor, WL_signal, 179 | events request_set_selection, WL_signal, 180 | events set_selection, WL_signal, 181 | events request_set_primary_selection, WL_signal, 182 | events set_primary_selection, WL_signal, 183 | events request_start_drag, WL_signal, 184 | events start_drag, WL_signal, 185 | events destroy, WL_signal, 186 | data, Ptr () 187 | }} 188 | 189 | {{ struct 190 | wlr/types/seat.h, 191 | wlr_touch_point, 192 | touch_id, Int32, 193 | surface, Ptr WLR_surface, 194 | client, Ptr WLR_seat_client, 195 | focus_surface, Ptr WLR_surface, 196 | focus_client, Ptr WLR_seat_client, 197 | sx, CDouble, 198 | sy, CDouble, 199 | surface_destroy, WL_listener, 200 | focus_surface_destroy, WL_listener, 201 | client_destroy, WL_listener, 202 | events destroy, WL_signal, 203 | link, WL_list 204 | }} 205 | 206 | -- TODO interface was a ConstPtr 207 | -- it looks there is a type for this starting in base 4.18.0.0 208 | -- https://hackage.haskell.org/package/base-4.19.0.0/docs/Foreign-C-ConstPtr.html 209 | 210 | {{ struct 211 | wlr/types/wlr_seat.h, 212 | wlr_seat_keyboard_grab, 213 | interface, Ptr WLR_keyboard_grab_interface, 214 | seat, Ptr WLR_seat, 215 | data, Ptr () 216 | }} 217 | 218 | {{ struct 219 | wlr/types/wlr_seat.h, 220 | wlr_keyboard_grab_interface, 221 | enter, FunPtr (Ptr WLR_seat_keyboard_grab -> Ptr WLR_surface -> [] Word32 -> IO ()), 222 | clear_focus, FunPtr (Ptr WLR_seat_keyboard_grab -> IO ()), 223 | key, FunPtr (Ptr WLR_seat_keyboard_grab -> Word32 -> Word32 -> Word32 -> IO ()), 224 | modifiers, FunPtr (Ptr WLR_seat_keyboard_grab -> Ptr WLR_keyboard_modifiers -> IO ()), 225 | cancel, FunPtr (Ptr WLR_seat_keyboard_grab -> IO ()) 226 | }} 227 | 228 | {{ struct 229 | wlr/types/wlr_seat.h, 230 | wlr_touch_grab_interface, 231 | down, FunPtr (Ptr WLR_seat_touch_grab -> Word32 -> Ptr WLR_touch_point -> IO (Word32)), 232 | up, FunPtr (Ptr WLR_seat_touch_grab -> Word32 -> Ptr WLR_touch_point -> IO ()), 233 | motion, FunPtr (Ptr WLR_seat_touch_grab -> Word32 -> Ptr WLR_touch_point -> IO ()), 234 | enter, FunPtr (Ptr WLR_seat_touch_grab -> Word32 -> Ptr WLR_touch_point -> IO ()), 235 | frame, FunPtr (Ptr WLR_seat_touch_grab -> IO ()), 236 | cancel, FunPtr (Ptr WLR_seat_touch_grab -> IO()), 237 | wl_cancel, FunPtr (Ptr WLR_seat_touch_grab -> Ptr WLR_surface -> IO ()) 238 | }} 239 | 240 | {{ struct 241 | wlr/types/seat.h, 242 | wlr_seat_touch_grab, 243 | interface, Ptr WLR_touch_grab_interface, 244 | seat, Ptr WLR_seat, 245 | data, Ptr () 246 | }} 247 | 248 | {{ struct 249 | wlr/types/seat.h, 250 | wlr_seat_pointer_request_set_cursor_event, 251 | seat_client, Ptr WLR_seat_client, 252 | surface, Ptr WLR_surface, 253 | serial, Word32, 254 | hotspot_x, Int32, 255 | hotspot_y, Int32 256 | }} 257 | 258 | {{ struct 259 | wlr/types/seat.h, 260 | wlr_seat_request_set_selection_event, 261 | source, Ptr WLR_data_source, 262 | serial, Word32 263 | }} 264 | 265 | {{ struct wlr/types/seat.h, 266 | wlr_seat_request_set_primary_selection_event, 267 | source, Ptr WLR_primary_selection_source, 268 | serial, Word32 269 | }} 270 | 271 | {{ struct wlr/types/seat.h, 272 | wlr_seat_request_start_drag_event, 273 | drag, Ptr WLR_drag, 274 | origin, Ptr WLR_surface, 275 | serial, Word32 276 | }} 277 | 278 | {{ struct wlr/types/seat.h, 279 | wlr_seat_pointer_focus_change_event, 280 | seat, Ptr WLR_seat, 281 | old_surface, Ptr WLR_surface, 282 | new_surface, Ptr WLR_surface, 283 | sx, CDouble, 284 | sy, CDouble 285 | }} 286 | {{ struct wlr/types/seat.h, 287 | wlr_seat_keyboard_focus_change_event, 288 | seat, Ptr WLR_seat, 289 | old_surface, Ptr WLR_surface, 290 | new_surface, Ptr WLR_surface, 291 | }} 292 | 293 | {- 294 | - Allocates a new struct wlr_seat and adds a wl_seat global to the display. 295 | -} 296 | foreign import capi "wlr/types/wlr_seat.h wlr_seat_create" 297 | wlr_seat_create :: Ptr WL_display -> CString -> IO (Ptr WLR_seat) 298 | 299 | {- 300 | - Destroys a seat, removes its wl_seat global and clears focus for all 301 | - devices belonging to the seat. 302 | -} 303 | foreign import capi "wlr/types/wlr_seat.h wlr_seat_destroy" 304 | wlr_seat_destroy :: Ptr WLR_seat -> IO () 305 | 306 | {- 307 | - Gets a struct wlr_seat_client for the specified client, or returns NULL if no 308 | - client is bound for that client. 309 | -} 310 | foreign import capi "wlr/types/wlr_seat.h wlr_seat_client_for_wl_client" 311 | wlr_seat_client_for_wl_client :: Ptr WLR_seat -> Ptr WL_client -> IO (Ptr WLR_seat_client) 312 | 313 | {- 314 | - Updates the capabilities available on this seat. 315 | - Will automatically send them to all clients. 316 | -} 317 | foreign import capi "wlr/types/wlr_seat.h wlr_seat_set_capabilities" 318 | wlr_seat_set_capabilities :: Ptr WLR_seat -> Word32 -> IO () 319 | 320 | --wlr_seat_set_name 321 | {- 322 | - Updates the name of this seat. 323 | - Will automatically send it to all clients. 324 | -} 325 | foreign import capi "wlr/types/wlr_seat.h wlr_seat_set_name" 326 | wlr_seat_set_name :: Ptr WLR_seat -> CString -> IO () 327 | 328 | {- 329 | - Whether or not the surface has pointer focus 330 | -} 331 | foreign import capi "wlr/types/wlr_seat.h wlr_seat_pointer_surface_has_focus" 332 | wlr_seat_pointer_surface_has_focus :: Ptr WLR_seat -> Ptr WLR_surface -> IO CBool 333 | 334 | {- 335 | - Send a pointer enter event to the given surface and consider it to be the 336 | - focused surface for the pointer. This will send a leave event to the last 337 | - surface that was entered. Coordinates for the enter event are surface-local. 338 | - This function does not respect pointer grabs: you probably want 339 | - wlr_seat_pointer_notify_enter() instead. 340 | -} 341 | foreign import capi "wlr/types/wlr_seat.h wlr_seat_pointer_enter" 342 | wlr_seat_pointer_enter :: Ptr WLR_seat -> Ptr WLR_surface -> CDouble -> CDouble -> IO () 343 | 344 | {- 345 | - Clear the focused surface for the pointer and leave all entered surfaces. 346 | - This function does not respect pointer grabs: you probably want 347 | - wlr_seat_pointer_notify_clear_focus() instead. 348 | -} 349 | foreign import capi "wlr/types/wlr_seat.h wlr_seat_pointer_clear_focus" 350 | wlr_seat_pointer_clear_focus :: Ptr WLR_seat -> IO () 351 | 352 | {- 353 | - Send a motion event to the surface with pointer focus. Coordinates for the 354 | - motion event are surface-local. This function does not respect pointer grabs: 355 | - you probably want wlr_seat_pointer_notify_motion() instead. 356 | -} 357 | foreign import capi "wlr/types/wlr_seat.h wlr_seat_pointer_send_motion" 358 | wlr_seat_pointer_send_motion :: Ptr WLR_seat -> Word32 -> CDouble -> CDouble -> IO () 359 | 360 | {- 361 | - Send a button event to the surface with pointer focus. Coordinates for the 362 | - button event are surface-local. Returns the serial. This function does not 363 | - respect pointer grabs: you probably want wlr_seat_pointer_notify_button() 364 | - instead. 365 | -} 366 | foreign import capi "wlr/types/wlr_seat.h wlr_seat_pointer_send_button" 367 | wlr_seat_pointer_send_button :: Ptr WLR_seat -> Word32 -> Word32 -> WLR_button_state_type -> IO Word32 368 | 369 | {- 370 | - Send an axis event to the surface with pointer focus. This function does not 371 | - respect pointer grabs: you probably want wlr_seat_pointer_notify_axis() 372 | - instead. 373 | -} 374 | foreign import capi "wlr/types/wlr_seat.h wlr_seat_pointer_send_axis" 375 | wlr_seat_pointer_send_axis :: Ptr WLR_seat -> Word32 -> WLR_axis_orientation_type -> CDouble -> Int32 -> WLR_axis_source_type -> IO () 376 | 377 | {- 378 | - Send a frame event to the surface with pointer focus. This function does not 379 | - respect pointer grabs: you probably want wlr_seat_pointer_notify_frame() 380 | - instead. 381 | -} 382 | foreign import capi "wlr/types/wlr_seat.h wlr_seat_pointer_send_frame" 383 | wlr_seat_pointer_send_frame :: Ptr WLR_seat -> IO () 384 | 385 | {- 386 | - Notify the seat of a pointer enter event to the given surface and request it 387 | - to be the focused surface for the pointer. Pass surface-local coordinates 388 | - where the enter occurred. This will send a leave event to the currently- 389 | - focused surface. Defers to any grab of the pointer. 390 | -} 391 | foreign import capi "wlr/types/wlr_seat.h wlr_seat_pointer_notify_enter" 392 | wlr_seat_pointer_notify_enter :: Ptr WLR_seat -> Ptr WLR_surface -> CDouble -> CDouble -> IO () 393 | 394 | {- 395 | - Notify the seat of a pointer leave event to the currently-focused surface. 396 | - Defers to any grab of the pointer. 397 | -} 398 | foreign import capi "wlr/types/wlr_seat.h wlr_seat_pointer_notify_clear_focus" 399 | wlr_seat_pointer_notify_clear_focus :: Ptr WLR_seat -> IO () 400 | 401 | {- 402 | - Warp the pointer of this seat to the given surface-local coordinates, without 403 | - generating motion events. 404 | -} 405 | foreign import capi "wlr/types/wlr_seat.h wlr_seat_pointer_warp" 406 | wlr_seat_pointer_warp :: Ptr WLR_seat -> CDouble -> CDouble -> IO () 407 | 408 | {- 409 | - Notify the seat of motion over the given surface. Pass surface-local 410 | - coordinates where the pointer motion occurred. Defers to any grab of the 411 | - pointer. 412 | -} 413 | foreign import capi "wlr/types/wlr_seat.h wlr_seat_pointer_notify_motion" 414 | wlr_seat_pointer_notify_motion :: Ptr WLR_seat -> Word32 -> CDouble -> CDouble -> IO () 415 | 416 | {- 417 | - Notify the seat that a button has been pressed. Returns the serial of the 418 | - button press or zero if no button press was sent. Defers to any grab of the 419 | - pointer. 420 | -} 421 | foreign import capi "wlr/types/wlr_seat.h wlr_seat_pointer_notify_button" 422 | wlr_seat_pointer_notify_button :: Ptr WLR_seat -> Word32 -> Word32 -> WLR_button_state_type -> IO Word32 423 | -------------------------------------------------------------------------------- /src/WLR/Util/Addon.hsc: -------------------------------------------------------------------------------- 1 | module WLR.Util.Addon where 2 | 3 | #define WLR_USE_UNSTABLE 4 | #include 5 | 6 | import Foreign 7 | 8 | import WL.Utils 9 | 10 | {{ struct 11 | wlr/util/wlr_addon.h, 12 | wlr_addon_set, 13 | addons, WL_list 14 | }} 15 | -------------------------------------------------------------------------------- /src/WLR/Util/Box.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDeriving #-} 2 | module WLR.Util.Box where 3 | 4 | #include 5 | 6 | import Foreign 7 | import Foreign.C.Types 8 | 9 | {{ struct 10 | wlr/util/box.h, 11 | wlr_box, 12 | x, CInt, 13 | y, CInt, 14 | width, CInt, 15 | height, CInt 16 | }} 17 | 18 | {{ struct 19 | wlr/util/box.h, 20 | wlr_fbox, 21 | x, CDouble, 22 | y, CDouble, 23 | width, CDouble, 24 | height, CDouble 25 | }} 26 | -------------------------------------------------------------------------------- /src/WLR/Util/Edges.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE PatternSynonyms #-} 2 | 3 | module WLR.Util.Edges where 4 | 5 | #include 6 | 7 | import Foreign.C.Types 8 | 9 | {{ enum 10 | WLR_edges, 11 | WLR_EDGE_NONE, 12 | WLR_EDGE_TOP, 13 | WLR_EDGE_BOTTOM, 14 | WLR_EDGE_LEFT, 15 | WLR_EDGE_RIGHT 16 | }} 17 | -------------------------------------------------------------------------------- /src/WLR/Util/Log.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE PatternSynonyms #-} 2 | 3 | module WLR.Util.Log where 4 | 5 | #include 6 | 7 | import Foreign 8 | import Foreign.C.Types 9 | 10 | type WLR_log_importance = CInt 11 | 12 | pattern WLR_SILENT :: (Eq a, Num a) => a 13 | pattern WLR_SILENT = #const WLR_SILENT 14 | 15 | pattern WLR_ERROR :: (Eq a, Num a) => a 16 | pattern WLR_ERROR = #const WLR_ERROR 17 | 18 | pattern WLR_INFO :: (Eq a, Num a) => a 19 | pattern WLR_INFO = #const WLR_INFO 20 | 21 | pattern WLR_DEBUG :: (Eq a, Num a) => a 22 | pattern WLR_DEBUG = #const WLR_DEBUG 23 | 24 | pattern WLR_LOG_IMPORTANCE_LAST :: (Eq a, Num a) => a 25 | pattern WLR_LOG_IMPORTANCE_LAST = #const WLR_LOG_IMPORTANCE_LAST 26 | 27 | -- | Note: C @wlr_log_func_t@ contains a @va_list@, so it cannot be 28 | -- directly marshalled to Haskell. 29 | type WLR_log_func_t = () 30 | 31 | foreign import capi "wlr/util/log.h wlr_log_init" 32 | wlr_log_init :: WLR_log_importance -> FunPtr WLR_log_func_t -> IO () 33 | -------------------------------------------------------------------------------- /src/WLR/Version.hs: -------------------------------------------------------------------------------- 1 | module WLR.Version where 2 | 3 | import Foreign.C.String 4 | 5 | foreign import capi "wlr/version.h value WLR_VERSION_STR" wlr_version_str :: CString 6 | -------------------------------------------------------------------------------- /wlhs-bindings.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: wlhs-bindings 3 | version: 0.1.0 4 | license: BSD-3-Clause 5 | license-file: LICENSE 6 | maintainer: brad.neimann@hotmail.com 7 | author: Brad Neimann 8 | tested-with: ghc ==9.4.8 9 | synopsis: Bindings to wlroots (and libwayland) 10 | category: Graphics 11 | build-type: Custom 12 | extra-doc-files: CHANGELOG.md 13 | 14 | custom-setup 15 | setup-depends: 16 | base >=4.16.4.0 && <5, 17 | Cabal >=3.10.1.0 && <3.11, 18 | directory >=1.3 && <1.4, 19 | text >=1.2 && <2.2, 20 | 21 | library 22 | exposed-modules: 23 | PIXMAN.Pixman 24 | Time.Time 25 | WL.Keyboard 26 | WL.ServerCore 27 | WL.ServerProtocol 28 | WL.Utils 29 | WL.Global 30 | WL.Version 31 | WL.Client 32 | WLR.Backend 33 | WLR.Types.DataDevice 34 | WLR.Render.Allocator 35 | WLR.Render.DrmFormatSet 36 | WLR.Render.Interface 37 | WLR.Render.Renderer 38 | WLR.Render.Swapchain 39 | WLR.Render.Texture 40 | WLR.Types.Compositor 41 | WLR.Types.DamageRing 42 | WLR.Types.Buffer 43 | WLR.Types.InputDevice 44 | WLR.Types.Keyboard 45 | WLR.Types.KeyboardGroup 46 | WLR.Types.PrimarySelection 47 | WLR.Types.Output 48 | WLR.Types.OutputLayer 49 | WLR.Types.Pointer 50 | WLR.Types.Seat 51 | WLR.Util.Addon 52 | WLR.Util.Box 53 | WLR.Util.Edges 54 | WLR.Util.Log 55 | WLR.Version 56 | 57 | pkgconfig-depends: wlroots ==0.17.1, wayland-server, pixman-1 58 | hs-source-dirs: src 59 | default-language: Haskell2010 60 | default-extensions: CApiFFI 61 | ghc-options: 62 | -Wall -fno-show-valid-hole-fits -optc -Wno-discarded-qualifiers 63 | 64 | build-depends: base >=4.16.4.0 && <5 65 | --------------------------------------------------------------------------------