diff --git a/CursesUIMInstance.hs b/CursesUIMInstance.hs --- a/CursesUIMInstance.hs +++ b/CursesUIMInstance.hs @@ -169,6 +169,28 @@ void $ fillBox (CVec (lockBottom+3) (left+1)) (CVec bottom (right-1)) 5 GravUp [ (`drawActiveLock` al) | al <- map noteOn $ notesSecured lockinfo ] +drawBasicHelpPage :: (String,ColPair) -> ([String],ColPair) -> UIM () +drawBasicHelpPage (title,titleCol) (body,bodyCol) = do + erase + (h,w) <- liftIO Curses.scrSize + drawStrCentred a0 titleCol (CVec 0 $ w`div`2) title + if w >= maximum (map length metagameHelpText) + then sequence_ [drawStrCentred a0 bodyCol (CVec line $ w`div`2) str | + (line,str) <- zip [2..h] $ body ] + else do + let wrap max = wrap' max max + wrap' _ _ [] = [] + wrap' max left (w:ws) = if 1+length w > left + then if left == max + then take max w ++ "\n" ++ + wrap' max max (drop max w : ws) + else '\n' : wrap' max max (w:ws) + else let prepend = if left == max then w else ' ':w + in prepend ++ wrap' max (left - length prepend) ws + sequence_ [drawStrCentred a0 bodyCol (CVec line $ w`div`2) str | + (line,str) <- zip [1..h] $ + lines (wrap w $ words $ intercalate " " body) ] + charify :: Curses.Key -> Maybe Char charify key = case key of Curses.KeyChar ch -> Just ch @@ -322,25 +344,11 @@ refresh return True showHelp IMMeta HelpPageGame = do - erase - (h,w) <- liftIO Curses.scrSize - if w >= maximum (map length metagameHelpText) - then sequence_ [drawStrCentred a0 magenta (CVec line $ w`div`2) str | - (line,str) <- zip [0..h-2] $ ["INTRICACY",""] ++ metagameHelpText ] - else do - let wrap max = wrap' max max - wrap' _ _ [] = [] - wrap' max left (w:ws) = if 1+length w > left - then if left == max - then take max w ++ "\n" ++ - wrap' max max (drop max w : ws) - else '\n' : wrap' max max (w:ws) - else let prepend = if left == max then w else ' ':w - in prepend ++ wrap' max (left - length prepend) ws - sequence_ [drawStrCentred a0 magenta (CVec line $ w`div`2) str | - (line,str) <- zip [0..h] $ - lines (wrap w $ words $ intercalate " " metagameHelpText) ] - return True + drawBasicHelpPage ("INTRICACY",magenta) (metagameHelpText,magenta) + return True + showHelp IMEdit HelpPageFirstEdit = do + drawBasicHelpPage ("Your first lock:",magenta) (firstEditHelpText,green) + return True showHelp _ _ = return False getChRaw = (charify<$>) $ liftIO $ CursesH.getKey (return ()) diff --git a/EditGameState.hs b/EditGameState.hs --- a/EditGameState.hs +++ b/EditGameState.hs @@ -56,8 +56,6 @@ PivotTile _ -> True _ -> False -- |Find next adjacent, skipping over current entity. - -- XXX: Note this doesn't work when the entity is adjacent in multiple - -- non-contiguous directions. nextOfAdjacents adjs loop = listToMaybe $ fromMaybe adjs $ do owner <- mowner i <- elemIndex owner adjs @@ -68,7 +66,7 @@ _ -> (case tile of -- _ | same && (pos /= lastPos) -> id Just (BlockTile _) -> - let adjacentBlocks = [ idx | + let adjacentBlocks = nub [ idx | dir <- hexDirs , Just (idx, BlockTile _) <- [Map.lookup (dir +^ pos) board'] , not $ protectedPiece idx ] diff --git a/Interact.hs b/Interact.hs --- a/Interact.hs +++ b/Interact.hs @@ -130,10 +130,16 @@ processCommand im cmd = lift $ processCommand' im cmd processCommand' :: UIMonad uiM => InputMode -> Command -> MainStateT uiM () -processCommand' im CmdHelp = lift $ +processCommand' im CmdHelp = lift $ do + helpPages <- case im of + IMMeta -> return [HelpPageInput, HelpPageGame] + IMEdit -> do + first <- not <$> liftIO hasLocks + return $ [HelpPageInput] ++ if first then [HelpPageFirstEdit] else [] + _ -> return [HelpPageInput] let showPage p = showHelp im p >>? do void $ textInput "[press a key or RMB]" 1 False True Nothing Nothing - in sequence_ $ map showPage $ enumFrom HelpPageInput + sequence_ $ map showPage helpPages processCommand' im (CmdBind mcmd)= lift $ (>> endPrompt) $ runMaybeT $ do cmd <- liftMaybe mcmd `mplus` do lift $ drawPrompt False "Command to bind: " @@ -215,8 +221,10 @@ regName <- mgetCurName mauth <- gets curAuth let isUs = maybe False ((==regName).authUser) mauth - let inputPassword = (hashPassword regName <$>) $ MaybeT $ lift $ - textInput "Enter new password:" 64 True False Nothing Nothing + let inputPassword = do + pw <- MaybeT $ lift $ textInput "Enter new password:" 64 True False Nothing Nothing + guard $ not $ null pw + return $ hashPassword regName pw if isUs then msum [ do confirmOrBail "Log out?" @@ -425,6 +433,11 @@ return size ] return (baseLock size, Nothing) + not <$> liftIO hasLocks >>? do + lift.lift $ showHelp IMEdit HelpPageFirstEdit >>? do + void $ textInput + "[Press a key or RMB to continue; you can review this help later with '?']" + 1 False True Nothing Nothing path <- lift $ gets curLockPath newPath <- MaybeT $ (esPath <$>) $ execSubMainState $ newEditState (reframe lock) msoln (if null path then Nothing else Just path) diff --git a/InteractUtil.hs b/InteractUtil.hs --- a/InteractUtil.hs +++ b/InteractUtil.hs @@ -97,6 +97,11 @@ (\x y -> (if newer then (<) else (>)) x (snd y)) time) <$> (\p -> (,) p <$> getModificationTime p) `mapM` paths +hasLocks :: IO Bool +hasLocks = do + lockdir <- confFilePath "locks" + not.null <$> getDirContentsRec lockdir + setLockPath :: UIMonad uiM => FilePath -> MainStateT uiM () setLockPath path = do lock <- liftIO $ fullLockPath path >>= readLock @@ -105,9 +110,13 @@ declare undecl@(Undeclared soln ls al) = do ourName <- mgetOurName ourUInfo <- mgetUInfo ourName - pbdg <- lift.lift $ getUIBinding IMMeta $ CmdPlaceLock Nothing + [pbdg,ebdg,hbdg] <- mapM (lift.lift . getUIBinding IMMeta) + [ CmdPlaceLock Nothing, CmdEdit, CmdHome ] + haveLock <- isJust <$> gets curLock idx <- askLockIndex "Secure behind which lock?" - ("You first need to place ('"++pbdg++"') a lock to secure your solution behind.") + (if haveLock + then "First you must place ('"++pbdg++"') a lock to secure your solution behind, while at home ('"++hbdg++"')." + else "First design a lock in the editor ('"++ebdg++"'), behind which to secure your solution.") (\i -> isJust $ userLocks ourUInfo ! i) guard $ isJust $ userLocks ourUInfo ! idx lift $ curServerActionAsyncThenInvalidate @@ -172,6 +181,7 @@ Nothing -> waitConfirm ansOfCmd (CmdInputChar 'y') = Just True ansOfCmd (CmdInputChar 'Y') = Just True + ansOfCmd (CmdInputChar c) = if isPrint c then Just False else Nothing ansOfCmd CmdRedraw = Just False ansOfCmd CmdRefresh = Nothing ansOfCmd CmdUnselect = Nothing @@ -223,12 +233,13 @@ then ((if length s >= maxlen then id else (++[c])) s, Nothing) else (s,mstem) applyCmd x (CmdInputSelLock idx) = - Right $ ([lockIndexChar idx], Nothing) + setTextOrSubmit x $ [lockIndexChar idx] applyCmd x (CmdInputSelUndecl (Undeclared _ _ (ActiveLock name idx))) = - Right $ (name++[':',lockIndexChar idx], Nothing) + setTextOrSubmit x $ name++[':',lockIndexChar idx] applyCmd x (CmdInputCodename name) = - Right $ (name, Nothing) + setTextOrSubmit x $ name applyCmd x CmdRefresh = Right x applyCmd x CmdUnselect = Right x applyCmd _ _ = Left False completes s s' = take (length s) s' == s + setTextOrSubmit (s,_) t = if s == t then Left True else Right (t,Nothing) diff --git a/MainState.hs b/MainState.hs --- a/MainState.hs +++ b/MainState.hs @@ -132,7 +132,7 @@ type MainStateT = StateT MainState -data HelpPage = HelpPageInput | HelpPageGame +data HelpPage = HelpPageInput | HelpPageGame | HelpPageFirstEdit deriving (Eq, Ord, Show, Enum) ms2im :: MainState -> InputMode @@ -472,4 +472,21 @@ , "the number of their locks which win you a point minus the number of your locks which win them one." , "If the secrets to one of your locks become widely disseminated, you may wish to replace it." , "However: once replaced, a lock is \"retired\", and the notes it secured are read by everyone." + ] + +firstEditHelpText :: [String] +firstEditHelpText = + [ "Design a lock to protect your secrets." + , "It must be possible to solve your lock by pulling a sprung bolt from the hole in the top-right," + , "but you should place blocks, springs, pivots, and balls to make this as difficult as possible." + , "" + , "Place pieces with keyboard or mouse. Springs must be set next to blocks, and arms next to pivots." + , "Repeatedly placing a piece in the same hex cycles through ways it can relate to its neighbours." + , "" + , "Use Test to prove your lock is solvable, or Play to alternate between testing and editing." + , "When you are done, Write your lock, then Quit from editing and Place your lock in a slot." + , "You will then be able to Declare locks you solve, and others will attempt to solve your lock." + , "" + , "Your first lock is unlikely to stand for long against your more experienced peers;" + , "examine their solutions to spot flaws in your design, and study their locks for ideas." ] diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -1,5 +1,13 @@ This is an abbreviated summary; see the git log for gory details. +0.6.2: + Fix obscure but actual bug in core game physics: + wrenches were being blocked when they shouldn't be. + See TST:C on the main server for an example - it can be solved only in + intricacy versions prior to this one. + Extra help text screen for editing first lock. + Cycle through all possibilities when placing blocks in editor. + 0.6.1: Fix stupid bug preventing registration via keyboard command. diff --git a/Physics.hs b/Physics.hs --- a/Physics.hs +++ b/Physics.hs @@ -145,8 +145,10 @@ else [i,j] stopWrench idx = setPiece idx (Wrench zero) - stopBlockedWrenches fs st' = foldr stopWrench st' [ - forceIdx f | f <- fs, isWrench.placedPiece $ getForcedpp st' f ] + stopBlockedWrenches blocked unblocked st' = foldr stopWrench st' $ + forcedWrenches blocked \\ forcedWrenches unblocked + where forcedWrenches fs = [ forceIdx f + | f <- fs, isWrench.placedPiece $ getForcedpp st' f ] divertedWrenches fs = [ idx | Push idx dir <- fs , Wrench mom <- [placedPiece $ getpp st idx] @@ -165,7 +167,7 @@ tell $ map AlertBlockedForce blocked tell $ map AlertAppliedForce unblocked tell $ map AlertDivertedWrench $ divertedWrenches unblocked - return $ stopBlockedWrenches blocked $ foldr applyForce st unblocked + return $ stopBlockedWrenches blocked unblocked $ foldr applyForce st unblocked resolveSinglePlForce :: Force -> GameState -> Writer [Alert] GameState resolveSinglePlForce force st = resolveForces diff --git a/SDLRender.hs b/SDLRender.hs --- a/SDLRender.hs +++ b/SDLRender.hs @@ -377,10 +377,13 @@ sequence_ [ pixel surf (fi $ x+size`div`3+(i*size`div`4)) (fi $ y - size`div`4) (bright white) | i <- [-1..1] ] -renderGlyph (UseSoundsButton use) centre@(SVec x y) size surf = sequence_ - [ arc surf (fi $ x - (size`div`2)) (fi y) r (-20) 20 - (if use then bright green else dim red) - | r <- map fi $ map (*(size`div`3)) [1,2,3] ] +renderGlyph (UseSoundsButton use) centre@(SVec x y) size surf = do + sequence [ arc surf (fi $ x - (2*size`div`3)) (fi y) r (-20) 20 + (if use then bright green else dim red) + | r <- map fi $ map (*(size`div`3)) [1,2,3] ] + when (not use) $ void $ aaLine surf + `uncurry` (innerCorner centre size hw) + `uncurry` (innerCorner centre size $ neg hw) $ dim red renderGlyph (WhsButtonsButton Nothing) centre size surf = renderGlyph (ButtonGlyph (dim red)) centre (size`div`3) surf diff --git a/SDLUI.hs b/SDLUI.hs --- a/SDLUI.hs +++ b/SDLUI.hs @@ -322,7 +322,7 @@ helpOfSelectable (SelReadNote note) = Just $ "You have read "++noteAuthor note++"'s note on this lock." helpOfSelectable SelReadNoteSlot = Just $ - "Reading three notes on this lock would let you unriddle its secrets." + "Reading three notes on this lock would suffice to reveal its secrets." helpOfSelectable (SelSecured note) = let ActiveLock owner idx = noteOn note in Just $ "Secured note on "++owner++"'s lock "++[lockIndexChar idx]++"." helpOfSelectable (SelSolution note) = Just $ case noteBehind note of diff --git a/SDLUIMInstance.hs b/SDLUIMInstance.hs --- a/SDLUIMInstance.hs +++ b/SDLUIMInstance.hs @@ -586,19 +586,11 @@ refresh return True showHelp IMMeta HelpPageGame = do - renderToMain $ do - erase - let headPos = (screenHeightHexes`div`4)*^(hv+^neg hw) - renderStrColAt red "INTRICACY" headPos - sequence_ - [ renderStrColAt purple str $ - headPos - +^ (y`div`2)*^(hw+^neg hv) - +^ (y`mod`2)*^hw - | (y,str) <- zip [1..] - metagameHelpText - ] - return True + renderToMain $ drawBasicHelpPage ("INTRICACY",red) (metagameHelpText,purple) + return True + showHelp IMEdit HelpPageFirstEdit = do + renderToMain $ drawBasicHelpPage ("Your first lock:",purple) (firstEditHelpText,green) + return True showHelp _ _ = return False onNewMode mode = modify (\ds -> ds{needHoverUpdate=True}) >> say "" @@ -849,3 +841,15 @@ [ \pos -> (lift $ registerSelectable pos 0 (SelSecured note)) >> drawActiveLock (noteOn note) pos | note <- notesSecured lockinfo ] +drawBasicHelpPage :: (String,Pixel) -> ([String],Pixel) -> RenderM () +drawBasicHelpPage (title,titleCol) (body,bodyCol) = do + erase + let headPos = (screenHeightHexes`div`4)*^(hv+^neg hw) + renderStrColAt titleCol title headPos + sequence_ + [ renderStrColAt bodyCol str $ + headPos + +^ (y`div`2)*^(hw+^neg hv) + +^ (y`mod`2)*^hw + | (y,str) <- zip [1..] body + ] diff --git a/Server.hs b/Server.hs --- a/Server.hs +++ b/Server.hs @@ -264,8 +264,8 @@ || note `elem` notesRead uinfo then if public onLinfo || uname `elem` accessedBy onLinfo then ServedSolution <$> getSolution note - else throwE "You can't wholly decipher that note." - else throwE "You don't have access to that note." + else throwE "You can't wholly decipher this note - you would need more notes on the same lock." + else throwE "This note is secured behind a lock you have not opened." DeclareSolution soln ls target idx -> do info <- getUserInfoOfAuth auth let name = codename info diff --git a/Version.hs b/Version.hs --- a/Version.hs +++ b/Version.hs @@ -11,4 +11,4 @@ module Version where version :: String -version = "0.6.1" +version = "0.6.2" diff --git a/intricacy.cabal b/intricacy.cabal --- a/intricacy.cabal +++ b/intricacy.cabal @@ -1,5 +1,5 @@ name: intricacy -version: 0.6.1 +version: 0.6.2 synopsis: A game of competitive puzzle-design homepage: http://mbays.freeshell.org/intricacy license: GPL-3 @@ -78,24 +78,25 @@ ghc-options: -no-hs-main include-dirs: /usr/include/SDL /usr/local/include/SDL c-sources: c_main.c - else - Buildable: False - if flag(Curses) - build-depends: hscurses >=1.4 - if flag(SDL) if flag(Curses) - main-is: MainBoth.hs + build-depends: hscurses >=1.4 + if flag(SDL) + if flag(Curses) + main-is: MainBoth.hs + else + main-is: MainSDL.hs else - main-is: MainSDL.hs + if flag(Curses) + main-is: MainCurses.hs + else + Buildable: False + -- XXX: there must be a neater way to prevent the cabal flag sat + -- solver from thinking it's acceptable to have both SDL and Curses be + -- False... but this will have to do for now: + build-depends: Unsatisfiable >= 1337 else - if flag(Curses) - main-is: MainCurses.hs - else - Buildable: False - -- XXX: there must be a neater way to prevent the cabal flag sat - -- solver from thinking it's acceptable to have both SDL and Curses be - -- False... but this will have to do for now: - build-depends: Unsatisfiable >= 1337 + main-is: MainBoth.hs + Buildable: False ghc-options: -fno-warn-tabs other-modules: AsciiLock, BinaryInstances, BoardColouring, Cache, Command,