Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

multiple heroes: prepare keys for hero selection commands

  • Loading branch information...
commit b04876614ba71e45b39f8581149bdbd515e6f1b0 1 parent 8152f6f
@Mikolaj Mikolaj authored
View
13 src/Display/Curses.hs
@@ -47,9 +47,9 @@ display ((y0,x0),(y1,x1)) (Session { win = w, styles = s }) f msg status =
mvWAddStr w (y1+2) 0 status
refresh
{-
- in V.update vty (Pic NoCursor
+ in V.update vty (Pic NoCursor
((renderBS attr (BS.pack (L.map (fromIntegral . ord) (toWidth (x1-x0+1) msg)))) <->
- img <->
+ img <->
(renderBS attr (BS.pack (L.map (fromIntegral . ord) (toWidth (x1-x0+1) status))))))
-}
@@ -66,6 +66,7 @@ keyTranslate e =
C.KeyChar '\n' -> Just K.Return
C.KeyChar '\r' -> Just K.Return
C.KeyEnter -> Just K.Return
+ C.KeyChar '\t' -> Just K.Tab
C.KeyUp -> Just K.Up
C.KeyDown -> Just K.Down
C.KeyLeft -> Just K.Left
@@ -76,7 +77,11 @@ keyTranslate e =
C.KeyNPage -> Just K.PgDn
C.KeyBeg -> Just K.Begin
C.KeyB2 -> Just K.Begin
- C.KeyChar c -> Just (K.Char c)
+ -- No KP_ keys in hscurses and they do not seem actively maintained.
+ -- For now, movement keys are more important than hero selection:
+ C.KeyChar c
+ | c `elem` "123456789" -> Just (K.KP c)
+ | otherwise -> Just (K.Char c)
_ -> Nothing
nextEvent :: Session -> IO K.Key
@@ -89,7 +94,7 @@ type Attr = (Maybe AttrColor, Maybe AttrColor)
attr = (Nothing, Nothing)
-data AttrColor = White | Black | Yellow | Blue | Magenta | Red | Green
+data AttrColor = White | Black | Yellow | Blue | Magenta | Red | Green
deriving (Show, Eq, Ord, Enum, Bounded)
toFColor :: Maybe AttrColor -> C.ForegroundColor
View
11 src/Display/Gtk.hs
@@ -1,5 +1,5 @@
module Display.Gtk
- (displayId, startup, shutdown,
+ (displayId, startup, shutdown,
display, nextEvent, setBG, setFG, setBold, Session,
white, black, yellow, blue, magenta, red, green, attr, Attr) where
@@ -95,9 +95,9 @@ startup k =
widgetModifyBase tv StateNormal black
widgetModifyText tv StateNormal white
- ec <- newChan
+ ec <- newChan
forkIO $ k (Session ec tts tv)
-
+
onKeyPress tv (\ e -> postGUIAsync (writeChan ec (Graphics.UI.Gtk.Gdk.Events.eventKeyName e)) >> return True)
onDestroy w mainQuit -- set quit handler
@@ -114,7 +114,7 @@ display ((y0,x0),(y1,x1)) session f msg status =
tb <- textViewGetBuffer (sview session)
let text = unlines [ [ snd (f (y,x)) | x <- [x0..x1] ] | y <- [y0..y1] ]
textBufferSetText tb (msg ++ "\n" ++ text ++ status)
- sequence_ [ setTo tb (stags session) (y,x) a |
+ sequence_ [ setTo tb (stags session) (y,x) a |
y <- [y0..y1], x <- [x0..x1], let loc = (y,x), let (a,c) = f (y,x) ]
setTo :: TextBuffer -> Map AttrKey TextTag -> Loc -> Attr -> IO ()
@@ -162,6 +162,7 @@ keyTranslate "question" = Just (K.Char '?')
keyTranslate "asterisk" = Just (K.Char '*')
keyTranslate "Escape" = Just K.Esc
keyTranslate "Return" = Just K.Return
+keyTranslate "Tab" = Just K.Tab
keyTranslate "KP_Up" = Just K.Up
keyTranslate "KP_Down" = Just K.Down
keyTranslate "KP_Left" = Just K.Left
@@ -172,7 +173,7 @@ keyTranslate "KP_Page_Up" = Just K.PgUp
keyTranslate "KP_Page_Down" = Just K.PgDn
keyTranslate "KP_Begin" = Just K.Begin
keyTranslate "KP_Enter" = Just K.Return
-keyTranslate ['K','P','_',c] = Just (K.Char c) -- for numbers
+keyTranslate ['K','P','_',c] = Just (K.KP c)
keyTranslate [c] = Just (K.Char c)
keyTranslate _ = Nothing
View
33 src/Display/Vty.hs
@@ -26,7 +26,7 @@ display ((y0,x0),(y1,x1)) vty f msg status =
[ [ (x,y) | x <- [x0..x1] ] | y <- [y0..y1] ]
in V.update vty (pic_for_image
(utf8_bytestring attr (BS.pack (L.map (fromIntegral . ord) (toWidth (x1 - x0 + 1) msg))) <->
- img <->
+ img <->
utf8_bytestring attr (BS.pack (L.map (fromIntegral . ord) (toWidth (x1 - x0 + 1) status)))))
toWidth :: Int -> String -> String
@@ -35,19 +35,24 @@ toWidth n x = take n (x ++ repeat ' ')
keyTranslate :: V.Event -> Maybe K.Key
keyTranslate e =
case e of
- V.EvKey KEsc [] -> Just K.Esc
- V.EvKey KEnter [] -> Just K.Return
- V.EvKey KUp [] -> Just K.Up
- V.EvKey KDown [] -> Just K.Down
- V.EvKey KLeft [] -> Just K.Left
- V.EvKey KRight [] -> Just K.Right
- V.EvKey KHome [] -> Just K.Home
- V.EvKey KPageUp [] -> Just K.PgUp
- V.EvKey KEnd [] -> Just K.End
- V.EvKey KPageDown [] -> Just K.PgDn
- V.EvKey KBegin [] -> Just K.Begin
- V.EvKey (KASCII c) [] -> Just (K.Char c)
- _ -> Nothing
+ V.EvKey KEsc [] -> Just K.Esc
+ V.EvKey KEnter [] -> Just K.Return
+ V.EvKey (KASCII '\t') [] -> Just K.Tab
+ V.EvKey KUp [] -> Just K.Up
+ V.EvKey KDown [] -> Just K.Down
+ V.EvKey KLeft [] -> Just K.Left
+ V.EvKey KRight [] -> Just K.Right
+ V.EvKey KHome [] -> Just K.Home
+ V.EvKey KPageUp [] -> Just K.PgUp
+ V.EvKey KEnd [] -> Just K.End
+ V.EvKey KPageDown [] -> Just K.PgDn
+ V.EvKey KBegin [] -> Just K.Begin
+ -- No KP_ keys in vty; maintainer contacted, we'll see.
+ -- For now, movement keys are more important than hero selection:
+ V.EvKey (KASCII c) []
+ | c `elem` "123456789" -> Just (K.KP c)
+ | otherwise -> Just (K.Char c)
+ _ -> Nothing
nextEvent :: Session -> IO K.Key
nextEvent session =
View
38 src/Display2.hs
@@ -30,25 +30,25 @@ nextCommand session =
canonicalKey :: Key -> Key
canonicalKey e =
case e of
- K.Char '8' -> K.Char 'K'
- K.Char '2' -> K.Char 'J'
- K.Char '4' -> K.Char 'H'
- K.Char '6' -> K.Char 'L'
- K.Char '7' -> K.Char 'Y'
- K.Char '9' -> K.Char 'U'
- K.Char '1' -> K.Char 'B'
- K.Char '3' -> K.Char 'N'
- K.Char '5' -> K.Char '.'
- K.Up -> K.Char 'k'
- K.Down -> K.Char 'j'
- K.Left -> K.Char 'h'
- K.Right -> K.Char 'l'
- K.Home -> K.Char 'y'
- K.PgUp -> K.Char 'u'
- K.End -> K.Char 'b'
- K.PgDn -> K.Char 'n'
- K.Begin -> K.Char '.'
- k -> k
+ K.KP '8' -> K.Char 'K'
+ K.KP '2' -> K.Char 'J'
+ K.KP '4' -> K.Char 'H'
+ K.KP '6' -> K.Char 'L'
+ K.KP '7' -> K.Char 'Y'
+ K.KP '9' -> K.Char 'U'
+ K.KP '1' -> K.Char 'B'
+ K.KP '3' -> K.Char 'N'
+ K.KP '5' -> K.Char '.'
+ K.Up -> K.Char 'k'
+ K.Down -> K.Char 'j'
+ K.Left -> K.Char 'h'
+ K.Right -> K.Char 'l'
+ K.Home -> K.Char 'y'
+ K.PgUp -> K.Char 'u'
+ K.End -> K.Char 'b'
+ K.PgDn -> K.Char 'n'
+ K.Begin -> K.Char '.'
+ k -> k
-- | Displays a message on a blank screen. Waits for confirmation.
displayBlankConfirm :: Session -> String -> IO Bool
View
6 src/Keys.hs
@@ -6,6 +6,7 @@ import Prelude hiding (Left, Right)
data Key =
Esc
| Return
+ | Tab
| PgUp
| PgDn
| Left
@@ -15,13 +16,15 @@ data Key =
| End
| Begin
| Home
- | Char Char -- ^ a single printable character
+ | KP Char -- ^ a keypad key for a character (digits and operators)
+ | Char Char -- ^ a single printable character
deriving (Ord, Eq)
showKey :: Key -> String
showKey (Char c) = [c]
showKey Esc = "<escape>"
showKey Return = "<return>"
+showKey Tab = "<tab>"
showKey PgUp = "<page-up>"
showKey PgDn = "<page-down>"
showKey Left = "<left>"
@@ -30,3 +33,4 @@ showKey Up = "<up>"
showKey Down = "<down>"
showKey End = "<end>"
showKey Home = "<home>"
+showKey (KP c) = "<KeyPad " ++ [c] ++ ">"
Please sign in to comment.
Something went wrong with that request. Please try again.