intricacy 0.3.3 → 0.3.8

raw patch · 149 files changed

+685/−309 lines, 149 filesdep +SDL-mixerdep +Unsatisfiablebinary-added

Dependencies added: SDL-mixer, Unsatisfiable

Files

Command.hs +5/−4
CursesUIMInstance.hs +4/−1
GameStateTypes.hs +3/−0
Interact.hs +26/−14
InteractUtil.hs +16/−6
KeyBindings.hs +7/−6
MainState.hs +13/−3
Mundanities.hs +1/−1
NEWS +13/−0
Physics.hs +16/−5
README +1/−1
SDLRender.hs +50/−15
SDLUI.hs +279/−84
SDLUIMInstance.hs +182/−114
intricacy.cabal +20/−6
sounds/ballmove-01.ogg binary
sounds/ballmove-02.ogg binary
sounds/ballmove-03.ogg binary
sounds/ballmove-04.ogg binary
sounds/hookarmblocked-01.ogg binary
sounds/hookarmblocked-02.ogg binary
sounds/hookarmblocked-03.ogg binary
sounds/hookarmblocked-04.ogg binary
sounds/hookblocked-01.ogg binary
sounds/hookblocked-02.ogg binary
sounds/hookblocked-03.ogg binary
sounds/pivot-01.ogg binary
sounds/pivot-02.ogg binary
sounds/pivot-03.ogg binary
sounds/pivot-04.ogg binary
sounds/springcontract1-01.ogg binary
sounds/springcontract1-02.ogg binary
sounds/springcontract1-03.ogg binary
sounds/springcontract1-04.ogg binary
sounds/springcontract10-01.ogg binary
sounds/springcontract10-02.ogg binary
sounds/springcontract10-03.ogg binary
sounds/springcontract10-04.ogg binary
sounds/springcontract11-01.ogg binary
sounds/springcontract11-02.ogg binary
sounds/springcontract11-03.ogg binary
sounds/springcontract11-04.ogg binary
sounds/springcontract12-01.ogg binary
sounds/springcontract12-02.ogg binary
sounds/springcontract12-03.ogg binary
sounds/springcontract12-04.ogg binary
sounds/springcontract2-01.ogg binary
sounds/springcontract2-02.ogg binary
sounds/springcontract2-03.ogg binary
sounds/springcontract2-04.ogg binary
sounds/springcontract3-01.ogg binary
sounds/springcontract3-02.ogg binary
sounds/springcontract3-03.ogg binary
sounds/springcontract3-04.ogg binary
sounds/springcontract4-01.ogg binary
sounds/springcontract4-02.ogg binary
sounds/springcontract4-03.ogg binary
sounds/springcontract4-04.ogg binary
sounds/springcontract5-01.ogg binary
sounds/springcontract5-02.ogg binary
sounds/springcontract5-03.ogg binary
sounds/springcontract5-04.ogg binary
sounds/springcontract6-01.ogg binary
sounds/springcontract6-02.ogg binary
sounds/springcontract6-03.ogg binary
sounds/springcontract6-04.ogg binary
sounds/springcontract7-01.ogg binary
sounds/springcontract7-02.ogg binary
sounds/springcontract7-03.ogg binary
sounds/springcontract7-04.ogg binary
sounds/springcontract8-01.ogg binary
sounds/springcontract8-02.ogg binary
sounds/springcontract8-03.ogg binary
sounds/springcontract8-04.ogg binary
sounds/springcontract9-01.ogg binary
sounds/springcontract9-02.ogg binary
sounds/springcontract9-03.ogg binary
sounds/springcontract9-04.ogg binary
sounds/springextend1-01.ogg binary
sounds/springextend1-02.ogg binary
sounds/springextend1-03.ogg binary
sounds/springextend1-04.ogg binary
sounds/springextend10-01.ogg binary
sounds/springextend10-02.ogg binary
sounds/springextend10-03.ogg binary
sounds/springextend10-04.ogg binary
sounds/springextend11-01.ogg binary
sounds/springextend11-02.ogg binary
sounds/springextend11-03.ogg binary
sounds/springextend11-04.ogg binary
sounds/springextend12-01.ogg binary
sounds/springextend12-02.ogg binary
sounds/springextend12-03.ogg binary
sounds/springextend12-04.ogg binary
sounds/springextend2-01.ogg binary
sounds/springextend2-02.ogg binary
sounds/springextend2-03.ogg binary
sounds/springextend2-04.ogg binary
sounds/springextend3-01.ogg binary
sounds/springextend3-02.ogg binary
sounds/springextend3-03.ogg binary
sounds/springextend3-04.ogg binary
sounds/springextend4-01.ogg binary
sounds/springextend4-02.ogg binary
sounds/springextend4-03.ogg binary
sounds/springextend4-04.ogg binary
sounds/springextend5-01.ogg binary
sounds/springextend5-02.ogg binary
sounds/springextend5-03.ogg binary
sounds/springextend5-04.ogg binary
sounds/springextend6-01.ogg binary
sounds/springextend6-02.ogg binary
sounds/springextend6-03.ogg binary
sounds/springextend6-04.ogg binary
sounds/springextend7-01.ogg binary
sounds/springextend7-02.ogg binary
sounds/springextend7-03.ogg binary
sounds/springextend7-04.ogg binary
sounds/springextend8-01.ogg binary
sounds/springextend8-02.ogg binary
sounds/springextend8-03.ogg binary
sounds/springextend8-04.ogg binary
sounds/springextend9-01.ogg binary
sounds/springextend9-02.ogg binary
sounds/springextend9-03.ogg binary
sounds/springextend9-04.ogg binary
sounds/unlocked-01.ogg binary
sounds/unlocked-02.ogg binary
sounds/unlocked-03.ogg binary
sounds/unlocked-04.ogg binary
sounds/unlocked-05.ogg binary
sounds/wrenchblocked-01.ogg binary
sounds/wrenchblocked-02.ogg binary
sounds/wrenchblocked-03.ogg binary
sounds/wrenchscrape-01.ogg binary
sounds/wrenchscrape-02.ogg binary
sounds/wrenchscrape-03.ogg binary
sounds/wrenchscrape-04.ogg binary
tutorial/1-winning.text +1/−1
tutorial/2-hook.lock +0/−11
tutorial/2-hook.text +0/−1
tutorial/2-wrench.lock +17/−0
tutorial/2-wrench.text +1/−0
tutorial/3-hook.lock +11/−0
tutorial/3-hook.text +1/−0
tutorial/3-wrench.lock +0/−17
tutorial/3-wrench.text +0/−1
tutorial/4-plug.lock +17/−17
tutorial/4-plug.text +1/−1

Command.hs view

@@ -13,7 +13,7 @@ import GameStateTypes import Metagame -data Command = CmdDir WrHoSel HexDir | CmdRotate TorqueDir | CmdWait+data Command = CmdDir WrHoSel HexDir | CmdRotate WrHoSel TorqueDir | CmdWait 	| CmdMoveTo HexPos | CmdManipulateToolAt HexPos 	| CmdDrag HexPos HexDir 	| CmdToggle@@ -22,7 +22,7 @@ 	| CmdPaintFromTo (Maybe Tile) HexPos HexPos 	| CmdSelect | CmdUnselect 	| CmdDelete | CmdMerge-	| CmdMark | CmdJumpMark+	| CmdMark | CmdJumpMark | CmdReset 	| CmdPlay | CmdTest 	| CmdUndo | CmdRedo 	| CmdReplayForward Int | CmdReplayBack Int@@ -49,7 +49,7 @@ 	 describeCommand :: Command -> String describeCommand (CmdDir whs dir) = "move " ++ whsStr whs ++ " " ++ dirStr dir-describeCommand (CmdRotate dir) = "rotate " ++ (if dir == 1 then "counter" else "") ++ "clockwise"+describeCommand (CmdRotate whs dir) = "rotate " ++ whsStr whs ++ " " ++ (if dir == 1 then "counter" else "") ++ "clockwise" describeCommand CmdWait = "nothing" describeCommand CmdToggle = "toggle tool" describeCommand CmdOpen = "open lock"@@ -57,6 +57,7 @@ describeCommand CmdMerge = "merge with adjacent piece"  describeCommand CmdMark = "mark state" describeCommand CmdJumpMark = "jump to marked state"+describeCommand CmdReset = "jump to initial state" describeCommand CmdSelect = "select piece"  describeCommand CmdUnselect = "unselect piece" describeCommand CmdDelete = "delete piece"@@ -78,7 +79,7 @@ describeCommand (CmdPlayLockSpec mls) = "find lock by number" ++ maybe "" ((' ':).show) mls describeCommand (CmdDeclare mundecl) = "declare solution" ++ maybe "" (\_->" [specified solution]") mundecl describeCommand (CmdViewSolution mnote) = "view lock solution" ++ maybe "" (\_->" [specified solution]") mnote-describeCommand CmdSelectLock = "choose lock"+describeCommand CmdSelectLock = "choose lock by name" describeCommand CmdNextLock = "next lock" describeCommand CmdPrevLock = "previous lock" describeCommand CmdNextPage = "page forward through lists"

CursesUIMInstance.hs view

@@ -260,7 +260,7 @@ 		    void $ fillBox (CVec y (s+4+length str+1)) (CVec y (w-1)) 5 GravLeft $ 			[ (`drawActiveLock` al) | al <- accessed] -    drawAlerts alerts =+    reportAlerts _ alerts = 	do mapM_ drawAlert alerts 	   unless (null alerts)  	    $ do refresh@@ -302,6 +302,9 @@ 	modify $ \s -> s { uiKeyBindings = 		Map.insertWith (\[bdg] -> \bdgs -> if bdg `elem` bdgs then delete bdg bdgs else bdg:bdgs) 		    mode [(ch,cmd)] $ uiKeyBindings s }+    getUIBinding mode cmd = do+	bdgs <- getBindings mode+	return $ maybe "" showKey $ findBinding bdgs cmd      initUI =  	do liftIO CursesH.start

GameStateTypes.hs view

@@ -81,4 +81,7 @@ -- |Alert: for passing information about physics processing to the UI data Alert = AlertCollision HexPos | AlertBlockingForce Force 	   | AlertResistedForce Force | AlertBlockedForce Force+	   | AlertAppliedForce Force | AlertDivertedWrench PieceIdx+	   | AlertUnlocked+	   | AlertIntermediateState GameState     deriving (Eq, Ord, Show)

Interact.hs view

@@ -63,17 +63,18 @@  	testAuth 	refreshUInfoUI+	tbdg <- lift $ getUIBinding IMMeta CmdTutorials 	(isNothing <$> gets curAuth >>=) $ flip when $-	    lift $ drawMessage "Welcome. To play the tutorial levels, press 'T'."+	    lift $ drawMessage $ "Welcome. To play the tutorial levels, press '"++tbdg++"'." 	)-    setMark '0'+    setMark startMark     loop      where 	loop = do 	    mainSt <- get 	    let im = ms2im mainSt-	    when (im == IMPlay && not (psSolved mainSt)) checkWon+	    when (im == IMPlay) checkWon 	    when (im == IMMeta) $ (checkAsyncErrors >>) $ void.runMaybeT $  		mourNameSelected >>= 		    flip when (lift purgeInvalidUndecls)@@ -115,7 +116,7 @@ processCommand' :: UIMonad uiM => InputMode -> Command -> StateT MainState uiM () processCommand' im CmdHelp = lift $ do     showHelp im-    void $ textInput "[press a key]" 1 False True Nothing Nothing+    void $ textInput "[press a key or RMB]" 1 False True Nothing Nothing processCommand' im CmdBind = lift $ flip (>>) (drawMessage "") $ void $ runMaybeT $ do 	lift $ drawMessage "Command to bind: " 	cmd <- msum $ repeat $ do@@ -133,14 +134,15 @@     guard $ im `elem` [IMEdit, IMPlay, IMReplay]     str <- MaybeT $ lift $ textInput "Mark: " 1 False True Nothing Nothing     ch <- MaybeT $ return $ listToMaybe str-    guard $ ch `notElem` ['0', '\'']+    guard $ ch `notElem` [startMark, '\'']     lift $ setMark ch processCommand' im CmdJumpMark = void.runMaybeT $ do     guard $ im `elem` [IMEdit, IMPlay, IMReplay]     str <- MaybeT $ lift $ textInput-	"Jump to mark ('0' for starting state): " 1 False True Nothing Nothing+	"Jump to mark (\"'\" to unjump): " 1 False True Nothing Nothing     ch <- MaybeT $ return $ listToMaybe str     lift $ jumpMark ch+processCommand' im CmdReset = jumpMark startMark processCommand' IMMeta (CmdSelCodename mname) = void.runMaybeT $ do     name <- msum [ MaybeT $ return $ mname 	, do@@ -320,7 +322,11 @@ processCommand' IMMeta (CmdPlaceLock midx) = void.runMaybeT $ do     mourNameSelected >>= guard     ourName <- mgetOurName-    (lock,msoln) <- MaybeT $ gets curLock+    (lock,msoln) <- msum [MaybeT $ gets curLock+	, do+	    ebdg <- lift.lift $ getUIBinding IMMeta CmdEdit+	    lift.lift $ drawError $ "No lock selected; '"++ebdg++"' to edit one."+	    mzero]     lockpath <- lift $ gets curLockPath     ourUInfo <- mgetUInfo ourName     idx <- msum [ MaybeT $ return midx@@ -338,7 +344,7 @@ processCommand' IMMeta CmdSelectLock = void.runMaybeT $ do     lockdir <- liftIO $ confFilePath "locks"     paths <- liftIO $ map (drop (length lockdir + 1)) <$> getDirContentsRec lockdir-    path <- MaybeT $ lift $ textInput "Select lock:" 1024 False False (Just paths) Nothing+    path <- MaybeT $ lift $ textInput "Lock name:" 1024 False False (Just paths) Nothing     lift $ setLockPath path processCommand' IMMeta CmdNextLock =     gets curLockPath >>= liftIO . nextLock True >>= setLockPath@@ -384,15 +390,18 @@ 	let name = tuts !! (i-1) 	let pref = tutdir ++ [pathSeparator] ++ name 	(lock,_) <- MaybeT $ liftIO $ readLock (pref ++ ".lock")-	text <- MaybeT $ liftIO $ listToMaybe <$> readStrings (pref ++ ".text")+	text <- liftIO $ (fromMaybe "" . listToMaybe) <$> (readStrings (pref ++ ".text") `catchIO` const (return [])) 	_ <- solveLock lock $ Just $ "Tutorial " ++ show i ++ ": " ++ text 	if i+1 <= length tuts then do-		confirmOrBail $ "Tutorial level completed! Play next tutorial level (" ++ show (i+1) ++ ")?"+		-- confirmOrBail $ "Tutorial level completed! Play next tutorial level (" ++ show (i+1) ++ ")?" 		dotut $ i+1 	    else lift $ do  		mauth <- gets curAuth+		cbdg <- lift $ getUIBinding IMMeta $ CmdSelCodename Nothing+		rbdg <- lift $ getUIBinding IMMeta CmdRegister 		lift $ drawMessage $ if isNothing mauth-		    then "Tutorial completed! To play on the server, pick a codename ('C') and register it ('R')."+		    then "Tutorial completed! To play on the server, pick a codename ('"++cbdg+++			"') and register it ('"++rbdg++"')." 		    else "Tutorial completed!"     dotut i processCommand' IMMeta CmdShowRetired = void.runMaybeT $ do@@ -452,7 +461,10 @@ 	    | whs == WHSWrench || (whs == WHSSelected && wsel) = 		Just $ WrenchPush dir 	    | otherwise = Just $ HookPush dir-	torque dir = Just $ HookTorque dir+	torque whs dir +	    | whs == WHSHook || (whs == WHSSelected && not wsel)=+		Just $ HookTorque dir+	    | otherwise = Nothing 	(wsel', pm) = 	    case cmd of 		CmdTile (WrenchTile _) -> (True, Nothing)@@ -460,7 +472,7 @@ 		CmdTile (ArmTile _ _) -> (False, Nothing) 		CmdToggle -> (not wsel, Nothing) 		CmdDir whs dir -> (wsel, push whs dir)-		CmdRotate dir -> (wsel, torque dir)+		CmdRotate whs dir -> (wsel, torque whs dir) 		CmdWait -> (wsel, Just NullPM) 		CmdSelect -> (wsel, Just NullPM) 		_ -> (wsel, Nothing)@@ -551,7 +563,7 @@ 		guard $ idx' == selIdx 		lift.lift $ warpPointer $ pos' 	    | pos' <- [dir<+>pos, pos] ]-processCommand' IMEdit (CmdRotate dir) = do+processCommand' IMEdit (CmdRotate _ dir) = do     selPiece <- gets selectedPiece     case selPiece of 	Nothing -> return ()

InteractUtil.hs view

@@ -42,9 +42,16 @@ checkWon = do     st <- gets psCurrentState     frame <- gets psFrame-    when (checkSolved (frame,st)) $ do-	modify $ \ps -> ps {psSolved = True}-	lift $ drawMessage "Unlocked!"+    wasSolved <- gets psSolved+    let solved = checkSolved (frame,st)+    when (solved /= wasSolved) $ do+	modify $ \ps -> ps {psSolved = solved}+	obdg <- lift $ getUIBinding IMPlay CmdOpen+	lift $ if solved then do+		drawMessage $ "Unlocked! '"++obdg++"' to open."+		reportAlerts st [AlertUnlocked]+	    else do+		drawMessage "" 	{- 	pms <- (reverse.(map snd)) `liftM` gets psGameStateMoveStack 	let wfname = fromMaybe "unnamed.lock" fname @@ -56,7 +63,7 @@     let (st',alerts) = runWriter $ resolveForces 	    (Vector.singleton (ForceChoice [force])) Vector.empty 	    (\_ _->False) st-    lift (drawAlerts alerts) >> pushEState st'+    lift (reportAlerts st' alerts) >> pushEState st' drawTile pos tile painting = do     modify $ \es -> es {selectedPiece = Nothing}     lastMP <- gets lastModPos@@ -85,7 +92,7 @@ doPhysicsTick :: UIMonad uiM => PlayerMove -> GameState -> uiM (GameState, [Alert]) doPhysicsTick pm st =     let r@(st',alerts) = runWriter $ physicsTick pm st in-    drawAlerts alerts >> return r+    reportAlerts st' alerts >> return r  nextLock :: Bool -> FilePath -> IO FilePath nextLock newer path = do@@ -106,8 +113,9 @@ declare undecl@(Undeclared soln ls al) = do     ourName <- mgetOurName     ourUInfo <- mgetUInfo ourName+    pbdg <- lift.lift $ getUIBinding IMMeta $ CmdPlaceLock Nothing     idx <- askLockIndex "Secure behind which lock?"-	"You first need to place a lock to secure your solution behind."+	("You first need to place ('"++pbdg++"') a lock to secure your solution behind.") 	(\i -> isJust $ userLocks ourUInfo ! i)     guard $ isJust $ userLocks ourUInfo ! idx     lift $ do@@ -117,6 +125,8 @@ 	-- and explicit refreshes to reveal it, we just invalidate all UInfos. 	invalidateAllUInfo 	refreshUInfoUI++startMark = '^'  jumpMark :: UIMonad uiM => Char -> StateT MainState uiM () jumpMark ch = do

KeyBindings.hs view

@@ -42,8 +42,8 @@     , ('U', CmdDir WHSWrench $ neg hw)     , ('Y', CmdDir WHSWrench hv)     , ('N', CmdDir WHSWrench $ neg hv)-    , ('k', CmdRotate 1)-    , ('j', CmdRotate $ -1)+    , ('k', CmdRotate WHSHook 1)+    , ('j', CmdRotate WHSHook $ -1)     ] qwertyLeftHex =     [ ('d', CmdDir WHSHook hu)@@ -58,8 +58,8 @@     , ('E', CmdDir WHSWrench $ neg hw)     , ('W', CmdDir WHSWrench hv)     , ('X', CmdDir WHSWrench $ neg hv)-    , ('q', CmdRotate 1)-    , ('c', CmdRotate $ -1)+    , ('q', CmdRotate WHSHook 1)+    , ('c', CmdRotate WHSHook $ -1)     , ('S', CmdWait)     , ('s', CmdWait)     ]@@ -80,8 +80,8 @@     , ('9', CmdDir WHSSelected $ neg hw)     , ('7', CmdDir WHSSelected hv)     , ('3', CmdDir WHSSelected $ neg hv)-    , ('8', CmdRotate 1)-    , ('2', CmdRotate $ -1)+    , ('8', CmdRotate WHSSelected 1)+    , ('2', CmdRotate WHSSelected $ -1)     ]  miscLockGlobal = lowerToo@@ -90,6 +90,7 @@     , ('R', CmdRedo)     , (ctrl 'R', CmdRedo)     , (ctrl 'U', CmdUndo)+    , ('^', CmdReset)     , ('.', CmdWait)     , ('Z', CmdWait)     , ('M', CmdMark)

MainState.hs view

@@ -49,7 +49,7 @@     initUI :: m Bool     endUI :: m ()     drawMainState :: StateT MainState m ()-    drawAlerts :: [Alert] -> m ()+    reportAlerts :: GameState -> [Alert] -> m ()     drawMessage :: String -> m ()     drawError :: String -> m ()     showHelp :: InputMode -> m ()@@ -57,6 +57,7 @@     getChRaw :: m ( Maybe Char )     unblockInput :: m (IO ())     setUIBinding :: InputMode -> Command -> Char -> m ()+    getUIBinding :: InputMode -> Command -> m String     getDrawImpatience :: m ( Int -> IO () )     warpPointer :: HexPos -> m ()     setYNButtons :: m ()@@ -349,14 +350,23 @@     m <* (liftIO $ atomically $ writeTVar finishedTV True)  getRelScore :: (UIMonad uiM) => Codename -> StateT MainState uiM (Maybe Int)-getRelScore name = runMaybeT $ do+getRelScore name = (fst<$>) <$> getRelScoreDetails name+getRelScoreDetails name = runMaybeT $ do     ourName <- mgetOurName     guard $ ourName /= name     uinfo <- mgetUInfo name     ourUInfo <- mgetUInfo ourName-    return $ countUnaccessedBy ourUInfo name - countUnaccessedBy uinfo ourName+    let (pos,neg) = (countUnaccessedBy ourUInfo name, countUnaccessedBy uinfo ourName)+    return $ (pos-neg,(pos,neg))     where 	countUnaccessedBy ui name = length $ filter (not.snd) $ getAccessInfo ui name ++accessedAL :: (UIMonad uiM) => ActiveLock -> StateT MainState uiM Bool+accessedAL (ActiveLock name idx) = (isJust <$>) $ runMaybeT $ do+    ourName <- mgetOurName+    guard $ ourName /= name+    uinfo <- mgetUInfo name+    guard $ snd $ getAccessInfo uinfo ourName !! idx  getNotesReadOn :: UIMonad uiM => LockInfo -> StateT MainState uiM [NoteInfo] getNotesReadOn lockinfo = (fromMaybe [] <$>) $ runMaybeT $ do

Mundanities.hs view

@@ -34,7 +34,7 @@ tryRead = (fst <$>) . listToMaybe . reads  readStrings :: FilePath -> IO [String]-readStrings = (lines . BSC.unpack <$>) . BS.readFile+readStrings file = (lines . BSC.unpack) <$> BS.readFile file  writeReadFile :: (Show a) => FilePath -> a -> IO () writeReadFile file x = do

NEWS view

@@ -1,3 +1,16 @@+0.3.8:+    Animate to show the two physics phases in each turn (thanks dormir)+0.3.7.1:+    Minor UI improvements (thanks dormir)+0.3.7:+    Metagame help text+0.3.6:+    Sound effects.+0.3.5:+    Button help text.+0.3.4:+    Tutorial tweaks.+    Yet more misc minor UI improvements. 0.3.3:     Misc minor UI improvements. 0.3.2:

Physics.hs view

@@ -101,6 +101,7 @@ 	(efs, dominates) = envForces st     in do 	st' <- resolveForces tfs Vector.empty (\_ _->False) $ setTools pm st+	tell $ [AlertIntermediateState st'] 	resolveForces Vector.empty efs dominates $ setTools NullPM st'  type Source = Int@@ -123,13 +124,17 @@ 	checkInconsistent :: Int -> Int -> [[Force]] -> Writer [Alert] [Int] 	checkInconsistent i j fss =  	    let st' = foldr applyForce st $ nub $ concat fss-		inconsistencies = [ [f,f']+		(inconsistencies,cols) = runWriter $ sequence+		    [ tell cols >> return [f,f'] 		    | [f,f'] <- sequence fss-		    , if forceIdx f == forceIdx f'-			then f /= f'-			else not.null $ collisions st' (forceIdx f) (forceIdx f') ]+		    , (True,cols) <- [+			    if forceIdx f == forceIdx f'+			    then (f /= f',[])+			    else let cols = collisions st' (forceIdx f) (forceIdx f')+				in (not $ null cols, cols) ]] 	    in do 		tell $ map AlertBlockingForce $ concat inconsistencies+		tell $ map AlertCollision cols 		return $ if null inconsistencies then [] 		    else if i==j then [i] 		    else if dominates i j then [j]@@ -138,7 +143,11 @@  	stopWrench idx = setPiece idx (Wrench zero) 	stopBlockedWrenches fs st' = foldr stopWrench st' [-	    idx | f <- fs, let idx = forceIdx f, isWrench.placedPiece $ getpp st' idx ]+	    forceIdx f | f <- fs, isWrench.placedPiece $ getForcedpp st' f ]+	divertedWrenches fs = [ idx+	    | Push idx dir <- fs+	    , Wrench mom <- [placedPiece $ getpp st idx]+	    , mom `notElem` [zero,dir] ]     in do  	let unresisted = [ s | (s, (_, Any False)) <- enumVec $ fmap runWriter initGrps ] @@ -151,6 +160,8 @@ 	let [blocked, unblocked] = map (nub.concat.(map (fst.runWriter)).Vector.toList) $ 		(\(x,y) -> [x,y]) $ Vector.partition (getAny.snd.runWriter) grps 	tell $ map AlertBlockedForce blocked+	tell $ map AlertAppliedForce unblocked+	tell $ map AlertDivertedWrench $ divertedWrenches unblocked 	return $ stopBlockedWrenches blocked $ foldr applyForce st unblocked      applyForce :: Force -> GameState -> GameState

README view

@@ -132,7 +132,7 @@ directed graph whose nodes are the blocks and whose edges are the springs is required to be acyclic. A spring may also be rooted in a pivot. -I will now attempt to describe in full excrutiating detail the game physics,+I will now attempt to describe in full excruciating detail the game physics, i.e. the algorithm used to determine what happens on a turn. You shouldn't need to read this to play the game! Experimenting and turning on blockage annotations should be enough.

SDLRender.hs view

@@ -47,11 +47,16 @@     aaPolygon' surf verts $ opaquify rimCol     return () -rimmedCircle surf centre@(SVec x y) rad fillCol rimCol = do-    filledCircle surf (fromIntegral x) (fromIntegral y) (fromIntegral rad) fillCol-    aaCircle' surf (fromIntegral x) (fromIntegral y) (fromIntegral rad) $ opaquify rimCol-    return ()+circleAt surf centre@(SVec x y) rad col =+    aaCircle' surf (fromIntegral x) (fromIntegral y) (fromIntegral rad) col +filledCircleAt surf centre@(SVec x y) rad col =+    filledCircle surf (fromIntegral x) (fromIntegral y) (fromIntegral rad) col++rimmedCircle surf centre@(SVec x y) rad fillCol rimCol = void $ do+    filledCircleAt surf centre rad fillCol+    circleAt surf centre rad $ opaquify rimCol+ type Glyph = SVec -> Int -> Surface -> IO ()  ysize :: Int -> Int@@ -107,12 +112,13 @@ 		]  tileGlyph (SpringTile extn dir) col centre size surf =-    aaLines surf points $ bright col+    aaLines surf points $ brightness col 	where 	    n = 3*case extn of 		Stretched -> 1 		Relaxed -> 2 		Compressed -> 3+	    brightness = if extn == Relaxed then dim else bright 	    dir' = if dir == zero then hu else dir 	    (sx,sy) = corner centre size (hextant dir' - 1) 	    (offx,offy) = corner centre size (hextant dir')@@ -205,8 +211,14 @@ 	--to' = corner centre size $ (hextant dir) - 1 	 collisionMarker :: Glyph-collisionMarker centre size surf =-    rimmedCircle surf centre (size`div`3) (bright orange) $ bright orange+collisionMarker centre@(SVec x y) size surf = void $ do+    -- rimmedCircle surf centre (size`div`3) (bright purple) $ bright purple+    aaLine surf `uncurry` start `uncurry` end $ col+    circleAt surf centre rad col+    where+	[start,end] = map (corner centre (size`div`2)) [0,3]+	rad = ysize size+	col = dim purple  hollowGlyph :: Pixel -> Glyph hollowGlyph col centre size surf =@@ -231,13 +243,37 @@ 	    (SVec `uncurry` corner centre (size`div`2) h) (size`div`2) surf) 	[0,2,4] -showBlocksButton :: Bool -> Glyph+data ShowBlocks = ShowBlocksBlocking | ShowBlocksAll | ShowBlocksNone+    deriving (Eq, Ord, Show, Read)++showBlocksButton :: ShowBlocks -> Glyph showBlocksButton showing centre size surf = do-    tileGlyph (BlockTile []) (dim red) centre size surf-    when showing $ blockedPush hu (bright orange) centre size surf+    tileGlyph (BlockTile []) (dim blue) centre size surf+    when (showing == ShowBlocksAll) $+	blockedPush hu (bright orange) centre size surf+    when (showing /= ShowBlocksNone) $+	blockedPush hw (bright purple) centre size surf -whsButtonsButton :: WrHoSel -> Glyph-whsButtonsButton whs centre size surf = do+showButtonTextButton :: Bool -> Glyph+showButtonTextButton showing centre@(SVec x y) size surf = do+    buttonGlyph (dim cyan) (SVec `uncurry` edge centre (size`div`2) (neg hu)) (size`div`2) surf+    when showing $+	sequence_ [ pixel surf (fromIntegral $ x+size`div`3+(i*size`div`4)) (fromIntegral $ y - size`div`4) (bright cyan)+	    | i <- [-1..1] ]++useSoundsButton :: Bool -> Glyph+useSoundsButton use centre@(SVec x y) size surf = sequence_+    [ arc surf (fromIntegral $ x - (size`div`2)) (fromIntegral y) r (-20) 20+	(if use then bright green else dim red)+    | r <- map fromIntegral $ map (*(size`div`3)) [1,2,3] ]++whsButtonsButton :: Maybe WrHoSel -> Glyph+whsButtonsButton Nothing centre size surf =+    buttonGlyph (dim red) centre (size`div`3) surf+    >> sequence_ [ buttonGlyph (dim blue)+	(SVec `uncurry` edge centre (size`div`2) dir) (size`div`3) surf+	| dir <- hexDirs ]+whsButtonsButton (Just whs) centre size surf = do     when (whs /= WHSHook) $ 	tileGlyph (WrenchTile zero) col (miniCentre 0) miniSize surf     when (whs /= WHSWrench) $ do@@ -384,8 +420,8 @@ drawBasicBG maxR = sequence_ [ drawAtRel (hollowGlyph $ colAt v) v | v <- hexDisc maxR ]     where 	colAt v@(HexVec hx hy hz) = let-		[r,g,b] = map (\h -> fromIntegral $ ((0xff*)$ abs h)`div`maxR) [hx,hy,hz]-		a = fromIntegral $ (0xb0 * (maxR - abs (hexLen v)))`div`maxR+		[r,g,b] = map (\h -> fromIntegral $ ((0xff*)$ 5 + abs h)`div`maxR) [hx,hy,hz]+		a = fromIntegral $ (0x90 * (maxR - abs (hexLen v)))`div`maxR 	    in rgbaToPixel (r,g,b,a)  drawAt :: Glyph -> HexPos -> RenderM ()@@ -398,7 +434,6 @@ 	liftIO $ gl cpos size surf  messageCol = white-accessedCol = green dimWhiteCol = Pixel 0xa0a0a000 buttonTextCol = white errorCol = red

SDLUI.hs view

@@ -8,6 +8,8 @@ -- You should have received a copy of the GNU General Public License -- along with this program.  If not, see http://www.gnu.org/licenses/. +{-# OPTIONS_GHC -cpp #-}+ module SDLUI where  import Graphics.UI.SDL hiding (flip)@@ -26,8 +28,14 @@ import Data.List import Data.Ratio import Data.Function (on)+import System.FilePath --import Debug.Trace (traceShow) +#ifdef SOUND+import Graphics.UI.SDL.Mixer+import System.Random (randomRIO)+#endif+ import Hex import Command import GameState (stateBoard)@@ -35,6 +43,7 @@ import BoardColouring import Lock import Physics+import GameState import KeyBindings import Mundanities import Metagame@@ -61,21 +70,34 @@     , message::Maybe (Pixel, String)     , hoverStr :: Maybe String     , dispCentre::HexPos-    , dispLastCol::PieceColouring }+    , dispLastCol::PieceColouring+    , animFrame::Int+    , nextAnimFrameAt::Maybe Word32+    , fps::Int+#ifdef SOUND+    , sounds::Map String [Chunk]+#endif+    }     deriving (Eq, Ord, Show) type UIM = StateT UIState IO nullUIState = UIState 0 0 Nothing Nothing Nothing Map.empty Map.empty []     defaultUIOptions Nothing Map.empty Nothing Nothing 0 0 Nothing Nothing Nothing-    (zero,False) Nothing Nothing (PHS zero) Map.empty+    (zero,False) Nothing Nothing (PHS zero) Map.empty 0 Nothing 25+#ifdef SOUND+    Map.empty+#endif  data UIOptions = UIOptions     { useFiveColouring::Bool-    , showBlocks::Bool-    , whsButtons::WrHoSel+    , showBlocks::ShowBlocks+    , whsButtons::Maybe WrHoSel     , useBackground::Bool+    , showButtonText::Bool+    , useSounds::Bool+    , uiAnimTime::Word32     }     deriving (Eq, Ord, Show, Read)-defaultUIOptions = UIOptions False False WHSSelected True+defaultUIOptions = UIOptions False ShowBlocksBlocking Nothing True True True 50 modifyUIOptions f = modify $ \s -> s { uiOptions = f $ uiOptions s }  renderToMain :: RenderM a -> UIM a@@ -107,99 +129,114 @@     modify $ \ds -> ds { lastFrameTicks = now }  -data Button = Button { buttonPos::HexVec, buttonCmd::Command }+data Button = Button { buttonPos::HexVec, buttonCmd::Command, buttonHelp::[ButtonHelp] }     deriving (Eq, Ord, Show) type ButtonGroup = ([Button],(Int,Int))-singleButton :: HexVec -> Command -> Int -> ButtonGroup-singleButton pos cmd col = ([Button pos cmd], (col,0))+type ButtonHelp = (String, HexVec)+singleButton :: HexVec -> Command -> Int -> [ButtonHelp] -> ButtonGroup+singleButton pos cmd col helps = ([Button pos cmd helps], (col,0)) getButtons :: InputMode -> UIM [ ButtonGroup ] getButtons mode = do-    whs <- gets $ whsButtons.uiOptions+    mwhs <- gets $ whsButtons.uiOptions     cntxtButtons <- gets contextButtons     return $ cntxtButtons ++ global ++ case mode of  	IMEdit -> [-	    singleButton (tl<+>hv) CmdTest 4-	    , singleButton (tl<+>(neg hw)) CmdPlay 2+	    singleButton (tl<+>hv<+>neg hw) CmdTest 4 [("test", hu<+>neg hw)]+	    , singleButton (tl<+>(neg hw)) CmdPlay 2 [("play", hu<+>neg hw)] 	    , markGroup-	    , singleButton (br<+>2<*>hu) CmdWriteState 2-	    , ( [ Button (bl<+>dir) (CmdDir WHSSelected dir) | dir <- hexDirs ] ++-		[ Button (bl<+>((-2)<*>hv)) (CmdRotate (-1))-		, Button (bl<+>((-2)<*>hw)) (CmdRotate 1) ], (4,0) )-	    , ( [ Button bl CmdSelect ], (0,0))-	    , ([Button (paintButtonStart <+> hu <+> i<*>hv) (paintTileCmds!!i)+	    , singleButton (br<+>2<*>hu) CmdWriteState 2 [("save", hu<+>neg hw)]+	    , ( [ Button (bl<+>dir) (CmdDir WHSSelected dir) [] | dir <- hexDirs ] +++		[ Button (bl<+>((-2)<*>hv)) (CmdRotate WHSSelected (-1)) []+		, Button (bl<+>((-2)<*>hw)) (CmdRotate WHSSelected 1) [] ], (4,0) )+	    , ( [ Button bl CmdSelect [] ], (0,0))+	    , ([Button (paintButtonStart <+> hu <+> i<*>hv) (paintTileCmds!!i) [] 		| i <- take (length paintTiles) [0..] ],(5,0)) 	    ] 	IMPlay -> -	    [ markGroup-	    , ( [ Button bl CmdWait ], (0,0))-	    , ( [ Button (bl<+>dir) (CmdDir whs dir) | dir <- hexDirs ], (4,0) )-	    ] ++-	    (if whs == WHSWrench then [] else-		[ ( [ Button (bl<+>((-2)<*>hv)) (CmdRotate (-1))-		    , Button (bl<+>((-2)<*>hw)) (CmdRotate 1)-		    ], (4,0) )-	    ]) ++-	    (if whs /= WHSSelected then [] else-		[ ( [ Button (bl<+>(2<*>hv)<+>hw) (CmdTile $ HookTile)-		    , Button (bl<+>(2<*>hv)) (CmdTile $ WrenchTile zero)-		    ], (2,0) )-	    ]) ++-	    [ singleButton tr CmdOpen 1 ]+	    [ markGroup ]+	    ++ case mwhs of+		Nothing -> []+		Just whs -> +		    [ ( [ Button bl CmdWait [] ], (0,0))+		    , ( [ Button (bl<+>dir) (CmdDir whs dir) +			    (if dir==hu then [("move",hu<+>neg hw),(whsStr whs,hu<+>neg hv)] else [])+			| dir <- hexDirs ], (4,0) )+		    ] +++		    (if whs == WHSWrench then [] else+			[ ( [ Button (bl<+>((-2)<*>hv)) (CmdRotate whs (-1)) [("turn",hu<+>neg hw),("cw",hu<+>neg hv)]+			    , Button (bl<+>((-2)<*>hw)) (CmdRotate whs 1) [("turn",hu<+>neg hw),("ccw",hu<+>neg hv)]+			    ], (4,0) )+		    ]) +++		    (if whs /= WHSSelected then [] else+			[ ( [ Button (bl<+>(2<*>hv)<+>hw<+>neg hu) (CmdTile $ HookTile) [("select",hu<+>neg hw),("hook",hu<+>neg hv)]+			    , Button (bl<+>(2<*>hv)<+>neg hu) (CmdTile $ WrenchTile zero) [("select",hu<+>neg hw),("wrench",hu<+>neg hv)]+			    ], (2,0) ) ])+	    ++ [ singleButton tr CmdOpen 1 [("open", hu<+>neg hw)] ] 	IMReplay -> [ markGroup ] 	IMMeta ->-	    [ singleButton serverPos CmdSetServer 2-	    , singleButton (serverPos<+>neg hu) CmdToggleCacheOnly 0-	    , singleButton lockLinePos CmdSelectLock 4-	    , singleButton (miniLockPos <+> 2<*>hv <+> neg hu <+> hw) CmdEdit 2-	    , singleButton (codenamePos <+> neg hu) (CmdSelCodename Nothing) 2-	    , singleButton (serverPos <+> 2<*>neg hv <+> hw) CmdTutorials 1+	    [ singleButton serverPos CmdSetServer 2 [("set server",2<*>neg hw)]+	    , singleButton (serverPos<+>neg hu) CmdToggleCacheOnly 0 [("cache only",3<*>hw<+>2<*>neg hu)]+	    , singleButton lockLinePos CmdSelectLock 4 [("select lock",2<*>neg hw)]+	    , singleButton (miniLockPos <+> 2<*>hv <+> neg hu) CmdEdit 2 [("edit",hv<+>4<*>neg hu),("lock",hw<+>4<*>neg hu)]+	    , singleButton (codenamePos <+> neg hu) (CmdSelCodename Nothing) 2 [("code",hv<+>4<*>neg hu),("name",hw<+>4<*>neg hu)]+	    , singleButton (serverPos <+> 2<*>neg hv <+> 2<*>hw) CmdTutorials 1 [("play",hu<+>neg hw),("tut",hu<+>neg hv)] 	    ] 		 	_ -> [] 	where-	    markGroup = ([Button (tl<+>hw) CmdMark, Button (tl<+>hw<+>neg hu) CmdJumpMark],(0,0))+	    markGroup = ([Button (tl<+>hw) CmdMark [("set",hu<+>neg hw),("mark",hu<+>neg hv)]+		, Button (tl<+>hw<+>hv) CmdJumpMark [("jump",hu<+>neg hw),("mark",hu<+>neg hv)]+		, Button (tl<+>hw<+>2<*>hv) CmdReset [("jump",hu<+>neg hw),("start",hu<+>neg hv)]],(0,1)) 	    global = if mode == IMTextInput then [] else-		[ singleButton br CmdQuit 0-		, singleButton (tr <+> 3<*>hv <+> 3<*>hu) CmdHelp 3 ]+		[ singleButton br CmdQuit 0 [("quit",hu<+>neg hw)]+		, singleButton (tr <+> 3<*>hv <+> 3<*>hu) CmdHelp 3 [("help",hu<+>neg hw)] ] 	    tr = periphery 0 	    tl = periphery 2 	    bl = periphery 3 	    br = periphery 5 +data AccessedMethod = AccessedSolved | AccessedPublic | AccessedReadNotes | AccessedUndeclared+    deriving (Eq, Ord, Show) data Selectable = SelOurLock     | SelLock ActiveLock-    | SelLockUnset ActiveLock-    | SelSelectedCodeName-    | SelOurAL+    | SelLockUnset Bool ActiveLock+    | SelSelectedCodeName Codename+    | SelRelScore Int+    | SelScoreLock (Maybe Codename) Bool ActiveLock     | SelUndeclared Undeclared     | SelReadNote NoteInfo+    | SelReadNoteSlot     | SelSolution NoteInfo     | SelAccessed Codename     | SelRandom Codename     | SelSecured NoteInfo     | SelOldLock LockSpec+    | SelPublicLock+    | SelAccessedMethod AccessedMethod     deriving (Eq, Ord, Show)  registerSelectable v r s =     modify $ \ds -> ds {metaSelectables = foldr 	(`Map.insert` s) (metaSelectables ds) $ map (v<+>) $ hexDisc r} registerButtonGroup g = modify $ \ds -> ds {contextButtons = g:contextButtons ds}-registerButton pos cmd col = registerButtonGroup $ singleButton pos cmd col+registerButton pos cmd col helps = registerButtonGroup $ singleButton pos cmd col helps clearSelectables,clearButtons :: UIM () clearSelectables = modify $ \ds -> ds {metaSelectables = Map.empty} clearButtons = modify $ \ds -> ds {contextButtons = []}  registerUndoButtons noUndo noRedo = do-    unless noUndo $ registerButton (periphery 2) CmdUndo 0-    unless noRedo $ registerButton (periphery 2<+>neg hu) CmdRedo 2+    unless noUndo $ registerButton (periphery 2<+>hu) CmdUndo 0 [("undo",hu<+>neg hw)]+    unless noRedo $ registerButton (periphery 2<+>hu<+>neg hv) CmdRedo 2 [("redo",hu<+>neg hw)]  commandOfSelectable IMMeta SelOurLock _ = CmdEdit commandOfSelectable IMMeta (SelLock (ActiveLock _ i)) False = CmdSolve (Just i) commandOfSelectable IMMeta (SelLock (ActiveLock _ i)) True = CmdPlaceLock (Just i)-commandOfSelectable IMMeta (SelLockUnset (ActiveLock _ i)) _ = CmdPlaceLock (Just i)-commandOfSelectable IMMeta SelSelectedCodeName False = CmdSelCodename Nothing-commandOfSelectable IMMeta SelSelectedCodeName True = CmdHome-commandOfSelectable IMMeta SelOurAL _ = CmdHome+commandOfSelectable IMMeta (SelScoreLock Nothing _ (ActiveLock _ i)) False = CmdSolve (Just i)+commandOfSelectable IMMeta (SelScoreLock Nothing _ (ActiveLock _ i)) True = CmdPlaceLock (Just i)+commandOfSelectable IMMeta (SelScoreLock (Just _) _ _) _ = CmdHome+commandOfSelectable IMMeta (SelLockUnset True (ActiveLock _ i)) _ = CmdPlaceLock (Just i)+commandOfSelectable IMMeta (SelSelectedCodeName _) False = CmdSelCodename Nothing+commandOfSelectable IMMeta (SelSelectedCodeName _) True = CmdHome commandOfSelectable IMMeta (SelUndeclared undecl) _ = CmdDeclare $ Just undecl commandOfSelectable IMMeta (SelReadNote note) False = CmdSelCodename $ Just $ noteAuthor note commandOfSelectable IMMeta (SelReadNote note) True = CmdViewSolution $ Just note@@ -211,7 +248,8 @@ commandOfSelectable IMMeta (SelSecured note) True = CmdViewSolution $ Just note commandOfSelectable IMMeta (SelOldLock ls) _ = CmdPlayLockSpec $ Just ls commandOfSelectable IMTextInput (SelLock (ActiveLock _ i)) _ = CmdInputSelLock i-commandOfSelectable IMTextInput (SelLockUnset (ActiveLock _ i)) _ = CmdInputSelLock i+commandOfSelectable IMTextInput (SelScoreLock _ _ (ActiveLock _ i)) _ = CmdInputSelLock i+commandOfSelectable IMTextInput (SelLockUnset _ (ActiveLock _ i)) _ = CmdInputSelLock i commandOfSelectable IMTextInput (SelReadNote note) _ = CmdInputCodename $ noteAuthor note commandOfSelectable IMTextInput (SelSolution note) _ = CmdInputCodename $ noteAuthor note commandOfSelectable IMTextInput (SelSecured note) _ = CmdInputCodename $ lockOwner $ noteOn note@@ -219,6 +257,35 @@ commandOfSelectable IMTextInput (SelUndeclared undecl) _ = CmdInputSelUndecl undecl commandOfSelectable _ _ _ = CmdNone +helpOfSelectable SelOurLock = Just "Design locks."+helpOfSelectable (SelSelectedCodeName name) = Just $ "Currently viewing "++name++"."+helpOfSelectable (SelRelScore score) = Just $ "Your score against this player is "++show score++". Higher is better."+helpOfSelectable (SelLock (ActiveLock name i)) = Just $ name++"'s lock "++[lockIndexChar i]++"."+helpOfSelectable (SelLockUnset True _) = Just "Place a lock."+helpOfSelectable (SelLockUnset False _) = Just "You access all empty lock slots once you access all filled slots."+helpOfSelectable (SelUndeclared _) = Just "Declare solution, putting your note behind one of your locks, to access the solved lock."+helpOfSelectable (SelRandom _) = Just "Random set of players. Colours show relative scores, bright red (-3) to bright green (+3)."+helpOfSelectable (SelScoreLock (Just name) False _) = Just $ "Your lock, not accessed by "++name++"."+helpOfSelectable (SelScoreLock (Just name) True _) = Just $ "Your lock, accessed by "++name++": -1 to relative score."+helpOfSelectable (SelScoreLock Nothing False (ActiveLock name _)) = Just $ name++"'s lock, not accessed by you."+helpOfSelectable (SelScoreLock Nothing True (ActiveLock name _)) = Just $ name++"'s lock, accessed by you: +1 to relative score."+helpOfSelectable (SelReadNote note) = Just $ "You have read "++noteAuthor note++"'s note on this lock."+helpOfSelectable SelReadNoteSlot = Just $ "If you read three notes on this lock, you can access it without having to solve it yourself."+helpOfSelectable (SelSecured note) = let ActiveLock owner idx = noteOn note in+    Just $ "Secured note on "++owner++"'s lock "++[lockIndexChar idx]++"; notes are read by accessing the lock holding them."+helpOfSelectable (SelSolution note) = Just $ case noteBehind note of+    Just (ActiveLock owner idx) -> owner +++	" has secured their note on this lock behind their lock " ++ [lockIndexChar idx] ++ "."+    Nothing -> noteAuthor note ++ "'s note on this lock is public knowledge."+helpOfSelectable (SelAccessed name) = Just $ name ++ " has accessed this lock without solving it, by reading three notes on it."+helpOfSelectable (SelPublicLock) = Just "Notes behind retired or public locks are public; locks with three public notes are public."+helpOfSelectable (SelAccessedMethod meth) = Just $ case meth of+    AccessedSolved -> "You solved this lock, so have access to it and any notes it holds."+    AccessedPublic -> "The solution to this lock is public knowledge."+    AccessedUndeclared -> "You have solved this lock, but need to declare your solution to access the lock."+    AccessedReadNotes -> "You have read three notes on others' solutions to this lock, so have access to it."+helpOfSelectable _ = Nothing+ cmdAtMousePos pos@(mPos,central) im selMode = do     buttons <- (concat . map fst) <$> getButtons im     sels <- gets metaSelectables@@ -228,30 +295,53 @@ 	++ maybe [] (\isRight -> [ commandOfSelectable im sel isRight 	    | Just sel <- [Map.lookup mPos sels] ]) selMode +helpAtMousePos pos@(mPos,_) IMMeta =+    join . fmap helpOfSelectable . Map.lookup mPos <$> gets metaSelectables+helpAtMousePos _ _ = return Nothing+    + data UIOptButton a = UIOptButton { getUIOpt::UIOptions->a, setUIOpt::a->UIOptions->UIOptions,     uiOptVals::[a], uiOptPos::HexVec, uiOptGlyph::a->Glyph, uiOptDescr::a->String }  -- non-uniform type, so can't use a list... uiOB1 = UIOptButton useFiveColouring (\v o -> o {useFiveColouring=v}) [True,False]-	(periphery 0 <+> 2 <*> neg hw <+> neg hv) useFiveColourButton+	(periphery 0 <+> 2 <*> hu) useFiveColourButton 	(\v -> if v then "Adjacent pieces get different colours" else 	"Pieces are coloured according to type")-uiOB2 = UIOptButton showBlocks (\v o -> o {showBlocks=v}) [True,False]-	(periphery 0 <+> 2 <*> neg hw <+> 3 <*> neg hv) showBlocksButton-	(\v -> if v then "Blocked and blocking forces are annotated" else-	"Blockage annotations disabled")-uiOB3 = UIOptButton whsButtons (\v o -> o {whsButtons=v}) [WHSSelected, WHSWrench, WHSHook]+uiOB2 = UIOptButton showBlocks (\v o -> o {showBlocks=v}) [ShowBlocksBlocking,ShowBlocksAll,ShowBlocksNone]+	(periphery 0 <+> 2 <*> hu <+> 1 <*> neg hv) showBlocksButton+	(\v -> case v of+	    ShowBlocksBlocking -> "Blocking forces are annotated"+	    ShowBlocksAll -> "Blocked and blocking forces are annotated"+	    ShowBlocksNone -> "Blockage annotations disabled")+uiOB3 = UIOptButton whsButtons (\v o -> o {whsButtons=v}) [Nothing, Just WHSSelected, Just WHSWrench, Just WHSHook] 	(periphery 3 <+> 3 <*> hv) whsButtonsButton-	(\v -> "Showing buttons for controlling " ++ case v of-	    WHSSelected -> "selected tool"-	    WHSWrench -> "wrench"-	    WHSHook -> "hook")+	(\v -> case v of+	    Nothing -> "Click to show keyboard control buttons for tools."+	    Just whs -> "Showing buttons for controlling " ++ case whs of+		WHSSelected -> "selected tool"+		WHSWrench -> "wrench"+		WHSHook -> "hook")+uiOB4 = UIOptButton showButtonText (\v o -> o {showButtonText=v}) [True,False]+	(periphery 0 <+> 2 <*> hu <+> 2 <*> hv) showButtonTextButton+	(\v -> if v then "Help text enabled" else+	"Help text disabled")+uiOB5 = UIOptButton useSounds (\v o -> o {useSounds=v}) [True,False]+	(periphery 0 <+> 2 <*> hu <+> 2 <*> neg hv) useSoundsButton+	(\v -> if v then "Sound effects enabled" else+	"Sound effects disabled")  drawUIOptionButtons :: InputMode -> UIM ()-drawUIOptionButtons mode = when (mode `elem` [IMPlay, IMEdit]) $ do-    drawUIOptionButton uiOB1-    drawUIOptionButton uiOB2 -    when (mode == IMPlay) $ drawUIOptionButton uiOB3+drawUIOptionButtons mode = do+    when (mode `elem` [IMPlay, IMEdit]) $ do+	drawUIOptionButton uiOB1+	drawUIOptionButton uiOB2+#ifdef SOUND+	drawUIOptionButton uiOB5+#endif+    when (mode == IMPlay) $+	drawUIOptionButton uiOB3+    drawUIOptionButton uiOB4 drawUIOptionButton b = do     value <- gets $ (getUIOpt b).uiOptions     renderToMain $ mapM_ (\g -> drawAtRel g (uiOptPos b))@@ -368,19 +458,38 @@ drawMainGameState' :: DrawArgs -> UIM () drawMainGameState' args@(DrawArgs highlight colourFixed alerts st uiopts) = do     lastArgs <- gets lastDrawArgs-    void $ if lastArgs == Just args+    when (lastArgs /= Just args) $+	modify $ \ds -> ds { animFrame = 0, nextAnimFrameAt = Nothing }++    lastAnimFrame <- gets animFrame+    now <- liftIO getTicks+    anim <- maybe False (<now) <$> gets nextAnimFrameAt+    when anim $+	modify $ \ds -> ds { animFrame = lastAnimFrame+1, nextAnimFrameAt = Nothing }+    animFrameToDraw <- gets animFrame+    void $ if (lastArgs == Just args && lastAnimFrame == animFrameToDraw) 	then do 	    vidSurf <- liftIO getVideoSurface 	    gsSurf <- liftM fromJust $ gets gsSurface 	    liftIO $ blitSurface gsSurf Nothing vidSurf Nothing 	else do 	    modify $ \ds -> ds { lastDrawArgs = Just args }-	    let board = stateBoard st++	    let animSts = [ st | AlertIntermediateState st <- alerts ] ++ [st]+	    let drawSt = animSts !! animFrameToDraw+	    -- let drawAlerts = takeWhile (/= AlertIntermediateState drawSt) alerts+	    let drawAlerts = alerts+	    nextIsSet <- isJust <$> gets nextAnimFrameAt+	    when (not nextIsSet && length animSts > animFrameToDraw+1) $ do+		time <- uiAnimTime <$> gets uiOptions+		modify $ \ds -> ds { nextAnimFrameAt = Just $ now + time }++	    let board = stateBoard drawSt 	    lastCol <- gets dispLastCol-	    let coloured = colouredPieces colourFixed st+	    let coloured = colouredPieces colourFixed drawSt 	    let colouring = if useFiveColouring uiopts-		then boardColouring st coloured lastCol-		else pieceTypeColouring st coloured+		then boardColouring drawSt coloured lastCol+		else pieceTypeColouring drawSt coloured 	    modify $ \ds -> ds { dispLastCol = colouring } 	    gsSurf <- liftM fromJust $ gets gsSurface 	    renderToMainWithSurf gsSurf $ do@@ -389,17 +498,60 @@ 		    (pos,glyph) <- Map.toList $ fmap (ownedTileGlyph colouring highlight) board 		    ] -		when (showBlocks uiopts) $ sequence_-		    $ [ drawBlocked st colouring False force |-		    AlertBlockedForce force <- alerts ]-		    ++ [ drawBlocked st colouring True force |-		    AlertBlockingForce force <- alerts ]-		    ++ [ drawBlocked st colouring True force |-		    AlertResistedForce force <- alerts ]-		    -- ++ [ drawAt collisionMarker pos | AlertCollision pos <- alerts ]+		when (showBlocks uiopts /= ShowBlocksNone) $ sequence_+		    $ [ drawBlocked drawSt colouring False force+			| AlertBlockedForce force <- drawAlerts+			, showBlocks uiopts == ShowBlocksAll ]+		    ++ [ drawBlocked drawSt colouring True force+			| AlertBlockingForce force <- drawAlerts ]+		    -- ++ [ drawBlocked drawSt colouring True force |+		    -- AlertResistedForce force <- drawAlerts ]+		    ++ [ drawAt collisionMarker pos+			| AlertCollision pos <- drawAlerts ] 	    vidSurf <- liftIO getVideoSurface 	    liftIO $ blitSurface gsSurf Nothing vidSurf Nothing +playAlertSounds :: GameState -> [Alert] -> UIM ()+#ifdef SOUND+playAlertSounds st alerts = do+    use <- useSounds <$> gets uiOptions+    when use $ mapM_ (maybe (return ()) playSound . alertSound) alerts+    where+	alertSound (AlertBlockedForce force) =+	    let PlacedPiece _ piece = getpp st $ forceIdx force+	    in case piece of+		Wrench _ -> Just "wrenchblocked"+		Hook _ _ -> if isPush force then Just "hookblocked" else Just "hookarmblocked"+		_ -> Nothing+	alertSound (AlertDivertedWrench _) = Just "wrenchscrape"+	alertSound (AlertAppliedForce (Torque idx _))+	    | isPivot.placedPiece.getpp st $ idx = Just "pivot"+	alertSound (AlertAppliedForce (Push idx dir))+	    | isBall.placedPiece.getpp st $ idx = Just "ballmove"+	alertSound (AlertAppliedForce (Push idx dir)) = do+	    (align,newLen) <- listToMaybe [(align,newLen)+		| c@(Connection (startIdx,_) (endIdx,_) (Spring outDir natLen)) <- connections st+		, let align = (if outDir == dir then 1 else if outDir == neg dir then -1 else 0)+			* (if idx == startIdx then 1 else if idx == endIdx then -1 else 0)+		, align /= 0+		, let newLen = connectionLength st c ]+	    return $ "spring" ++ (if align == 1 then "contract" else "extend")+		++ show (min newLen 12)+	alertSound AlertUnlocked = Just "unlocked"+	alertSound _ = Nothing+	playSound :: String -> UIM ()+	playSound sound = void.runMaybeT $ do+	    ss <- MaybeT $ Map.lookup sound <$> gets sounds+	    guard.not.null $ ss+	    liftIO $ randFromList ss >>= \(Just s) -> void $ tryPlayChannel (-1) s 0+	randFromList :: [a] -> IO (Maybe a)+	randFromList [] = return Nothing+	randFromList as = (Just.(as!!)) <$> randomRIO (0,length as - 1)+#else+playAlertSounds _ _ = return ()+#endif++ drawMiniLock :: Lock -> HexVec -> UIM () drawMiniLock lock v = do     surface <- Map.lookup lock <$> gets miniLocks >>= maybe new return@@ -447,9 +599,15 @@ drawButtons mode = do     buttons <- getButtons mode     bindingStr <- getBindingStr mode-    renderToMain $ sequence_ $ concat [-	    [ drawAtRel (buttonGlyph col) v >> renderStrColAt buttonTextCol bdg v |-		(i,(v,bdg)) <- enumerate $ map (\b->(buttonPos b, bindingStr $ buttonCmd b)) $ buttonGroup+    showBT <- showButtonText <$> gets uiOptions+    smallFont <- gets dispFontSmall+    renderToMain $ sequence_ $ concat [ [ do+		drawAtRel (buttonGlyph col) v +		renderStrColAt buttonTextCol bdg v+		when showBT $+		    withFont smallFont $ recentreAt v $ rescaleRender (1/4) $+		    sequence_ [ renderStrColAtLeft col s dv | (s,dv) <- helps ]+	    | (i,(v,bdg,helps)) <- enumerate $ map (\b->(buttonPos b, bindingStr $ buttonCmd b, buttonHelp b)) $ buttonGroup 		, let col = dim $ colourWheel (base+inc*i) ] 	| (buttonGroup,(base,inc)) <- buttons 	]@@ -485,8 +643,45 @@      clearMiniLocks -    when (isNothing font) $ lift.putStr $ "Warning: font file not found at "++fontpath++".\n"+    when (isNothing font) $ lift $ do+	let text = "Warning: font file not found at "++fontpath++".\n"+	putStr text+	writeFile "error.log" text  +initAudio :: UIM ()+#ifdef SOUND+initAudio = do+    liftIO $ tryOpenAudio defaultFrequency AudioS16LSB 1 4096+    -- liftIO $ querySpec >>= print+    liftIO $ allocateChannels 16+    let seqWhileJust (m:ms) = m >>= \ret -> case ret of+	    Nothing -> return []+	    Just a -> (a:) <$> seqWhileJust ms+    soundsdir <- liftIO $ getDataPath "sounds"+    sounds <- sequence [ do+	    chunks <- liftIO $ seqWhileJust+		[ runMaybeT $ do+		    chunk <- msum $ map (MaybeT . tryLoadWAV) paths+		    liftIO $ volumeChunk chunk vol+		    return chunk+		| n <- [1..]+		, let paths = [soundsdir ++ [pathSeparator] ++ sound +++			"-" ++ (if n < 10 then ('0':) else id) (show n) ++ ext+			| ext <- [".ogg", ".wav"] ]+		, let vol = case sound of+			"pivot" -> 64+			"wrenchscrape" -> 64+			_ -> 128+		]+	    return (sound,chunks)+	| sound <- ["hookblocked","hookarmblocked","wrenchblocked","wrenchscrape","pivot","unlocked","ballmove"]+		++ ["spring" ++ d ++ show l | d <- ["extend","contract"], l <- [1..12]] ]+    -- liftIO $ print sounds+    modify $ \s -> s { sounds = Map.fromList sounds }+#else+initAudio = return ()+#endif+ drawMsgLine = void.runMaybeT $ do     (col,str) <- msum 	[ ((,) dimWhiteCol) <$> MaybeT (gets hoverStr)@@ -515,7 +710,7 @@ lockLinePos = 2<*>(hu <+> neg hw) <+> miniLockPos serverPos = 12<*>hv <+> 6<*>neg hu serverWaitPos = serverPos <+> hw <+> neg hu-nextPagePos = serverPos <+> 4<*>neg hv+nextPagePos = serverPos <+> 5<*>neg hv randomNamesPos = 9<*>hv <+> neg hu codenamePos = (-4)<*>hw <+> 4<*>hv undeclsPos = hv <+> neg hw <+> codenamePos

SDLUIMInstance.hs view

@@ -16,6 +16,7 @@ import qualified Graphics.UI.SDL.TTF as TTF import Control.Concurrent.STM import Control.Applicative hiding ((<*>))+import System.Timeout import qualified Data.Map as Map import Data.Map (Map) import qualified Data.Vector as Vector@@ -85,15 +86,15 @@ 	    renderToMain $ drawCursorAt $ if isNothing selPiece then Just selPos else Nothing 	    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<+>hv) CmdDelete 0 [("delete",hu<+>neg hw)]+		, singleButton (periphery 2 <+> 3<*>hw) CmdMerge 4 [("merge",hu<+>neg hw)] 		] 	    sequence_ 		[ when (null . filter (pred . placedPiece) . Vector.toList $ placedPieces st)-		    $ registerButton (periphery 0 <+> d) cmd 2-		| (pred,cmd,d) <- [-		    (isWrench, CmdTile $ WrenchTile zero, 3<*>hu),-		    (isHook, CmdTile $ HookTile, 3<*>hu <+> hv)] ]+		    $ registerButton (periphery 0 <+> d) cmd 2 [("place",hu<+>neg hw),(tool,hu<+>neg hv)]+		| (pred,tool,cmd,d) <- [+		    (isWrench, "wrench", CmdTile $ WrenchTile zero, 3<*>hu <+> hv),+		    (isHook, "hook", CmdTile $ HookTile, 3<*>hu <+> 2<*>hv)] ] 	    drawPaintButtons 	drawMainState' (MetaState saddr undecls cOnly auth names _ _ rnamestvar _ _ mretired path mlock offset) = do 	    let ourName = authUser <$> auth@@ -104,21 +105,22 @@ 		(\lock -> do 		    drawMiniLock lock miniLockPos 		    registerSelectable miniLockPos 3 SelOurLock-		    registerButton (miniLockPos <+> 2<*>neg hv <+> hu) CmdPrevLock 4-		    registerButton (miniLockPos <+> 2<*>neg hv <+> hu <+> neg hw) CmdNextLock 4 		    ) 		(fst<$>mlock)+	    lift $ when (not $ null path) $ do+		renderToMain $ renderStrColAtLeft messageCol path $ lockLinePos <+> hu+		sequence_+		    [ registerButton (miniLockPos <+> 2<*>neg hv <+> hu <+> dv) cmd 4+			[(dirText,hu<+>neg hw),("lock",hu<+>neg hv)]+		    | (dv,cmd,dirText) <- [(zero,CmdPrevLock,"prev"),(neg hw,CmdNextLock,"next")] ] 	    lift $ do 		smallFont <- gets dispFontSmall 		renderToMain $ withFont smallFont $ renderStrColAtLeft messageCol 			(saddrStr saddr ++ if cOnly then " (cache only)" else "") 		    $ serverPos <+> hu-		renderToMain $ renderStrColAtLeft messageCol path $ lockLinePos <+> hu-		when (offset>0) $-		    registerButton (nextPagePos<+>neg hu) CmdPrevPage 4  	    when (length names > 1) $ lift $ registerButton-		(codenamePos <+> 2<*>neg hu <+> hw) CmdBackCodename 0+		(codenamePos <+> 2<*>neg hu <+> hw) CmdBackCodename 0 [("back",2<*>hw<+>neg hv<+>neg hu)]  	    runMaybeT $ do 		name <- MaybeT (return selName)@@ -130,10 +132,11 @@ 			    renderToMain $ withFont smallFont $ renderStrColAtLeft (opaquify $ dim errorCol) "(stale)" $ serverWaitPos 			maybe (return ()) (setMsgLineNoRefresh errorCol) err 			when (fresh && (isNothing ourName || home || isNothing muirc)) $-			    registerButton (codenamePos <+> 2<*>hu)-				(if (isNothing muirc && isNothing ourName) || home then CmdRegister else CmdAuth) 2+			    let reg = (isNothing muirc && isNothing ourName) || home  +			    in registerButton (codenamePos <+> hw <+> 2<*>hu)+				(if reg then CmdRegister else CmdAuth) 2 [(if reg then "reg" else "auth", hu<+>neg hv)] 		    (if isJust muirc then drawName else drawNullName) name codenamePos-		    lift $ registerSelectable codenamePos 0 SelSelectedCodeName+		    lift $ registerSelectable codenamePos 0 (SelSelectedCodeName name) 		    drawRelScore name (codenamePos<+>hu) 		    for_ muirc $ \(RCUserInfo (_,uinfo)) -> case mretired of  			    Just retired -> do@@ -141,38 +144,39 @@ 				    (map (locksPos<+>) $ zero:[rotate n $ 4<*>hu<->4<*>hw | n <- [0,2,3,5]]) 				    [ \pos -> (lift $ registerSelectable pos 1 (SelOldLock ls)) >> drawOldLock ls pos 				    | ls <- retired ]-				lift $ registerButton retiredPos CmdShowRetired pubWheelAngle-				lift $ registerButton (retiredPos <+> hw) (CmdPlayLockSpec Nothing) 4+				lift $ registerButton retiredPos CmdShowRetired pubWheelAngle [("retired",hu<+>neg hw)]+				lift $ registerButton (retiredPos <+> hw) (CmdPlayLockSpec Nothing) 4 [("play",hu<+>neg hw),("no.",hu<+>neg hv)] 			    Nothing -> do 				sequence_ [ drawLockInfo (ActiveLock (codename uinfo) i) mlockinfo | 				    (i,mlockinfo) <- assocs $ userLocks uinfo ] 				let mmiscpos = (serverPos <+> 2<*>neg hv) 				when (isJust $ msum $ elems $ userLocks uinfo) $ lift $ do 				    registerButtonGroup-					([ Button mmiscpos (CmdSolve Nothing), Button (mmiscpos<+>hu) (CmdViewSolution Nothing)], (2,2))+					([ Button mmiscpos (CmdSolve Nothing) [("solve",hu<+>neg hw),("lock",hu<+>neg hv)]+					, Button (mmiscpos<+>neg hv) (CmdViewSolution Nothing) [("view",hu<+>neg hw),("soln",hu<+>neg hv)]], (2,2)) 				let tested = maybe False (isJust.snd) mlock 				when (isJust mlock && home) $ lift $ registerButton-				    (miniLockPos <+> 2<*>hv <+> neg hu) (CmdPlaceLock Nothing) $ if tested then 2 else 0-				lift $ registerButton retiredPos CmdShowRetired pubWheelAngle+				    (miniLockPos <+> 3<*>hv) (CmdPlaceLock Nothing) (if tested then 2 else 0) [("place",hv<+>5<*>neg hu),("lock",hw<+>4<*>neg hu)]+				lift $ registerButton retiredPos CmdShowRetired pubWheelAngle [("retired",hu<+>neg hw)]  	    when home $ do 		unless (null undecls) $ do 		    lift.renderToMain $ renderStrColAtLeft messageCol "Undeclared:" (undeclsPos<+>2<*>hv)-		    lift $ registerButton (undeclsPos<+>2<*>hv<+>neg hu) (CmdDeclare Nothing) 2+		    lift $ registerButton (undeclsPos<+>2<*>hv<+>neg hu) (CmdDeclare Nothing) 2 [("decl",hv<+>4<*>neg hu),("soln",hw<+>4<*>neg hu)] 		    fillArea (undeclsPos<+>hv) 			(map (undeclsPos<+>) $ hexDisc 1 ++ [hu<+>neg hw, neg hu<+>hv]) 			[ \pos -> (lift $ registerSelectable pos 0 (SelUndeclared undecl)) >> drawActiveLock al pos 			| undecl@(Undeclared _ _ al) <- undecls ]-		rnames <- liftIO $ atomically $ readTVar rnamestvar-		unless (null rnames) $-		    fillArea randomNamesPos-			(map (randomNamesPos<+>) $ hexDisc 2)-			[ \pos -> (lift $ registerSelectable pos 0 (SelRandom name)) >> drawName name pos-			| name <- rnames ]+	    rnames <- liftIO $ atomically $ readTVar rnamestvar+	    unless (null rnames) $+		fillArea randomNamesPos+		    (map (randomNamesPos<+>) $ hexDisc 2)+		    [ \pos -> (lift $ registerSelectable pos 0 (SelRandom name)) >> drawName name pos+		    | name <- rnames ]  	    when (ourName /= selName) $ void $ runMaybeT $ do 		when (isJust ourName) $-		    lift.lift $ registerButton (codenamePos <+> neg hu <+> hw) CmdHome 4+		    lift.lift $ registerButton (codenamePos <+> neg hu <+> hw) CmdHome 4 [("home",hu<+>neg hv)] 		sel <- MaybeT $ return selName 		us <- MaybeT $ return ourName 		ourUInfo <- mgetUInfo us@@ -180,29 +184,34 @@ 		let accesses = map (uncurry getAccessInfo) [(ourUInfo,sel),(selUInfo,us)] 		lift $ do  		    fillArea (codenamePos<+>3<*>hv<+>hw) (map ((codenamePos<+>3<*>hv)<+>) [zero,hw,neg hv])-			[ \pos -> (lift $ registerSelectable pos 0 SelOurAL) >>+			[ \pos -> (lift $ registerSelectable pos 0 (SelScoreLock (Just sel) access $ ActiveLock us i)) >> 			    drawNameWithCharAndCol us white (lockIndexChar i) col pos 			| i <- [0..2] 			, let (pub,access) = accesses !! 0 !! i 			, let col-				| pub = obscure pubColour -				| access = obscure $ scoreColour $ -3 -				| otherwise = dim $ scoreColour 3 ]+				| pub = dim pubColour +				| access = dim $ scoreColour $ -3 +				| otherwise = obscure $ scoreColour 3 ] 		    fillArea (codenamePos<+>2<*>neg hw) (map ((codenamePos<+>3<*>neg hw)<+>) [zero,hw,neg hv])-			[ \pos -> (lift $ registerSelectable pos 0 (SelLock $ ActiveLock sel i)) >>+			[ \pos -> (lift $ registerSelectable pos 0 (SelScoreLock Nothing access $ ActiveLock sel i)) >> 			    drawNameWithCharAndCol sel white (lockIndexChar i) col pos 			| i <- [0..2] 			, let (pub,access) = accesses !! 1 !! i 			, let col 				| pub = obscure pubColour -				| access = obscure $ scoreColour $ 3 -				| otherwise = dim $ scoreColour $ -3 ]+				| access = dim $ scoreColour $ 3 +				| otherwise = obscure $ scoreColour $ -3 ]+		(usUnacc,selUnacc) <- MaybeT $ (snd<$>) <$> getRelScoreDetails sel+		lift.lift.renderToMain $ sequence_ [renderStrColAt (scoreColour score) (sign:show (abs score)) pos+			| (sign,score,pos) <-+			    [ ('-',usUnacc-3,codenamePos<+>3<*>hv<+>neg hw)+			    , ('+',3-selUnacc,codenamePos<+>3<*>neg hw<+>hv) ] ] 	drawMainState' _ = return ()      drawMessage = say     drawError = sayError -    drawAlerts alerts = return ()+    reportAlerts = playAlertSounds      getChRaw = do 	events <- liftIO getEvents@@ -215,6 +224,8 @@ 		Map.insertWith (\[bdg] -> \bdgs -> if bdg `elem` bdgs then delete bdg bdgs else bdg:bdgs) 		    mode [(ch,cmd)] $ uiKeyBindings s } +    getUIBinding mode cmd = ($cmd) <$> getBindingStr mode+     initUI = liftM isJust (runMaybeT $ do 	catchIOErrorMT $ SDL.init [InitVideo] 	catchIOErrorMT TTF.init@@ -228,6 +239,7 @@ 	    renderToMain $ erase 	    liftIO $ enableUnicode True 	    liftIO $ enableKeyRepeat 250 30+	    initAudio 	    readBindings 	) 	where@@ -264,18 +276,42 @@      setYNButtons = do 	clearButtons-	registerButton (periphery 5 <+> hw) (CmdInputChar 'Y') 2-	registerButton (periphery 5 <+> neg hv) (CmdInputChar 'N') 0+	registerButton (periphery 5 <+> hw) (CmdInputChar 'Y') 2 []+	registerButton (periphery 5 <+> neg hv) (CmdInputChar 'N') 0 [] 	drawButtons IMTextInput 	refresh      getInput mode = do-	events <- liftIO $ getEvents+	fps <- gets fps+	events <- liftIO $ nubMouseMotions <$> getEventsTimeout (10^6`div`fps) 	oldUIState <- get 	cmds <- concat <$> mapM processEvent events-	newUIState <- get-	return $ cmds ++ if uistatesMayVisiblyDiffer oldUIState newUIState then [CmdRefresh] else []+	setPaintFromCmds cmds+	addRefresh <- needRefresh oldUIState+	return $ cmds ++ if addRefresh then [CmdRefresh] else [] 	where+	    nubMouseMotions evs =+		-- drop all but last mouse motion event+		let nubMouseMotions' False (mm@(MouseMotion {}):evs) = mm:(nubMouseMotions' True evs)+		    nubMouseMotions' True (mm@(MouseMotion {}):evs) = nubMouseMotions' True evs+		    nubMouseMotions' b (ev:evs) = ev:(nubMouseMotions' b evs)+		    nubMouseMotions' _ [] = []+		in reverse $ nubMouseMotions' False $ reverse evs+	    setPaintFromCmds cmds = sequence_+		[ modify $ \s -> s { paintTileIndex = pti }+		    | (pti,pt) <- zip [0..] paintTiles+		    , cmd <- cmds+		    , (isNothing pt && cmd == CmdDelete) ||+			(isJust $ do+			    pt' <- pt+			    CmdTile t <- Just cmd+			    guard $ ((==)`on`tileType) t pt') ]+	    needRefresh old = do+		new <- get+		now <- liftIO getTicks+		anim <- maybe False (<now) <$> gets nextAnimFrameAt+		return $ anim || uistatesMayVisiblyDiffer old new+ 	    uistatesMayVisiblyDiffer uis1 uis2 = 		uis1 { mousePos = (zero,False), lastFrameTicks=0 } 		/= uis2 {mousePos = (zero,False), lastFrameTicks=0 }@@ -291,14 +327,6 @@ 		    else do 			uibdgs <- Map.findWithDefault [] mode `liftM` gets uiKeyBindings 			let mCmd = lookup ch $ uibdgs ++ bindings mode-			sequence_-			    [ modify $ \s -> s { paintTileIndex = pti }-				| (pti,pt) <- zip [0..] paintTiles-				, (isNothing pt && mCmd == Just CmdDelete) ||-				    (isJust $ do-					pt' <- pt-					CmdTile t <- mCmd-					guard $ ((==)`on`tileType) t pt') ] 			return $ maybeToList mCmd 	    processEvent (MouseMotion {}) = do 		(oldMPos,_) <- gets mousePos@@ -342,12 +370,16 @@ 			++ [ (modify $ \s -> s {paintTileIndex = i}) >> return [] 			    | i <- take (length paintTiles) [0..] 			    , mPos == paintButtonStart <+> i<*>hv ]-			++ [ toggleUIOption uiOB1 >> updateHoverStr >> return []+			++ [ toggleUIOption uiOB1 >> updateHoverStr mode >> return [] 			    | mPos == uiOptPos uiOB1 ]-			++ [ toggleUIOption uiOB2 >> updateHoverStr >> return []+			++ [ toggleUIOption uiOB2 >> updateHoverStr mode >> return [] 			    | mPos == uiOptPos uiOB2 ]-			++ [ toggleUIOption uiOB3 >> updateHoverStr >> return []+			++ [ toggleUIOption uiOB3 >> updateHoverStr mode >> return [] 			    | mPos == uiOptPos uiOB3 ]+			++ [ toggleUIOption uiOB4 >> updateHoverStr mode >> return []+			    | mPos == uiOptPos uiOB4 ]+			++ [ toggleUIOption uiOB5 >> updateHoverStr mode >> return []+			    | mPos == uiOptPos uiOB5 ]  		if rb 		then return [ CmdWait ]@@ -365,18 +397,20 @@ 	    processEvent (MouseButtonDown _ _ ButtonRight) = do 		pos@(mPos,_) <- gets mousePos 		modify $ \s -> s { rightButtonDown = Just mPos }-		(fromMaybe [] <$>) $ runMaybeT $ msum+		lb <- isJust <$> gets leftButtonDown+		if lb+		then return [ CmdWait ]+		else (fromMaybe [] <$>) $ runMaybeT $ msum 		    [ do 			cmd <- MaybeT $ cmdAtMousePos pos mode Nothing+			guard $ mode /= IMTextInput 			modify $ \s -> s { settingBinding = Just cmd } 			return [] 		    , do 			cmd <- MaybeT $ cmdAtMousePos pos mode (Just True) 			return [cmd] 		    , case mode of-			IMPlay -> do-			    centre <- gets dispCentre-			    return $ [ CmdManipulateToolAt $ mPos <+> centre ]+			IMPlay -> return [ CmdWait ] 			_ -> return [ CmdSelect ] ] 	    processEvent (MouseButtonUp _ _ ButtonRight) = do 		modify $ \s -> s { rightButtonDown = Nothing }@@ -402,13 +436,13 @@ 	    doWheel dw = do 		rb <- isJust <$> gets rightButtonDown 		mb <- isJust <$> gets middleButtonDown-		if rb || mode == IMPlay && not mb-		    then return [ CmdRotate dw ]-		    else if mb -			then return [ if dw == 1 then CmdUndo else CmdRedo ]-			else do-			modify $ \s -> s { paintTileIndex = (paintTileIndex s + dw) `mod` (length paintTiles) }-			return []+		if ((rb||mb) && mode /= IMEdit) || (mb && mode == IMEdit)+		then return [ if dw == 1 then CmdUndo else CmdRedo ]+		else if mode /= IMEdit || rb+		then return [ CmdRotate WHSSelected dw ]+		else do+		    modify $ \s -> s { paintTileIndex = (paintTileIndex s + dw) `mod` (length paintTiles) }+		    return [] 		  	    drawCmd mt True = CmdPaint mt@@ -429,23 +463,7 @@ 		oldPos <- gets mousePos 		when (newPos /= oldPos) $ do 		    modify $ \ds -> ds { mousePos = newPos }-		    updateHoverStr --	    updateHoverStr = do-		p@(mPos,isCentral) <- gets mousePos-		hstr <- runMaybeT $ msum-		    [ MaybeT ( cmdAtMousePos p mode Nothing ) >>= lift . describeCommandAndKeys-		    , guard (mPos == uiOptPos uiOB1) >> describeUIOptionButton uiOB1-		    , guard (mPos == uiOptPos uiOB2) >> describeUIOptionButton uiOB2-		    , guard (mPos == uiOptPos uiOB3) >> describeUIOptionButton uiOB3 ]-		modify $ \ds -> ds { hoverStr = hstr }-	    describeCommandAndKeys :: Command -> UIM String-	    describeCommandAndKeys cmd = do-		uibdgs <- Map.findWithDefault [] mode `liftM` gets uiKeyBindings-		return $ describeCommand cmd ++ " ["-		    ++ concat (intersperse ","-			(map showKeyFriendly $ findBindings (uibdgs ++ bindings mode) cmd))-		    ++ "]"+		    updateHoverStr mode      showHelp mode = do 	bdgs <- nub <$> getBindings mode@@ -454,16 +472,16 @@ 	    erase 	    let bdgWidth = (screenWidthHexes-6) `div` 3 		showKeys chs = intercalate "/" (map showKeyFriendly chs)-		maxkeyslen = maximum $ map (length.showKeys.map fst) $ groupBy ((==) `on` snd) bdgs+		maxkeyslen = maximum . (0:) $ 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."]+			"Click by tool to move; right-click to wait;", "Scroll wheel to rotate hook;",+			"Scroll wheel with right button 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."]+		    IMReplay -> ["Scroll wheel with right button held down to undo/redo."] 		    IMMeta -> ["Left-clicking on something does most obvious thing;", 			"Right-clicking does second-most obvious thing."] @@ -498,6 +516,11 @@     es <- pollEvents     return $ e:es +getEventsTimeout us = do+    es <- maybeToList <$> timeout us waitEvent+    es' <- pollEvents+    return $ es++es'+ pollEvents = do     e <- pollEvent     case e of@@ -506,18 +529,48 @@ 	    es <- pollEvents 	    return $ e:es +updateHoverStr :: InputMode -> UIM ()+updateHoverStr mode = do+    p@(mPos,isCentral) <- gets mousePos+    showBT <- showButtonText <$> gets uiOptions+    hstr <- runMaybeT $ msum+	[ MaybeT ( cmdAtMousePos p mode Nothing ) >>= lift . describeCommandAndKeys+	, guard showBT >> MaybeT (helpAtMousePos p mode)+	, guard (showBT && mode == IMEdit) >> msum+	    [ return $ "set paint mode: " ++ describeCommand (paintTileCmds!!i)+	    | i <- take (length paintTiles) [0..]+	    , mPos == paintButtonStart <+> i<*>hv ]+	, guard (mPos == uiOptPos uiOB1) >> describeUIOptionButton uiOB1+	, guard (mPos == uiOptPos uiOB2) >> describeUIOptionButton uiOB2+	, guard (mPos == uiOptPos uiOB3) >> describeUIOptionButton uiOB3+	, guard (mPos == uiOptPos uiOB4) >> describeUIOptionButton uiOB4+	, guard (mPos == uiOptPos uiOB5) >> describeUIOptionButton uiOB5 ]+    modify $ \ds -> ds { hoverStr = hstr }+    where+	describeCommandAndKeys :: Command -> UIM String+	describeCommandAndKeys cmd = do+	    uibdgs <- Map.findWithDefault [] mode `liftM` gets uiKeyBindings+	    return $ describeCommand cmd ++ " ["+		++ concat (intersperse ","+		    (map showKeyFriendly $ findBindings (uibdgs ++ bindings mode) cmd))+		++ "]" + fillArea :: HexVec -> [HexVec] -> [HexVec -> StateT MainState UIM ()] -> StateT MainState UIM ()  fillArea centre area draws = do-    selDraws <- do-	    offset <- gets listOffset-	    let na = length area-		nd = length draws-	    when (nd > (na*(offset+1))) $ lift $-		registerButton nextPagePos CmdNextPage 4-	    return $ drop (max 0 $ min (nd - na) (na*offset)) $ draws+    offset <- gets listOffset+    let na = length area+	listButton cmd = \pos -> lift $ registerButton pos cmd 4 []+	draws' = if offset > 0 && length draws > na+	    then listButton CmdPrevPage :+		drop (max 0 $ min (length draws - (na-1)) (na-1 + (na-2)*(offset-1))) draws+	    else draws+	selDraws = if length draws' > na+	    then take (na-1) draws' ++ [listButton CmdNextPage]+	    else take na draws'     sequence_ $ map (uncurry ($)) $-	zip selDraws $ sortBy+	zip selDraws $ sortBy (compare `on` hexVec2SVec 37) $+	    take (length selDraws) $ sortBy 		(compare `on` (hexLen . (<->centre))) 		area @@ -539,14 +592,19 @@     col <- nameCol name     relScore <- getRelScore name     flip (maybe (return ())) relScore $ \score ->-	lift.renderToMain $ renderStrColAt col-	    ((if score > 0 then "+" else "") ++ show score) pos+	lift $ do+	    renderToMain $ renderStrColAt col+		((if score > 0 then "+" else "") ++ show score) pos+	    registerSelectable pos 0 (SelRelScore score)  drawNote note pos = case noteBehind note of     Just al -> drawActiveLock al pos     Nothing -> drawPublicNote (noteAuthor note) pos-drawActiveLock (ActiveLock name i) =-    drawNameWithChar name white (lockIndexChar i)+drawActiveLock al@(ActiveLock name i) pos = do+    accessed <- accessedAL al+    drawNameWithChar name+	(if accessed then accColour else white)+	(lockIndexChar i) pos drawPublicNote name =     drawNameWithChar name pubColour 'P' drawNameWithChar name charcol char pos = do@@ -565,6 +623,7 @@ 	    renderStrColAt charcol [char] pos pubWheelAngle = 5 pubColour = colourWheel pubWheelAngle -- ==purple+accColour = cyan nameCol name = do     ourName <- (authUser <$>) <$> gets curAuth     relScore <- getRelScore name@@ -586,7 +645,8 @@     let centre = hw<+>neg hv <+> 7*(i-1)<*>hu     lift $ drawEmptyMiniLock centre     drawNameWithCharAndCol name white (lockIndexChar i) (invisible white) centre-    lift $ registerSelectable centre 3 $ SelLockUnset al+    ourName <- (authUser <$>) <$> gets curAuth+    lift $ registerSelectable centre 3 $ SelLockUnset (ourName == Just name) al drawLockInfo al@(ActiveLock name i) (Just lockinfo) = do     let centre = locksPos <+> 7*(i-1)<*>hu     let accessedByPos = centre <+> 3<*>(hv <+> neg hw)@@ -606,7 +666,9 @@      lift.renderToMain $ renderStrColAt dimWhiteCol "Accessed by:" $ accessedByPos <+> hv     if public lockinfo-    then lift.renderToMain $ renderStrColAt pubColour "Everyone!" accessedByPos+    then lift $ do+	renderToMain $ renderStrColAt pubColour "Everyone!" accessedByPos+	registerSelectable accessedByPos 1 SelPublicLock     else if null $ accessedBy lockinfo 	then lift.renderToMain $ renderStrColAt messageCol "No-one" accessedByPos 	else fillArea accessedByPos@@ -619,22 +681,28 @@ 		    | name <- accessedBy lockinfo \\ map noteAuthor (lockSolutions lockinfo) ]          undecls <- gets undeclareds-    if isJust $ guard . (|| public lockinfo) . (`elem` map noteAuthor (lockSolutions lockinfo)) =<< ourName-    then lift.renderToMain $ -	(if public lockinfo-	    then renderStrColAt pubColour "Accessed!"-	    else renderStrColAt green "Solved!")-	accessedPos-    else if any (\(Undeclared _ ls _) -> ls == lockSpec lockinfo) undecls-    then lift.renderToMain $ renderStrColAt yellow "Undeclared" accessedPos-    else do-	read <- take 3 <$> getNotesReadOn lockinfo-	unless (ourName == Just name) $ do-	    lift.renderToMain $ renderStrColAt (if length read == 3 then accessedCol else dimWhiteCol)-		"Read:" $ accessedPos <+> (-3)<*>hu-	    fillArea (accessedPos<+>neg hu) [ accessedPos <+> i<*>hu | i <- [-1..1] ]-		$ take 3 $ [ \pos -> (lift $ registerSelectable pos 0 (SelReadNote note)) >> drawName (noteAuthor note) pos-		    | note <- read ] ++ (repeat $ lift . renderToMain . drawAtRel (hollowGlyph $ dim green))+    case if isJust $ guard . (|| public lockinfo) . (`elem` map noteAuthor (lockSolutions lockinfo)) =<< ourName+	    then if public lockinfo+		then Just (pubColour,"Accessed!",AccessedPublic)+		else Just (accColour, "Solved!",AccessedSolved)+	    else if any (\(Undeclared _ ls _) -> ls == lockSpec lockinfo) undecls+		then Just (yellow, "Undeclared",AccessedUndeclared)+		else Nothing+	of+	Just (col,str,selstr) -> lift $ do+	    renderToMain $ renderStrColAt col str accessedPos+	    registerSelectable accessedPos 1 (SelAccessedMethod selstr)+	Nothing -> do+	    read <- take 3 <$> getNotesReadOn lockinfo+	    unless (ourName == Just name) $ do+		let readPos = accessedPos <+> (-3)<*>hu+		lift.renderToMain $ renderStrColAt (if length read == 3 then accColour else dimWhiteCol)+		    "Read:" $ readPos+		when (length read == 3) $ lift $ registerSelectable readPos 0 (SelAccessedMethod AccessedReadNotes)+		fillArea (accessedPos<+>neg hu) [ accessedPos <+> i<*>hu | i <- [-1..1] ]+		    $ take 3 $ [ \pos -> (lift $ registerSelectable pos 0 (SelReadNote note)) >> drawName (noteAuthor note) pos+			| note <- read ] ++ (repeat $ \pos -> (lift $ registerSelectable pos 0 SelReadNoteSlot >>+				renderToMain (drawAtRel (hollowGlyph $ dim green) pos)))      lift.renderToMain $ renderStrColAt dimWhiteCol "Holds notes:" $ notesPos <+> hv     if null $ notesSecured lockinfo

intricacy.cabal view

@@ -1,5 +1,5 @@ name:                intricacy-version:             0.3.3+version:             0.3.8 synopsis:            A game of competitive puzzle-design homepage:            http://mbays.freeshell.org/intricacy license:             GPL-3@@ -10,7 +10,7 @@ category:            Game build-type:          Simple cabal-version:       >=1.8-data-files: VeraMono.ttf tutorial/*.lock tutorial/*.text+data-files: VeraMono.ttf tutorial/*.lock tutorial/*.text sounds/*.ogg extra-doc-files: README NEWS tutorial-extra/*.lock tutorial-extra/README  description:@@ -29,16 +29,19 @@    type:     git    location: http://mbays.freeshell.org/intricacy/.git +Flag Game+    Description: Build game+    Default: True+    Manual: True Flag SDL      Description: Enable SDL UI     Default: True+Flag Sound +    Description: Enable sound+    Default: True Flag Curses      Description: Enable Curses UI     Default: True-Flag Game-    Description: Build game-    Default: True-    Manual: True Flag Server     Description: Build server     Default: False@@ -56,9 +59,14 @@         , cryptohash >= 0.8       if flag(SDL)           build-depends: SDL >=0.6.5, SDL-ttf >=0.6, SDL-gfx >=0.6+          if flag(Sound)+              cpp-options: -DSOUND+              build-depends: SDL-mixer >= 0.6, random >= 1.0           if os(windows)               Extra-Lib-Dirs:    winlibs               Extra-Libraries:   SDL_ttf SDL SDL_gfx freetype+              if flag(Sound)+                  Extra-Libraries: SDL_mixer               ghc-options: -optl-mwindows   else       Buildable: False@@ -72,6 +80,12 @@   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    other-modules: AsciiLock, BinaryInstances, BoardColouring, Cache, Command,       CursesRender, CursesUI, CursesUIMInstance, CVec, Database, Debug,

+ sounds/ballmove-01.ogg view

binary file changed (absent → 5227 bytes)

+ sounds/ballmove-02.ogg view

binary file changed (absent → 6168 bytes)

+ sounds/ballmove-03.ogg view

binary file changed (absent → 5275 bytes)

+ sounds/ballmove-04.ogg view

binary file changed (absent → 4948 bytes)

+ sounds/hookarmblocked-01.ogg view

binary file changed (absent → 5561 bytes)

+ sounds/hookarmblocked-02.ogg view

binary file changed (absent → 5041 bytes)

+ sounds/hookarmblocked-03.ogg view

binary file changed (absent → 5347 bytes)

+ sounds/hookarmblocked-04.ogg view

binary file changed (absent → 6047 bytes)

+ sounds/hookblocked-01.ogg view

binary file changed (absent → 5463 bytes)

+ sounds/hookblocked-02.ogg view

binary file changed (absent → 5341 bytes)

+ sounds/hookblocked-03.ogg view

binary file changed (absent → 4953 bytes)

+ sounds/pivot-01.ogg view

binary file changed (absent → 7398 bytes)

+ sounds/pivot-02.ogg view

binary file changed (absent → 7510 bytes)

+ sounds/pivot-03.ogg view

binary file changed (absent → 5994 bytes)

+ sounds/pivot-04.ogg view

binary file changed (absent → 5915 bytes)

+ sounds/springcontract1-01.ogg view

binary file changed (absent → 4360 bytes)

+ sounds/springcontract1-02.ogg view

binary file changed (absent → 4528 bytes)

+ sounds/springcontract1-03.ogg view

binary file changed (absent → 6307 bytes)

+ sounds/springcontract1-04.ogg view

binary file changed (absent → 4331 bytes)

+ sounds/springcontract10-01.ogg view

binary file changed (absent → 4087 bytes)

+ sounds/springcontract10-02.ogg view

binary file changed (absent → 4273 bytes)

+ sounds/springcontract10-03.ogg view

binary file changed (absent → 5370 bytes)

+ sounds/springcontract10-04.ogg view

binary file changed (absent → 4265 bytes)

+ sounds/springcontract11-01.ogg view

binary file changed (absent → 4119 bytes)

+ sounds/springcontract11-02.ogg view

binary file changed (absent → 4268 bytes)

+ sounds/springcontract11-03.ogg view

binary file changed (absent → 5401 bytes)

+ sounds/springcontract11-04.ogg view

binary file changed (absent → 4291 bytes)

+ sounds/springcontract12-01.ogg view

binary file changed (absent → 4108 bytes)

+ sounds/springcontract12-02.ogg view

binary file changed (absent → 4213 bytes)

+ sounds/springcontract12-03.ogg view

binary file changed (absent → 5320 bytes)

+ sounds/springcontract12-04.ogg view

binary file changed (absent → 4309 bytes)

+ sounds/springcontract2-01.ogg view

binary file changed (absent → 4492 bytes)

+ sounds/springcontract2-02.ogg view

binary file changed (absent → 5057 bytes)

+ sounds/springcontract2-03.ogg view

binary file changed (absent → 6158 bytes)

+ sounds/springcontract2-04.ogg view

binary file changed (absent → 4576 bytes)

+ sounds/springcontract3-01.ogg view

binary file changed (absent → 4486 bytes)

+ sounds/springcontract3-02.ogg view

binary file changed (absent → 4662 bytes)

+ sounds/springcontract3-03.ogg view

binary file changed (absent → 5957 bytes)

+ sounds/springcontract3-04.ogg view

binary file changed (absent → 4387 bytes)

+ sounds/springcontract4-01.ogg view

binary file changed (absent → 4321 bytes)

+ sounds/springcontract4-02.ogg view

binary file changed (absent → 4767 bytes)

+ sounds/springcontract4-03.ogg view

binary file changed (absent → 6099 bytes)

+ sounds/springcontract4-04.ogg view

binary file changed (absent → 4421 bytes)

+ sounds/springcontract5-01.ogg view

binary file changed (absent → 4335 bytes)

+ sounds/springcontract5-02.ogg view

binary file changed (absent → 4648 bytes)

+ sounds/springcontract5-03.ogg view

binary file changed (absent → 6110 bytes)

+ sounds/springcontract5-04.ogg view

binary file changed (absent → 4491 bytes)

+ sounds/springcontract6-01.ogg view

binary file changed (absent → 4126 bytes)

+ sounds/springcontract6-02.ogg view

binary file changed (absent → 4382 bytes)

+ sounds/springcontract6-03.ogg view

binary file changed (absent → 5759 bytes)

+ sounds/springcontract6-04.ogg view

binary file changed (absent → 4403 bytes)

+ sounds/springcontract7-01.ogg view

binary file changed (absent → 4181 bytes)

+ sounds/springcontract7-02.ogg view

binary file changed (absent → 4337 bytes)

+ sounds/springcontract7-03.ogg view

binary file changed (absent → 5538 bytes)

+ sounds/springcontract7-04.ogg view

binary file changed (absent → 4439 bytes)

+ sounds/springcontract8-01.ogg view

binary file changed (absent → 4120 bytes)

+ sounds/springcontract8-02.ogg view

binary file changed (absent → 4303 bytes)

+ sounds/springcontract8-03.ogg view

binary file changed (absent → 5447 bytes)

+ sounds/springcontract8-04.ogg view

binary file changed (absent → 4365 bytes)

+ sounds/springcontract9-01.ogg view

binary file changed (absent → 4149 bytes)

+ sounds/springcontract9-02.ogg view

binary file changed (absent → 4277 bytes)

+ sounds/springcontract9-03.ogg view

binary file changed (absent → 5431 bytes)

+ sounds/springcontract9-04.ogg view

binary file changed (absent → 4401 bytes)

+ sounds/springextend1-01.ogg view

binary file changed (absent → 4358 bytes)

+ sounds/springextend1-02.ogg view

binary file changed (absent → 4527 bytes)

+ sounds/springextend1-03.ogg view

binary file changed (absent → 6302 bytes)

+ sounds/springextend1-04.ogg view

binary file changed (absent → 4332 bytes)

+ sounds/springextend10-01.ogg view

binary file changed (absent → 4088 bytes)

+ sounds/springextend10-02.ogg view

binary file changed (absent → 4277 bytes)

+ sounds/springextend10-03.ogg view

binary file changed (absent → 5364 bytes)

+ sounds/springextend10-04.ogg view

binary file changed (absent → 4271 bytes)

+ sounds/springextend11-01.ogg view

binary file changed (absent → 4121 bytes)

+ sounds/springextend11-02.ogg view

binary file changed (absent → 4263 bytes)

+ sounds/springextend11-03.ogg view

binary file changed (absent → 5405 bytes)

+ sounds/springextend11-04.ogg view

binary file changed (absent → 4288 bytes)

+ sounds/springextend12-01.ogg view

binary file changed (absent → 4103 bytes)

+ sounds/springextend12-02.ogg view

binary file changed (absent → 4212 bytes)

+ sounds/springextend12-03.ogg view

binary file changed (absent → 5338 bytes)

+ sounds/springextend12-04.ogg view

binary file changed (absent → 4306 bytes)

+ sounds/springextend2-01.ogg view

binary file changed (absent → 4499 bytes)

+ sounds/springextend2-02.ogg view

binary file changed (absent → 5020 bytes)

+ sounds/springextend2-03.ogg view

binary file changed (absent → 6149 bytes)

+ sounds/springextend2-04.ogg view

binary file changed (absent → 4565 bytes)

+ sounds/springextend3-01.ogg view

binary file changed (absent → 4534 bytes)

+ sounds/springextend3-02.ogg view

binary file changed (absent → 4653 bytes)

+ sounds/springextend3-03.ogg view

binary file changed (absent → 5953 bytes)

+ sounds/springextend3-04.ogg view

binary file changed (absent → 4391 bytes)

+ sounds/springextend4-01.ogg view

binary file changed (absent → 4321 bytes)

+ sounds/springextend4-02.ogg view

binary file changed (absent → 4767 bytes)

+ sounds/springextend4-03.ogg view

binary file changed (absent → 6099 bytes)

+ sounds/springextend4-04.ogg view

binary file changed (absent → 4421 bytes)

+ sounds/springextend5-01.ogg view

binary file changed (absent → 4333 bytes)

+ sounds/springextend5-02.ogg view

binary file changed (absent → 4650 bytes)

+ sounds/springextend5-03.ogg view

binary file changed (absent → 6105 bytes)

+ sounds/springextend5-04.ogg view

binary file changed (absent → 4496 bytes)

+ sounds/springextend6-01.ogg view

binary file changed (absent → 4129 bytes)

+ sounds/springextend6-02.ogg view

binary file changed (absent → 4382 bytes)

+ sounds/springextend6-03.ogg view

binary file changed (absent → 5760 bytes)

+ sounds/springextend6-04.ogg view

binary file changed (absent → 4409 bytes)

+ sounds/springextend7-01.ogg view

binary file changed (absent → 4178 bytes)

+ sounds/springextend7-02.ogg view

binary file changed (absent → 4337 bytes)

+ sounds/springextend7-03.ogg view

binary file changed (absent → 5544 bytes)

+ sounds/springextend7-04.ogg view

binary file changed (absent → 4436 bytes)

+ sounds/springextend8-01.ogg view

binary file changed (absent → 4121 bytes)

+ sounds/springextend8-02.ogg view

binary file changed (absent → 4308 bytes)

+ sounds/springextend8-03.ogg view

binary file changed (absent → 5453 bytes)

+ sounds/springextend8-04.ogg view

binary file changed (absent → 4368 bytes)

+ sounds/springextend9-01.ogg view

binary file changed (absent → 4160 bytes)

+ sounds/springextend9-02.ogg view

binary file changed (absent → 4275 bytes)

+ sounds/springextend9-03.ogg view

binary file changed (absent → 5435 bytes)

+ sounds/springextend9-04.ogg view

binary file changed (absent → 4393 bytes)

+ sounds/unlocked-01.ogg view

binary file changed (absent → 7986 bytes)

+ sounds/unlocked-02.ogg view

binary file changed (absent → 6374 bytes)

+ sounds/unlocked-03.ogg view

binary file changed (absent → 6521 bytes)

+ sounds/unlocked-04.ogg view

binary file changed (absent → 5399 bytes)

+ sounds/unlocked-05.ogg view

binary file changed (absent → 6689 bytes)

+ sounds/wrenchblocked-01.ogg view

binary file changed (absent → 5825 bytes)

+ sounds/wrenchblocked-02.ogg view

binary file changed (absent → 5588 bytes)

+ sounds/wrenchblocked-03.ogg view

binary file changed (absent → 4899 bytes)

+ sounds/wrenchscrape-01.ogg view

binary file changed (absent → 5119 bytes)

+ sounds/wrenchscrape-02.ogg view

binary file changed (absent → 5221 bytes)

+ sounds/wrenchscrape-03.ogg view

binary file changed (absent → 5070 bytes)

+ sounds/wrenchscrape-04.ogg view

binary file changed (absent → 5125 bytes)

tutorial/1-winning.text view

@@ -1,1 +1,1 @@-use tools to pull bolt, then Open the lock+click and drag tools to pull bolt, then Open the lock

− tutorial/2-hook.lock

@@ -1,11 +0,0 @@-       " " " " " "       -      " # # # # # " " "  -     " # # # # # # "   " -    " # # S S S S & & & "-   " # # ] #     & & " " -  " # # # ] # # #     "  - " "   # # ]         "   -" * ' &     ] # % % "    - " @ " Z     % Z % "     -  " " " Z       Z "      -       " " " " " "

− tutorial/2-hook.text

@@ -1,1 +0,0 @@-the hook is a versatile tool; move and rotate it to push the springs aside

+ tutorial/2-wrench.lock view

@@ -0,0 +1,17 @@+        " " " " " " " " "          +       "                 " " " "   +      "   % S S S S S &   "     "  +     "     O   %       &   "     " +    " % % % %   o -   & & & & & & "+   "         %   %           "   " +  "           %   % %   # # # " "  + "             %             # "   +"               % % %   # # # # "  + "             % %             "   +  "             %         O   "    + " "         &   % %   % % % "     +" * ' & & & & &     \     % "      + " @ "         & & & o   % "       +  " " "         &       % "        +       "         &     % "         +        " " " " " " " " "

+ tutorial/2-wrench.text view

@@ -0,0 +1,1 @@+the wrench moves in a line until it hits something; you can undo ('X') mistakes

+ tutorial/3-hook.lock view

@@ -0,0 +1,11 @@+       & & & & & &       +      & S S " " " & & &  +     & S S " %   " &   & +    & ~ ~     % ' " " " &+   & ~   ~     o     & & +  & ~   # %     ` % % &  + & &   7 %         % &   +& * ' 7 %     # # # &    + & @ & %     # # # &     +  & & & % C C C C &      +       & & & & & &

+ tutorial/3-hook.text view

@@ -0,0 +1,1 @@+turn hook with mouse wheel to pull springs aside; numpad and vi keys also supported

− tutorial/3-wrench.lock

@@ -1,17 +0,0 @@-        " " " " " " " " "          -       "                 " " " "   -      "   % S S S S S &   "     "  -     "     O   %       &   "     " -    " % % % %   o -   & & & & & & "-   "         %   %           "   " -  "           %   % %   # # # " "  - "             %             # "   -"               % % %   # # # # "  - "             % %             "   -  "             %         O   "    - " "         &   % %   % % % "     -" * ' & & & & &     \     % "      - " @ "         & & & o   % "       -  " " "         &       % "        -       "         &     % "         -        " " " " " " " " "

− tutorial/3-wrench.text

@@ -1,1 +0,0 @@-you have less fine control over the wrench; it moves until stopped

tutorial/4-plug.lock view

@@ -1,17 +1,17 @@-        & & & & & & & & &          -       & #             [ & & & &   -      &   #           [   &     &  -     &     #         (     & # # & -    &       #       (   # # #     &-   & # # # # #     (   #   7 &   & -  &         %     (       7   & &  - &           Z   (       % % % &   -&             Z (       # S S % &  - &             "               &   -  &             ]             &    - & &             ] % % % % % &     -& * '             # %       &      - & @ &               %     &       -  & & &               %   &        -       &               % &         -        & & & & & & & & &          +        " " " " " " " " "          +       " #             ( " " " "   +      "   #           (   "     "  +     "   # #         (     " #   " +    "   #   #       (       #     "+   "         #     (       # "   " +  "   & &   %     (         # " "  + "   & & & & Z   (         # # "   +"   # C C & & Z (       # #   # "  + "   & & & & & #             7 "   +  "   & & & & & ]           7 "    + " "     & & &   ] %       7 "     +" * '   o \ O   # " %     7 "      + " @ "   ` o     #   %   7 "       +  " " "   #   %   #   % 7 "        +       "     % %       % "         +        " " " " " " " " "

tutorial/4-plug.text view

@@ -1,1 +1,1 @@-Co-ordinate the tools. Keyboard control advised; rebind with ^B or right-click.+compress the central springs with both tools at once