summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authormbays <>2016-07-31 22:01:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2016-07-31 22:01:00 (GMT)
commitec88ddbe092e2551ee75bf504c70eacc608d3048 (patch)
tree1300b396b646618babdbc6c7b75fd3cd749604e7
parent8296224200a08ad398b82f8ffd48fd8d5aea6003 (diff)
version 0.6.20.6.2
-rw-r--r--CursesUIMInstance.hs46
-rw-r--r--EditGameState.hs4
-rw-r--r--Interact.hs21
-rw-r--r--InteractUtil.hs21
-rw-r--r--MainState.hs19
-rw-r--r--NEWS8
-rw-r--r--Physics.hs8
-rw-r--r--SDLRender.hs11
-rw-r--r--SDLUI.hs2
-rw-r--r--SDLUIMInstance.hs30
-rw-r--r--Server.hs4
-rw-r--r--Version.hs2
-rw-r--r--intricacy.cabal33
13 files changed, 137 insertions, 72 deletions
diff --git a/CursesUIMInstance.hs b/CursesUIMInstance.hs
index 4423764..b10d7f4 100644
--- a/CursesUIMInstance.hs
+++ b/CursesUIMInstance.hs
@@ -169,6 +169,28 @@ drawLockInfo al@(ActiveLock name i) lockinfo = do
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 @@ instance UIMonad (StateT UIState IO) where
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
index db575fe..652e2f6 100644
--- a/EditGameState.hs
+++ b/EditGameState.hs
@@ -56,8 +56,6 @@ modTile tile pos lastPos painting st =
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 @@ modTile tile pos lastPos painting st =
_ -> (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
index 932469f..fa89283 100644
--- a/Interact.hs
+++ b/Interact.hs
@@ -130,10 +130,16 @@ processCommand IMPlay CmdOpen = do
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 @@ processCommand' IMMeta (CmdRegister _) = void.runMaybeT $ do
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 @@ processCommand' IMMeta CmdEdit = void.runMaybeT $ do
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
index 7cd907a..f8d0fa5 100644
--- a/InteractUtil.hs
+++ b/InteractUtil.hs
@@ -97,6 +97,11 @@ nextLock newer path = do
(\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 @@ setLockPath path = do
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 @@ confirm prompt = do
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 @@ textInput prompt maxlen hidden endOnMax mposss init = getText (fromMaybe "" init
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
index 84d7a0e..56d455a 100644
--- a/MainState.hs
+++ b/MainState.hs
@@ -132,7 +132,7 @@ data MainState
type MainStateT = StateT MainState
-data HelpPage = HelpPageInput | HelpPageGame
+data HelpPage = HelpPageInput | HelpPageGame | HelpPageFirstEdit
deriving (Eq, Ord, Show, Enum)
ms2im :: MainState -> InputMode
@@ -473,3 +473,20 @@ metagameHelpText =
, "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
index 731c413..fbfa324 100644
--- 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
index fc7fbe0..1ab703c 100644
--- a/Physics.hs
+++ b/Physics.hs
@@ -145,8 +145,10 @@ resolveForces plForces eForces eDominates st =
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 @@ resolveForces plForces eForces eDominates st =
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
index 46d1b0c..d4c6faa 100644
--- a/SDLRender.hs
+++ b/SDLRender.hs
@@ -377,10 +377,13 @@ renderGlyph (ShowButtonTextButton showing) centre@(SVec x y) size surf = do
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
index 4358c60..bf137c5 100644
--- a/SDLUI.hs
+++ b/SDLUI.hs
@@ -322,7 +322,7 @@ helpOfSelectable (SelScoreLock Nothing (Just AccessedEmpty) (ActiveLock name _))
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
index db1bfe6..1a64165 100644
--- a/SDLUIMInstance.hs
+++ b/SDLUIMInstance.hs
@@ -586,19 +586,11 @@ instance UIMonad (StateT UIState IO) where
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 @@ drawLockInfo al@(ActiveLock name idx) (Just lockinfo) = do
[ \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
index b714b22..2e52505 100644
--- a/Server.hs
+++ b/Server.hs
@@ -264,8 +264,8 @@ handleRequest dbpath mfeedPath req@(ClientRequest pv auth action) = do
|| 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
index 62c2ebc..f961b02 100644
--- 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
index 0e6187f..7c00daa 100644
--- 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 @@ executable intricacy
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,