{-# OPTIONS_GHC -Wall -O2 #-} 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 printableGroup, digitsGroup, lettersGroup, upperCaseGroup, lowerCaseGroup, arrowsGroup :: KeyGroup lettersGroup = combineGroups "Letters" [upperCaseGroup, lowerCaseGroup] printableGroup = KeyGroup "Printable" . keysSetOfUnicode $ keysUnicode digitsGroup = KeyGroup "Digits" . keysSetOfUnicode $ digitsUnicode upperCaseGroup = KeyGroup "Upper-case letters" . keysSetOfUnicode $ upperCaseUnicode lowerCaseGroup = KeyGroup "Lower-case letters" . keysSetOfUnicode $ lowerCaseUnicode 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, upperCaseUnicode, digitsUnicode :: 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.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.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, "=") ]]