fake-type (empty) → 0.1.0.0
raw patch · 5 files changed
+215/−0 lines, 5 filesdep +X11dep +basedep +base-preludesetup-changed
Dependencies added: X11, base, base-prelude
Files
- CHANGELOG.md +3/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- fake-type.cabal +34/−0
- lib/FakeType.hs +146/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+# 0.1.0.0++First release. Only Linux support is available so far.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Artyom++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Artyom nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ fake-type.cabal view
@@ -0,0 +1,34 @@+name: fake-type+version: 0.1.0.0+synopsis: A crossplatform library to simulate keyboard input+description: + A crossplatform library to simulate keyboard input (so far it works only on Linux, but I'll add Windows and OS X soon).+license: BSD3+license-file: LICENSE+author: Artyom+maintainer: Artyom <yom@artyom.me>+homepage: http://github.com/aelve/fake-type+bug-reports: http://github.com/aelve/fake-type/issues+-- copyright: +category: System+tested-with: GHC == 7.8.4, GHC == 7.10.3+build-type: Simple+extra-source-files:+ CHANGELOG.md+cabal-version: >=1.10++source-repository head+ type: git+ location: git://github.com/aelve/fake-type.git++library+ exposed-modules: FakeType+ -- other-modules: + -- other-extensions: + build-depends: base >= 4.7 && < 5+ , base-prelude == 0.1.*+ , X11+ extra-libraries: "Xtst"+ ghc-options: -Wall -fno-warn-unused-do-bind+ hs-source-dirs: lib+ default-language: Haskell2010
+ lib/FakeType.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE+ForeignFunctionInterface,+NondecreasingIndentation,+RecordWildCards,+NoImplicitPrelude+ #-}+++module FakeType+(+ sendString,+)+where+++import BasePrelude+import Numeric+import Foreign+import Foreign.C.Types+import Graphics.X11+++foreign import ccall unsafe "HsXlib.h XGetKeyboardMapping"+ xGetKeyboardMapping+ :: Display+ -> KeyCode -- First keycode+ -> CInt -- Amount of keycodes+ -> Ptr CInt -- Keysyms per keycode+ -> IO (Ptr KeySym) -- Keysyms++foreign import ccall unsafe "HsXlib.h XChangeKeyboardMapping"+ xChangeKeyboardMapping+ :: Display+ -> KeyCode -- First keycode+ -> CInt -- Keysyms per keycode+ -> Ptr KeySym -- Array of keysyms+ -> CInt -- Amount of keycodes+ -> IO ()++foreign import ccall unsafe "X11/extensions/XTest.h XTestFakeKeyEvent"+ xFakeKeyEvent :: Display -> KeyCode -> Bool -> CULong -> IO Status++data Mapping = Mapping {+ minKey :: KeyCode,+ keyCount :: CInt,+ symArray :: Ptr KeySym,+ symPerKey :: CInt }++getKeyboardMapping+ :: Display+ -> Maybe (KeyCode, CInt) -- ^ First key + amount of keys,+ -- or 'Nothing' if it's “all”+ -> IO Mapping+getKeyboardMapping display mb = do+ let (minKey, keyCount) = case mb of+ Just x -> x+ Nothing -> let (a, b) = displayKeycodes display+ in (fromIntegral a, b-a+1)+ alloca $ \symPerKey_return -> do+ symArray <- xGetKeyboardMapping+ display+ minKey+ keyCount+ symPerKey_return+ symPerKey <- peek symPerKey_return+ return Mapping{..}++symIndex :: KeyCode -> Int -> Mapping -> Int+symIndex key pos Mapping{..} =+ fromIntegral (key-minKey) * fromIntegral symPerKey + pos++changeKeyboardMapping+ :: Display+ -> Maybe (KeyCode, CInt) -- ^ First key + amount of keys,+ -- or 'Nothing' if it's “all”+ -> Mapping+ -> IO ()+changeKeyboardMapping display mb mapping@Mapping{..} =+ case mb of+ Nothing ->+ xChangeKeyboardMapping+ display+ minKey+ symPerKey+ symArray+ keyCount+ Just (key, amount) ->+ xChangeKeyboardMapping+ display+ key+ symPerKey+ (advancePtr symArray (symIndex key 0 mapping))+ amount++getSymbol+ :: KeyCode -- ^ Key+ -> Int -- ^ Position (usually 0..3)+ -> Mapping+ -> IO KeySym+getSymbol key pos mapping =+ peekElemOff (symArray mapping) (symIndex key pos mapping)++changeSymbol+ :: Display+ -> KeyCode -- ^ Key+ -> Int -- ^ Position (usually 0..3)+ -> KeySym -- ^ Symbol+ -> Mapping+ -> IO ()+changeSymbol display key pos sym mapping = do+ pokeElemOff (symArray mapping) (symIndex key pos mapping) sym+ changeKeyboardMapping display (Just (key, 1)) mapping+ flush display++findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)+findM _ [] = return Nothing+findM p (x:xs) = do+ r <- p x+ if r then return (Just x) else findM p xs++-- Find a key that has an empty default position (so that we'd be able to+-- simulate a keypress without having to use any key modifiers). If there's+-- no empty key, throw an exception.+findFreeKey :: Mapping -> IO KeyCode+findFreeKey mapping@Mapping{..} = do+ let isEmptyKey key = (== noSymbol) <$> getSymbol key 0 mapping+ mbFreeKey <- findM isEmptyKey (take (fromIntegral keyCount) [minKey..])+ case mbFreeKey of+ Nothing -> error "findFreeKey: couldn't find a free key"+ Just k -> return k++sendString :: String -> IO ()+sendString string = do+ display <- openDisplay ":0.0"+ mapping <- getKeyboardMapping display Nothing+ freeKey <- findFreeKey mapping+ sync display False+ forM_ string $ \char -> do+ let sym = stringToKeysym ('U' : showHex (fromEnum char) "")+ changeSymbol display freeKey 0 sym mapping+ xFakeKeyEvent display freeKey True 0+ xFakeKeyEvent display freeKey False 0+ sync display False+ threadDelay 12000+ changeSymbol display freeKey 0 noSymbol mapping+ closeDisplay display