module Graphics.UI.HaskGame.Keys
(KeyGroup(..),allGroups,groupsOfKey,keysUnicode
,printableGroup,digitsGroup,lettersGroup
,upperCaseGroup,lowerCaseGroup,arrowsGroup
)
where
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Graphics.UI.SDL as SDL
import Graphics.UI.HaskGame.Key
(noMods, shift, ModKey(..), KeyGroup(..)
,singletonKeyGroup)
inGroup :: ModKey -> KeyGroup -> Bool
key `inGroup` group = key `Set.member` (keyGroupKeys group)
groupsOfKey :: ModKey -> [KeyGroup]
groupsOfKey key = singletonKeyGroup key :
filter (key `inGroup`) allGroups
allGroups :: [KeyGroup]
allGroups =
[printableGroup
,digitsGroup
,lettersGroup
,upperCaseGroup
,lowerCaseGroup
,arrowsGroup
]
combineGroups :: String -> [KeyGroup] -> KeyGroup
combineGroups name groups = KeyGroup name (Set.unions . map keyGroupKeys $ groups)
keysSetOfUnicode :: Map.Map ModKey String -> Set.Set ModKey
keysSetOfUnicode = Set.fromList . Map.keys
lettersGroup :: KeyGroup
lettersGroup = combineGroups "Letters" [upperCaseGroup, lowerCaseGroup]
printableGroup :: KeyGroup
printableGroup = KeyGroup "Printable" . keysSetOfUnicode $ keysUnicode
digitsGroup :: KeyGroup
digitsGroup = KeyGroup "Digits" . keysSetOfUnicode $ digitsUnicode
upperCaseGroup :: KeyGroup
upperCaseGroup = KeyGroup "Upper-case letters" . keysSetOfUnicode $ upperCaseUnicode
lowerCaseGroup :: KeyGroup
lowerCaseGroup = KeyGroup "Lower-case letters" . keysSetOfUnicode $ lowerCaseUnicode
arrowsGroup :: KeyGroup
arrowsGroup = KeyGroup "Arrows" $
Set.fromList [ModKey noMods SDL.SDLK_LEFT
,ModKey noMods SDL.SDLK_RIGHT
,ModKey noMods SDL.SDLK_UP
,ModKey noMods SDL.SDLK_DOWN]
lowerCaseUnicode :: Map.Map ModKey String
lowerCaseUnicode = Map.fromList $
[(ModKey noMods SDL.SDLK_a, "a")
,(ModKey noMods SDL.SDLK_b, "b")
,(ModKey noMods SDL.SDLK_c, "c")
,(ModKey noMods SDL.SDLK_d, "d")
,(ModKey noMods SDL.SDLK_e, "e")
,(ModKey noMods SDL.SDLK_f, "f")
,(ModKey noMods SDL.SDLK_g, "g")
,(ModKey noMods SDL.SDLK_h, "h")
,(ModKey noMods SDL.SDLK_i, "i")
,(ModKey noMods SDL.SDLK_j, "j")
,(ModKey noMods SDL.SDLK_k, "k")
,(ModKey noMods SDL.SDLK_l, "l")
,(ModKey noMods SDL.SDLK_m, "m")
,(ModKey noMods SDL.SDLK_n, "n")
,(ModKey noMods SDL.SDLK_o, "o")
,(ModKey noMods SDL.SDLK_p, "p")
,(ModKey noMods SDL.SDLK_q, "q")
,(ModKey noMods SDL.SDLK_r, "r")
,(ModKey noMods SDL.SDLK_s, "s")
,(ModKey noMods SDL.SDLK_t, "t")
,(ModKey noMods SDL.SDLK_u, "u")
,(ModKey noMods SDL.SDLK_v, "v")
,(ModKey noMods SDL.SDLK_w, "w")
,(ModKey noMods SDL.SDLK_x, "x")
,(ModKey noMods SDL.SDLK_y, "y")
,(ModKey noMods SDL.SDLK_z, "z")
]
upperCaseUnicode :: Map.Map ModKey String
upperCaseUnicode = Map.fromList $
[(ModKey shift SDL.SDLK_a, "A")
,(ModKey shift SDL.SDLK_b, "B")
,(ModKey shift SDL.SDLK_c, "C")
,(ModKey shift SDL.SDLK_d, "D")
,(ModKey shift SDL.SDLK_e, "E")
,(ModKey shift SDL.SDLK_f, "F")
,(ModKey shift SDL.SDLK_g, "G")
,(ModKey shift SDL.SDLK_h, "H")
,(ModKey shift SDL.SDLK_i, "I")
,(ModKey shift SDL.SDLK_j, "J")
,(ModKey shift SDL.SDLK_k, "K")
,(ModKey shift SDL.SDLK_l, "L")
,(ModKey shift SDL.SDLK_m, "M")
,(ModKey shift SDL.SDLK_n, "N")
,(ModKey shift SDL.SDLK_o, "O")
,(ModKey shift SDL.SDLK_p, "P")
,(ModKey shift SDL.SDLK_q, "Q")
,(ModKey shift SDL.SDLK_r, "R")
,(ModKey shift SDL.SDLK_s, "S")
,(ModKey shift SDL.SDLK_t, "T")
,(ModKey shift SDL.SDLK_u, "U")
,(ModKey shift SDL.SDLK_v, "V")
,(ModKey shift SDL.SDLK_w, "W")
,(ModKey shift SDL.SDLK_x, "X")
,(ModKey shift SDL.SDLK_y, "Y")
,(ModKey shift SDL.SDLK_z, "Z")
]
digitsUnicode :: Map.Map ModKey String
digitsUnicode = Map.fromList $
[(ModKey noMods SDL.SDLK_0, "0")
,(ModKey noMods SDL.SDLK_1, "1")
,(ModKey noMods SDL.SDLK_2, "2")
,(ModKey noMods SDL.SDLK_3, "3")
,(ModKey noMods SDL.SDLK_4, "4")
,(ModKey noMods SDL.SDLK_5, "5")
,(ModKey noMods SDL.SDLK_6, "6")
,(ModKey noMods SDL.SDLK_7, "7")
,(ModKey noMods SDL.SDLK_8, "8")
,(ModKey noMods SDL.SDLK_9, "9")
,(ModKey shift SDL.SDLK_KP0, "0")
,(ModKey shift SDL.SDLK_KP1, "1")
,(ModKey shift SDL.SDLK_KP2, "2")
,(ModKey shift SDL.SDLK_KP3, "3")
,(ModKey shift SDL.SDLK_KP4, "4")
,(ModKey shift SDL.SDLK_KP5, "5")
,(ModKey shift SDL.SDLK_KP6, "6")
,(ModKey shift SDL.SDLK_KP7, "7")
,(ModKey shift SDL.SDLK_KP8, "8")
,(ModKey shift SDL.SDLK_KP9, "9")
]
keysUnicode :: Map.Map ModKey String
keysUnicode = Map.unions
[lowerCaseUnicode
,upperCaseUnicode
,digitsUnicode,
Map.fromList
[(ModKey noMods SDL.SDLK_SPACE, " ")
,(ModKey noMods SDL.SDLK_EXCLAIM, "!")
,(ModKey noMods SDL.SDLK_QUOTEDBL, "\"")
,(ModKey noMods SDL.SDLK_HASH, "#")
,(ModKey noMods SDL.SDLK_DOLLAR, "$")
,(ModKey noMods SDL.SDLK_AMPERSAND, "&")
,(ModKey noMods SDL.SDLK_QUOTE, "'")
,(ModKey noMods SDL.SDLK_LEFTPAREN, "(")
,(ModKey noMods SDL.SDLK_RIGHTPAREN, ")")
,(ModKey noMods SDL.SDLK_ASTERISK, "*")
,(ModKey noMods SDL.SDLK_PLUS, "+")
,(ModKey noMods SDL.SDLK_COMMA, ",")
,(ModKey noMods SDL.SDLK_MINUS, "-")
,(ModKey noMods SDL.SDLK_PERIOD, ".")
,(ModKey noMods SDL.SDLK_SLASH, "/")
,(ModKey noMods SDL.SDLK_COLON, ":")
,(ModKey noMods SDL.SDLK_SEMICOLON, ";")
,(ModKey noMods SDL.SDLK_LESS, "<")
,(ModKey noMods SDL.SDLK_EQUALS, "=")
,(ModKey noMods SDL.SDLK_GREATER, ">")
,(ModKey noMods SDL.SDLK_QUESTION, "?")
,(ModKey noMods SDL.SDLK_AT, "@")
,(ModKey noMods SDL.SDLK_LEFTBRACKET, "[")
,(ModKey noMods SDL.SDLK_BACKSLASH, "\\")
,(ModKey noMods SDL.SDLK_RIGHTBRACKET, "]")
,(ModKey noMods SDL.SDLK_UNDERSCORE, "_")
,(ModKey noMods SDL.SDLK_BACKQUOTE, "`")
,(ModKey shift SDL.SDLK_QUOTE, "\"")
,(ModKey shift SDL.SDLK_COMMA, "<")
,(ModKey shift SDL.SDLK_MINUS, "_")
,(ModKey shift SDL.SDLK_PERIOD, ">")
,(ModKey shift SDL.SDLK_SLASH, "?")
,(ModKey shift SDL.SDLK_0, ")")
,(ModKey shift SDL.SDLK_1, "!")
,(ModKey shift SDL.SDLK_2, "@")
,(ModKey shift SDL.SDLK_3, "#")
,(ModKey shift SDL.SDLK_4, "$")
,(ModKey shift SDL.SDLK_5, "%")
,(ModKey shift SDL.SDLK_6, "^")
,(ModKey shift SDL.SDLK_7, "&")
,(ModKey shift SDL.SDLK_8, "*")
,(ModKey shift SDL.SDLK_9, "(")
,(ModKey shift SDL.SDLK_SEMICOLON, ":")
,(ModKey shift SDL.SDLK_EQUALS, "+")
,(ModKey shift SDL.SDLK_LEFTBRACKET, "{")
,(ModKey shift SDL.SDLK_BACKSLASH, "|")
,(ModKey shift SDL.SDLK_RIGHTBRACKET, "}")
,(ModKey shift SDL.SDLK_BACKQUOTE, "~")
,(ModKey shift SDL.SDLK_KP_PERIOD, ".")
,(ModKey shift SDL.SDLK_KP_DIVIDE, "/")
,(ModKey shift SDL.SDLK_KP_MULTIPLY, "*")
,(ModKey shift SDL.SDLK_KP_MINUS, "-")
,(ModKey shift SDL.SDLK_KP_PLUS, "+")
,(ModKey shift SDL.SDLK_KP_EQUALS, "=")
]]