intricacy 0.6.1 → 0.6.2

raw patch · 13 files changed

+137/−72 lines, 13 files

Files

• CursesUIMInstance.hs +27/−19
• EditGameState.hs +1/−3
• Interact.hs +17/−4
• InteractUtil.hs +16/−5
• MainState.hs +18/−1
• NEWS +8/−0
• Physics.hs +5/−3
• SDLRender.hs +7/−4
• SDLUI.hs +1/−1
• SDLUIMInstance.hs +17/−13
• Server.hs +2/−2
• Version.hs +1/−1
• intricacy.cabal +17/−16

@@ -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 ())

@@ -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 ]

@@ -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)

@@ -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)

@@ -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."     ]

@@ -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. 

@@ -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

@@ -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

@@ -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

@@ -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+        ]

@@ -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

@@ -11,4 +11,4 @@ module Version where  version :: String-version = "0.6.1"+version = "0.6.2"

@@ -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,