never executed always true always false
    1 {-|
    2 Module: Flaw.Input.Keyboard
    3 Description: Keyboard user input.
    4 License: MIT
    5 -}
    6 
    7 {-# LANGUAGE MultiParamTypeClasses #-}
    8 
    9 module Flaw.Input.Keyboard
   10   ( KeyboardState(..)
   11   , KeyboardEvent(..)
   12   , Key(..)
   13   , getKeyState
   14   ) where
   15 
   16 import Control.Concurrent.STM
   17 import Data.Array.MArray
   18 
   19 import Flaw.Input
   20 
   21 newtype KeyboardState = KeyboardState
   22   { keyboardStateKeys :: TArray Key Bool
   23   }
   24 
   25 data KeyboardEvent
   26   = KeyDownEvent !Key
   27   | KeyUpEvent !Key
   28   | CharEvent !Char
   29   deriving Show
   30 
   31 data Key
   32   = KeyUnknown
   33   | KeyBackSpace
   34   | KeyTab
   35   | KeyLineFeed
   36   | KeyClear
   37   | KeyReturn
   38   | KeyPause
   39   | KeyScrollLock
   40   | KeySysReq
   41   | KeyEscape
   42   | KeyInsert
   43   | KeyDelete
   44   | KeyHome
   45   | KeyLeft
   46   | KeyUp
   47   | KeyRight
   48   | KeyDown
   49   | KeyPageUp
   50   | KeyPageDown
   51   | KeyEnd
   52   | KeyBegin
   53   | KeyNumLock
   54   | KeyPadSpace
   55   | KeyPadTab
   56   | KeyPadEnter
   57   | KeyPadF1
   58   | KeyPadF2
   59   | KeyPadF3
   60   | KeyPadF4
   61   | KeyPadHome
   62   | KeyPadLeft
   63   | KeyPadUp
   64   | KeyPadRight
   65   | KeyPadDown
   66   | KeyPadPageUp
   67   | KeyPadPageDown
   68   | KeyPadEnd
   69   | KeyPadBegin
   70   | KeyPadInsert
   71   | KeyPadDelete
   72   | KeyPadEqual
   73   | KeyPadMultiply
   74   | KeyPadAdd
   75   | KeyPadSeparator
   76   | KeyPadSubtract
   77   | KeyPadDecimal
   78   | KeyPadDivide
   79   | KeyPad0
   80   | KeyPad1
   81   | KeyPad2
   82   | KeyPad3
   83   | KeyPad4
   84   | KeyPad5
   85   | KeyPad6
   86   | KeyPad7
   87   | KeyPad8
   88   | KeyPad9
   89   | KeyF1
   90   | KeyF2
   91   | KeyF3
   92   | KeyF4
   93   | KeyF5
   94   | KeyF6
   95   | KeyF7
   96   | KeyF8
   97   | KeyF9
   98   | KeyF10
   99   | KeyF11
  100   | KeyF12
  101   | KeyShiftL
  102   | KeyShiftR
  103   | KeyControlL
  104   | KeyControlR
  105   | KeyCapsLock
  106   | KeyShiftLock
  107   | KeyMetaL
  108   | KeyMetaR
  109   | KeyAltL
  110   | KeyAltR
  111   | KeySuperL
  112   | KeySuperR
  113   | KeyHyperL
  114   | KeyHyperR
  115   | KeySpace
  116   | Key0
  117   | Key1
  118   | Key2
  119   | Key3
  120   | Key4
  121   | Key5
  122   | Key6
  123   | Key7
  124   | Key8
  125   | Key9
  126   | KeyA
  127   | KeyB
  128   | KeyC
  129   | KeyD
  130   | KeyE
  131   | KeyF
  132   | KeyG
  133   | KeyH
  134   | KeyI
  135   | KeyJ
  136   | KeyK
  137   | KeyL
  138   | KeyM
  139   | KeyN
  140   | KeyO
  141   | KeyP
  142   | KeyQ
  143   | KeyR
  144   | KeyS
  145   | KeyT
  146   | KeyU
  147   | KeyV
  148   | KeyW
  149   | KeyX
  150   | KeyY
  151   | KeyZ
  152   deriving (Eq, Ord, Ix, Bounded, Enum, Show)
  153 
  154 instance InputState KeyboardState where
  155   initialInputState = do
  156     keysArray <- newArray (minBound, maxBound) False
  157     return KeyboardState
  158       { keyboardStateKeys = keysArray
  159       }
  160 
  161 instance InputDevice KeyboardState KeyboardEvent where
  162   applyInputEvent KeyboardState
  163     { keyboardStateKeys = keysArray
  164     } event = case event of
  165     KeyDownEvent key -> writeArray keysArray key True
  166     KeyUpEvent key -> writeArray keysArray key False
  167     CharEvent _ -> return ()
  168 
  169 getKeyState :: KeyboardState -> Key -> STM Bool
  170 getKeyState KeyboardState
  171   { keyboardStateKeys = keysArray
  172   } = readArray keysArray