diff --git a/CursesUIMInstance.hs b/CursesUIMInstance.hs --- a/CursesUIMInstance.hs +++ b/CursesUIMInstance.hs @@ -189,6 +189,7 @@ drawMainState' (MetaState saddr undecls cOnly auth names _ _ rnamestvar _ _ mretired path lock _) = do let ourName = liftM authUser auth let selName = listToMaybe names + let home = isJust ourName && ourName == selName (h,w) <- liftIO Curses.scrSize when (h<20 || w<40) $ liftIO CursesH.end >> error "Terminal too small!" lift $ do @@ -213,9 +214,10 @@ lift $ do unless fresh $ drawAtCVec (Glyph '*' red bold) $ CVec 2 (w`div`2+7) maybe (return ()) sayError err - when (fresh && isNothing ourName) $ + when (fresh && (isNothing ourName || home || isNothing muirc)) $ drawStrGrey (CVec 2 (w`div`2+1+9)) =<< - (bindingsStr IMMeta $ if isNothing muirc then [CmdRegister] else [CmdAuth]) + (bindingsStr IMMeta $ + if (isNothing muirc && isNothing ourName) || home then [CmdRegister] else [CmdAuth]) for_ muirc $ \(RCUserInfo (_,uinfo)) -> case mretired of Just retired -> do (h,w) <- liftIO Curses.scrSize @@ -294,7 +296,6 @@ (map (`divMod` (h-3)) [0..]) , (x+1)*bdgWidth < w] refresh - void $ getInput mode getChRaw = (charify<$>) $ liftIO $ CursesH.getKey (return ()) setUIBinding mode cmd ch = diff --git a/EditGameState.hs b/EditGameState.hs --- a/EditGameState.hs +++ b/EditGameState.hs @@ -153,3 +153,4 @@ (idx'',_) <- Map.lookup (dir<+>pos) $ stateBoard st' return $ addPivotArm idx'' pos st' + _ -> mzero diff --git a/Interact.hs b/Interact.hs --- a/Interact.hs +++ b/Interact.hs @@ -113,7 +113,9 @@ processCommand im cmd = lift $ processCommand' im cmd processCommand' :: UIMonad uiM => InputMode -> Command -> StateT MainState uiM () -processCommand' im CmdHelp = lift $ showHelp im +processCommand' im CmdHelp = lift $ do + showHelp im + void $ textInput "[press a key]" 1 False True Nothing Nothing processCommand' im CmdBind = lift $ flip (>>) (drawMessage "") $ void $ runMaybeT $ do lift $ drawMessage "Command to bind: " cmd <- msum $ repeat $ do @@ -566,27 +568,31 @@ selPos <- gets selectedPos st:_ <- gets esGameStateStack lift $ drawMessage "Merge in which direction?" - cmd <- lift $ head <$> getSomeInput IMEdit - lift $ drawMessage "" - case cmd of - CmdDir _ mergeDir -> do - modifyEState $ mergeTiles selPos mergeDir True - -- XXX: merging might invalidate selectedPiece - modify $ \es -> es {selectedPiece = Nothing} + let getDir = do + cmd <- lift $ head <$> getSomeInput IMEdit + case cmd of + CmdDir _ mergeDir -> return $ Just mergeDir + CmdDrag _ mergeDir -> return $ Just mergeDir + CmdMoveTo _ -> getDir + _ -> return $ Nothing + mergeDir <- getDir + case mergeDir of + Just mergeDir -> modifyEState $ mergeTiles selPos mergeDir True _ -> return () + -- XXX: merging might invalidate selectedPiece + modify $ \es -> es {selectedPiece = Nothing} + lift $ drawMessage "" processCommand' IMEdit CmdWait = do - selPos <- gets selectedPos - selPiece <- gets selectedPiece st:_ <- gets esGameStateStack - case selPiece of - Nothing -> drawTile selPos Nothing False - Just _ -> do (st',_) <- lift $ doPhysicsTick NullPM st - pushEState st' + (st',_) <- lift $ doPhysicsTick NullPM st + pushEState st' + processCommand' IMEdit CmdDelete = do + selPos <- gets selectedPos selPiece <- gets selectedPiece st:_ <- gets esGameStateStack case selPiece of - Nothing -> return () + Nothing -> drawTile selPos Nothing False Just p -> do modify $ \es -> es {selectedPiece = Nothing} modifyEState $ delPiece p processCommand' IMEdit CmdWriteState = void.runMaybeT $ do diff --git a/KeyBindings.hs b/KeyBindings.hs --- a/KeyBindings.hs +++ b/KeyBindings.hs @@ -8,7 +8,7 @@ -- You should have received a copy of the GNU General Public License -- along with this program. If not, see http://www.gnu.org/licenses/. -module KeyBindings (KeyBindings, bindings, findBindings, findBinding, showKey) where +module KeyBindings (KeyBindings, bindings, findBindings, findBinding, showKey, showKeyFriendly) where import Data.Maybe import Data.Char @@ -128,7 +128,10 @@ , ('T', CmdTest) , ('W', CmdWriteState) , (ctrl 'S', CmdWriteState) + , ('=', CmdMerge) + , ('+', CmdMerge) , ('&', CmdMerge) + , ('0', CmdDelete) , ('E', CmdDelete) ] tilesPaintRow = lowerToo @@ -137,7 +140,7 @@ , ('D', CmdTile $ PivotTile zero) , ('S', CmdTile $ SpringTile Relaxed zero) , ('A', CmdTile $ BlockTile []) - , ('Z', CmdWait) + , ('Z', CmdDelete) ] tilesAscii = [ ('o', CmdTile $ PivotTile zero) @@ -153,7 +156,7 @@ , ('*', CmdTile $ WrenchTile zero) , ('#', CmdTile $ BlockTile []) ] -editOnly = editMisc ++ tilesPaintRow ++ tilesAscii +editOnly = tilesPaintRow ++ editMisc ++ tilesAscii playBindings = playOnly ++ lockGlobal replayBindings = replayOnly ++ lockGlobal @@ -197,3 +200,10 @@ showKey ch | isPrint ch = [ch] showKey ch | isPrint (unctrl ch) = ('^':[unctrl ch]) showKey _ = "[?]" + +showKeyFriendly ' ' = "space" +showKeyFriendly '\r' = "return" +showKeyFriendly '\n' = "newline" +showKeyFriendly '\t' = "tab" +showKeyFriendly '\b' = "bksp" +showKeyFriendly ch = showKey ch diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -1,3 +1,6 @@ +0.3.1: + Misc minor UI improvements; + Help screens in SDL mode. 0.3: Minor fixes; first version uploaded to hackage 0.2.8: diff --git a/SDLUI.hs b/SDLUI.hs --- a/SDLUI.hs +++ b/SDLUI.hs @@ -116,7 +116,7 @@ getButtons mode = do whs <- gets $ whsButtons.uiOptions cntxtButtons <- gets contextButtons - return $ cntxtButtons ++ case mode of + return $ cntxtButtons ++ global ++ case mode of IMEdit -> [ singleButton (tl<+>hv) CmdTest 4 , singleButton (tl<+>(neg hw)) CmdPlay 2 @@ -162,6 +162,7 @@ where quitButton = Button br CmdQuit markGroup = ([Button (tl<+>hw) CmdMark, Button (tl<+>hw<+>neg hu) CmdJumpMark],(0,0)) + global = [ singleButton (tr <+> 4<*>hv <+> 3<*>hu) CmdHelp 3 ] tr = periphery 0 tl = periphery 2 bl = periphery 3 @@ -293,6 +294,10 @@ liftIO makeConfDir liftIO $ writeFile path $ show bdgs +getBindings mode = do + uibdgs <- Map.findWithDefault [] mode `liftM` gets uiKeyBindings + return $ uibdgs ++ bindings mode + paintTiles :: [ Maybe Tile ] paintTiles = [ Just BallTile @@ -303,7 +308,7 @@ , Nothing ] -paintTileCmds = map (maybe CmdWait CmdTile) paintTiles +paintTileCmds = map (maybe CmdDelete CmdTile) paintTiles getEffPaintTileIndex :: UIM Int getEffPaintTileIndex = do diff --git a/SDLUIMInstance.hs b/SDLUIMInstance.hs --- a/SDLUIMInstance.hs +++ b/SDLUIMInstance.hs @@ -85,7 +85,7 @@ registerUndoButtons (null sts) (null undostack) when (isJust selPiece) $ mapM_ registerButtonGroup [ singleButton (periphery 2 <+> 3<*>hw<+>hu) CmdDelete 0 - -- , singleButton (periphery 2 <+> 3<*>hw) CmdMerge 4 + , singleButton (periphery 2 <+> 3<*>hw) CmdMerge 4 ] drawPaintButtons drawMainState' (MetaState saddr undecls cOnly auth names _ _ rnamestvar _ _ mretired path mlock offset) = do @@ -122,9 +122,9 @@ smallFont <- gets dispFontSmall renderToMain $ withFont smallFont $ renderStrColAtLeft (opaquify $ dim errorCol) "(stale)" $ serverWaitPos maybe (return ()) (setMsgLineNoRefresh errorCol) err - when (fresh && (isNothing ourName || home)) $ + when (fresh && (isNothing ourName || home || isNothing muirc)) $ registerButtonGroup $ singleButton (codenamePos <+> 2<*>hu) - (if isNothing muirc || home then CmdRegister else CmdAuth) 2 + (if (isNothing muirc && isNothing ourName) || home then CmdRegister else CmdAuth) 2 (if isJust muirc then drawName else drawNullName) name codenamePos lift $ registerSelectable codenamePos 0 SelSelectedCodeName drawRelScore name (codenamePos<+>hu) @@ -197,8 +197,6 @@ drawAlerts alerts = return () - showHelp _ = return () - getChRaw = do events <- liftIO getEvents case listToMaybe $ [ key | KeyDown key <- events ] of @@ -282,7 +280,7 @@ sequence_ [ modify $ \s -> s { paintTileIndex = pti } | (pti,pt) <- zip [0..] paintTiles - , (isNothing pt && mCmd == Just CmdWait) || + , (isNothing pt && mCmd == Just CmdDelete) || (isJust $ do pt' <- pt CmdTile t <- mCmd @@ -401,7 +399,7 @@ drawCmd mt True = CmdPaint mt drawCmd (Just t) False = CmdTile t - drawCmd Nothing _ = CmdWait + drawCmd Nothing _ = CmdDelete getMousePos :: UIM ((HexVec,Bool),(Double,Double,Double)) getMousePos = do @@ -432,8 +430,54 @@ uibdgs <- Map.findWithDefault [] mode `liftM` gets uiKeyBindings return $ describeCommand cmd ++ " [" ++ concat (intersperse "," - (map showKey $ findBindings (uibdgs ++ bindings mode) cmd)) + (map showKeyFriendly $ findBindings (uibdgs ++ bindings mode) cmd)) ++ "]" + + showHelp mode = do + bdgs <- nub <$> getBindings mode + smallFont <- gets dispFontSmall + renderToMain $ do + erase + let bdgWidth = (screenWidthHexes-6) `div` 3 + showKeys chs = intercalate "/" (map showKeyFriendly chs) + maxkeyslen = maximum $ map (length.showKeys.map fst) $ groupBy ((==) `on` snd) bdgs + mouseHelpStrs = ["Mouse commands:", "Right-click on a button to set a keybinding;"] ++ case mode of + IMPlay -> ["Click on tool to select, drag to move;", + "Click by tool to move;", "Scroll wheel to rotate hook;", + "Scroll wheel while held down to undo/redo."] + IMEdit -> ["Left-click to draw selected; scroll to change selection;", + "Right-click on piece to select, drag to move;", + "While holding right-click: left-click to advance time, middle-click to delete;", + "Scroll wheel to rotate selected piece; scroll wheel while held down to undo/redo."] + IMReplay -> ["Scroll wheel while held down to undo/redo."] + IMMeta -> ["Left-clicking on something does most obvious thing;", + "Right-clicking does second-most obvious thing."] + + renderStrColAt messageCol "Keybindings:" $ (screenHeightHexes`div`4)<*>(hv<+>neg hw) + sequence_ [ with $ renderStrColAtLeft messageCol + ( keysStr ++ ": " ++ desc ) + $ (x*bdgWidth-(screenWidthHexes-6)`div`2)<*>hu <+> neg hv <+> + (screenHeightHexes`div`4 - y`div`2)<*>(hv<+>neg hw) <+> + (y`mod`2)<*>hw + | ((keysStr,with,desc),(x,y)) <- zip [(keysStr,with,desc) + | group <- groupBy ((==) `on` snd) $ sortBy (compare `on` snd) bdgs + , let cmd = snd $ head group + , let desc = describeCommand cmd + , not $ null desc + , let chs = map fst group + , let keysStr = showKeys chs + , let with = if True -- 3*(bdgWidth-1) < length desc + length keysStr + 1 + then withFont smallFont + else id + ] + (map (`divMod` (screenHeightHexes-9)) [0..]) + , (x+1)*bdgWidth < screenWidthHexes] + sequence_ [ renderStrColAt messageCol str + $ (3-screenHeightHexes`div`4-y`div`2)<*>(hv<+>neg hw) + <+> hv + <+> (y`mod`2)<*>hw + | (str,y) <- zip mouseHelpStrs [0..] ] + refresh getEvents = do e <- waitEvent diff --git a/intricacy.cabal b/intricacy.cabal --- a/intricacy.cabal +++ b/intricacy.cabal @@ -1,5 +1,5 @@ name: intricacy -version: 0.3 +version: 0.3.1 synopsis: A game of competitive puzzle-design homepage: http://mbays.freeshell.org/intricacy license: GPL-3