diff --git a/AsciiLock.hs b/AsciiLock.hs
--- a/AsciiLock.hs
+++ b/AsciiLock.hs
@@ -3,23 +3,21 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
 
 module AsciiLock (lockToAscii, lockOfAscii, stateToAscii
-    , readAsciiLockFile, writeAsciiLockFile) where
+    , readAsciiLockFile, writeAsciiLockFile, monochromeOTileChar) where
 
 import Data.Function (on)
 import Control.Applicative hiding ((<*>))
 import Control.Monad
 import Control.Arrow ((&&&))
-import System.IO
 import qualified Data.Map as Map
 import Data.Map (Map)
 import qualified Data.Vector as Vector
-import Data.Vector (Vector, (!), (//))
 import Data.Maybe
 import Data.Traversable as T
 import Data.List
@@ -38,7 +36,7 @@
 type AsciiLock = [String]
 
 lockToAscii :: Lock -> AsciiLock
-lockToAscii (_,st) = stateToAscii st
+lockToAscii = stateToAscii . snd
 
 stateToAscii :: GameState -> AsciiLock
 stateToAscii st =
@@ -48,7 +46,7 @@
 lockOfAscii :: AsciiLock -> Maybe Lock
 lockOfAscii lines = do
     board <- asciiToBoard lines
-    let size = maximum $ map (hx . (<->origin))$ Map.keys board
+    let size = maximum $ map (hx . (<->origin)) $ Map.keys board
 	frame = BasicFrame size
     st <- asciiBoardState frame board
     return (frame, st)
@@ -61,7 +59,7 @@
 	(miny,maxy) = minmax $ map cy $ Map.keys asciiBoard
 	(minx,maxx) = minmax $ map cx $ Map.keys asciiBoard
 	asciiBoard' = Map.mapKeys (<->CVec miny minx) asciiBoard
-    in [ [ Map.findWithDefault ' ' (CVec y x) asciiBoard' 
+    in [ [ Map.findWithDefault ' ' (CVec y x) asciiBoard'
 	    | x <- [0..(maxx-minx)] ]
 	| y <- [0..(maxy-miny)] ]
 
@@ -94,40 +92,41 @@
 	addBaseOT :: (HexPos,(PieceIdx,Tile)) -> GameState -> GameState
 	addBaseOT (pos,(o,BlockTile [])) = addBlockPos o pos
 	addBaseOT (pos,(-1,t)) = addpp $ PlacedPiece pos $ basePieceOfTile t
+	addBaseOT _ = error "owned non-block tile in AsciiLock.asciiBoardState"
 	basePieceOfTile (PivotTile _) = Pivot []
 	basePieceOfTile HookTile = Hook hu NullHF
 	basePieceOfTile (WrenchTile _) = Wrench zero
 	basePieceOfTile BallTile = Ball
+	basePieceOfTile _ = error "Unexpected tile in AsciiLock.asciiBoardState"
 	componentifyNew st = foldr ((fst.).componentify) st $ filter (/=0) $ ppidxs st
 	-- | we assume that the largest wholly out-of-bounds block is the frame
 	setFrame st = fromMaybe st $ do
-	    (idx,pp) <- listToMaybe $ sortBy (flip compare `on` blockSize . placedPiece . snd)
-		    [ (idx,pp)
+	    (idx,pp) <- listToMaybe $ map fst $ sortBy (flip compare `on` snd)
+		    [ ((idx,pp),length vs)
 		    | (idx,pp) <- enumVec $ placedPieces st
-		    , isBlock . placedPiece $ pp
+		    , Block vs <- [placedPiece pp]
 		    , let fp = plPieceFootprint pp
 		    , not $ null fp
 		    , all (not.inBounds frame) fp
 		    ]
 	    return $ delPiece idx $ setpp 0 pp st
-	blockSize (Block vs) = length vs
 	baseSt = setFrame . componentifyNew . addBase . addPreBase $ GameState Vector.empty []
 
 	baseBoard = stateBoard baseSt
 	addAppendages :: GameState -> Maybe GameState
 	addAppendages st = foldM addAppendageOT st $ Map.toList $
 	    Map.filter (not.isBaseTile.snd) board
-	addAppendageOT st (pos,(-1,ArmTile dir _)) = 
+	addAppendageOT st (pos,(-1,ArmTile dir _)) =
 	    let rpos = (neg dir<+>pos)
 	    in case Map.lookup rpos baseBoard of
 		Just (idx,PivotTile _) -> Just $ addPivotArm idx pos st
 		Just (idx,HookTile) -> Just $ setpp idx (PlacedPiece rpos (Hook dir NullHF)) st
 		_ -> Nothing
-	addAppendageOT st (pos,(-1,SpringTile extn dir)) =
+	addAppendageOT st (pos,(-1,SpringTile _ dir)) =
 	    let rpos = (neg dir<+>pos)
 	    in case Map.lookup rpos baseBoard of
 		Just (_,SpringTile _ _) -> Just st
-		Just (ridx,tile) -> do
+		Just _ -> do
 		    (_,epos) <- castRay pos dir baseBoard
 		    let twiceNatLen = sum [ extnValue extn
 			    | i <- [1..hexLen (epos<->rpos)-1]
@@ -152,8 +151,9 @@
 	Just 4 -> '~'
 	_ -> '#'
 monochromeOTileChar _ (_,t) = monochromeTileChar t
+monochromeTileChar :: Tile -> Char
 monochromeTileChar (PivotTile _) = 'o'
-monochromeTileChar (ArmTile dir _) 
+monochromeTileChar (ArmTile dir _)
     | dir == hu = '-'
     | dir == hv = '\\'
     | dir == hw = '/'
@@ -188,6 +188,7 @@
 	Stretched                  -> '1'
 	Relaxed                    -> '7'
 	Compressed                 -> '9'
+monochromeTileChar _ = '?'
 monoToOTile :: Char -> Maybe OwnedTile
 monoToOTile '#' = Just $ (1,BlockTile [])
 monoToOTile '%' = Just $ (2,BlockTile [])
@@ -195,6 +196,7 @@
 monoToOTile '&' = Just $ (4,BlockTile [])
 monoToOTile '~' = Just $ (5,BlockTile [])
 monoToOTile ch = ((,) (-1)) <$> monoToTile ch
+monoToTile :: Char -> Maybe Tile
 monoToTile 'o' = Just $ PivotTile zero
 monoToTile '-' = Just $ ArmTile hu False
 monoToTile '\\' = Just $ ArmTile hv False
@@ -242,4 +244,3 @@
     writeStrings path $ lockToAscii lock ++ case msoln of
 	Nothing -> []
 	Just soln -> ["Solution:", show soln]
-
diff --git a/BinaryInstances.hs b/BinaryInstances.hs
--- a/BinaryInstances.hs
+++ b/BinaryInstances.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
@@ -61,7 +61,7 @@
 
 instance Binary HexVec where
     put (HexVec x y _) = putPackedInt x >> putPackedInt y
-    get = do 
+    get = do
 	x <- getPackedInt
 	y <- getPackedInt
 	return $ tupxy2hv (x,y)
@@ -131,4 +131,3 @@
 	    1 -> liftM HookPush get
 	    2 -> liftM HookTorque getPackedInt
 	    3 -> liftM WrenchPush get
-
diff --git a/BoardColouring.hs b/BoardColouring.hs
--- a/BoardColouring.hs
+++ b/BoardColouring.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
@@ -17,7 +17,6 @@
 import Data.Map (Map)
 import qualified Data.Set as Set
 import Data.Set (Set)
-import qualified Data.Vector as Vector
 import Data.List
 import Data.Maybe
 
@@ -41,8 +40,8 @@
     [ (idx, col) | (idx, PlacedPiece _ p) <- enumVec $ placedPieces st
 	, idx `elem` coloured
 	, let col = if isBlock p then 1+((connGraphHeight st idx - 1) `mod` 5) else 0 ]
-    
 
+
 boardColouring :: GameState -> [PieceIdx] -> PieceColouring -> PieceColouring
 boardColouring st coloured lastCol =
    fiveColour graph lastCol
@@ -50,7 +49,7 @@
 	board = stateBoard st
 	graph = Map.fromList [ (idx, nub $ neighbours idx)
 	    | idx <- coloured ]
-	neighbours idx = 
+	neighbours idx =
 	    neighbours' idx (perim idx) []
 	perim :: PieceIdx -> Set (HexPos,HexDir)
 	perim idx =
@@ -63,7 +62,7 @@
 		    return $ idx == idx'
 		]
 	neighbours' :: PieceIdx -> Set (HexPos,HexDir) -> [PieceIdx] -> [PieceIdx]
-	neighbours' idx as ns 
+	neighbours' idx as ns
 	    | Set.null as = ns
 	    | otherwise =
 		let a = head $ Set.elems as
@@ -76,18 +75,18 @@
 	march idx startPos (pos,basedir) init
 	    | not init && pos == startPos = ([],[])
 	    | otherwise =
-	    let n = do 
+	    let mn = do
 		    (idx',_) <- Map.lookup pos board
 		    guard $ idx' `elem` coloured
 		    return idx'
-		mNext = listToMaybe 
+		mNext = listToMaybe
 		    [ (pos', rotate (h-2) basedir)
-		    | h <- [1..5] 
+		    | h <- [1..5]
 		    , let pos' = (rotate h basedir)<+>pos
 		    , (fst <$> Map.lookup pos' board) /= Just idx
 		    ]
 		(path,ns) = case mNext of
 		    Nothing -> ([],[])
 		    Just next -> march idx startPos next False
-	    in (pos:path, (maybeToList n)++ns)
+	    in (pos:path, (maybeToList mn)++ns)
 
diff --git a/CVec.hs b/CVec.hs
--- a/CVec.hs
+++ b/CVec.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
@@ -19,11 +19,10 @@
     mempty = CVec 0 0
     mappend (CVec y x) (CVec y' x') = CVec (y+y') (x+x')
 instance Grp CVec where
-    neg (CVec y x) = CVec (-y) (-x) 
+    neg (CVec y x) = CVec (-y) (-x)
 type CCoord = PHS CVec
 
 hexVec2CVec :: HexVec -> CVec
-hexVec2CVec (HexVec x y z) = CVec (-y) (x-z) 
+hexVec2CVec (HexVec x y z) = CVec (-y) (x-z)
 cVec2HexVec :: CVec -> HexVec
 cVec2HexVec (CVec y x) = HexVec ((x+y)`div`2) (-y) ((y-x)`div`2)
-
diff --git a/Cache.hs b/Cache.hs
--- a/Cache.hs
+++ b/Cache.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
@@ -49,7 +49,7 @@
 	    let action = case rec of
 		    RecUserInfo name ->
 			let curVersion = (\(RCUserInfo (v,_)) -> v) <$> fromCache
-			in GetUserInfo name curVersion 
+			in GetUserInfo name curVersion
 		    _ -> askForRecord rec
 	    resp <- makeRequest saddr (ClientRequest
 		    protocolVersion (if needsAuth action then auth else Nothing) action)
@@ -83,7 +83,7 @@
 	    `catchIO` (const $ return $ ServerError $ "Cannot connect to "++saddrStr saddr++"!")
     where
 	makeRequest' hdl = do
-	    BS.hPut hdl $ BL.toStrict $ encode request 
+	    BS.hPut hdl $ BL.toStrict $ encode request
 	    hFlush hdl
 	    (decode . BL.fromStrict) `liftM` BS.hGetContents hdl
 
diff --git a/Command.hs b/Command.hs
--- a/Command.hs
+++ b/Command.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
@@ -13,52 +13,57 @@
 import GameStateTypes
 import Metagame
 
-data Command = CmdDir WrHoSel HexDir | CmdRotate WrHoSel TorqueDir | CmdWait
-	| CmdMoveTo HexPos | CmdManipulateToolAt HexPos
-	| CmdDrag HexPos HexDir
-	| CmdToggle
-	| CmdOpen
-	| CmdTile Tile | CmdPaint (Maybe Tile)
-	| CmdPaintFromTo (Maybe Tile) HexPos HexPos
-	| CmdSelect | CmdUnselect
-	| CmdDelete | CmdMerge
-	| CmdMark | CmdJumpMark | CmdReset
-	| CmdPlay | CmdTest
-	| CmdUndo | CmdRedo
-	| CmdReplayForward Int | CmdReplayBack Int
-	| CmdInputChar Char
-	| CmdInputSelLock LockIndex | CmdInputCodename Codename | CmdInputSelUndecl Undeclared
-	| CmdWriteState
-	| CmdTutorials
-	| CmdShowRetired | CmdPlayLockSpec (Maybe LockSpec)
-	| CmdSetServer | CmdToggleCacheOnly
-	| CmdSelCodename (Maybe Codename) | CmdBackCodename | CmdHome
-	| CmdSolve (Maybe LockIndex) | CmdDeclare (Maybe Undeclared)
-	| CmdViewSolution (Maybe NoteInfo)
-	| CmdSelectLock | CmdNextLock | CmdPrevLock
-	| CmdEdit | CmdPlaceLock (Maybe LockIndex)
-	| CmdRegister | CmdAuth
-	| CmdNextPage | CmdPrevPage
-	| CmdRedraw | CmdRefresh | CmdSuspend
-	| CmdQuit | CmdForceQuit
-	| CmdHelp | CmdBind
-	| CmdNone
+data Command
+    = CmdDir WrHoSel HexDir | CmdRotate WrHoSel TorqueDir | CmdWait
+    | CmdMoveTo HexPos | CmdManipulateToolAt HexPos
+    | CmdDrag HexPos HexDir
+    | CmdToggle
+    | CmdOpen
+    | CmdTile Tile | CmdPaint (Maybe Tile)
+    | CmdPaintFromTo (Maybe Tile) HexPos HexPos
+    | CmdSelect | CmdUnselect
+    | CmdDelete | CmdMerge
+    | CmdMark | CmdJumpMark | CmdReset
+    | CmdPlay | CmdTest
+    | CmdUndo | CmdRedo
+    | CmdReplayForward Int | CmdReplayBack Int
+    | CmdInputChar Char
+    | CmdInputSelLock LockIndex
+    | CmdInputCodename Codename
+    | CmdInputSelUndecl Undeclared
+    | CmdWriteState
+    | CmdTutorials
+    | CmdShowRetired | CmdPlayLockSpec (Maybe LockSpec)
+    | CmdSetServer | CmdToggleCacheOnly
+    | CmdSelCodename (Maybe Codename) | CmdBackCodename | CmdHome
+    | CmdSolve (Maybe LockIndex) | CmdDeclare (Maybe Undeclared)
+    | CmdViewSolution (Maybe NoteInfo)
+    | CmdSelectLock | CmdNextLock | CmdPrevLock
+    | CmdEdit | CmdPlaceLock (Maybe LockIndex)
+    | CmdRegister | CmdAuth
+    | CmdNextPage | CmdPrevPage
+    | CmdToggleColourMode
+    | CmdRedraw | CmdRefresh | CmdSuspend
+    | CmdQuit | CmdForceQuit
+    | CmdHelp | CmdBind
+    | CmdNone
     deriving (Eq, Ord, Show, Read)
 data WrHoSel = WHSWrench | WHSHook | WHSSelected
     deriving (Eq, Ord, Show, Read)
-	
+
 describeCommand :: Command -> String
 describeCommand (CmdDir whs dir) = "move " ++ whsStr whs ++ " " ++ dirStr dir
-describeCommand (CmdRotate whs dir) = "rotate " ++ whsStr whs ++ " " ++ (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"
 describeCommand (CmdTile tile) = tileStr tile
-describeCommand CmdMerge = "merge with adjacent piece" 
+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 CmdSelect = "select piece"
 describeCommand CmdUnselect = "unselect piece"
 describeCommand CmdDelete = "delete piece"
 describeCommand CmdPlay = "play lock"
@@ -72,23 +77,30 @@
 describeCommand CmdShowRetired = "show retired locks"
 describeCommand CmdSetServer = "set server"
 describeCommand CmdToggleCacheOnly = "toggle using only cache"
-describeCommand (CmdSelCodename mname) = "select player" ++ maybe "" (' ':) mname
+describeCommand (CmdSelCodename mname) = "select player"
+	++ maybe "" (' ':) mname
 describeCommand CmdBackCodename = "select last player"
 describeCommand CmdHome = "select self"
-describeCommand (CmdSolve mli) = "solve lock" ++ maybe "" ((' ':).(:"").lockIndexChar) mli
-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 (CmdSolve mli) = "solve lock"
+	++ maybe "" ((' ':).(:"").lockIndexChar) mli
+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 by name"
 describeCommand CmdNextLock = "next lock"
 describeCommand CmdPrevLock = "previous lock"
 describeCommand CmdNextPage = "page forward through lists"
 describeCommand CmdPrevPage = "page back through lists"
 describeCommand CmdEdit = "edit lock"
-describeCommand (CmdPlaceLock mli) = "place lock" ++ maybe "" ((' ':).(:"").lockIndexChar) mli
+describeCommand (CmdPlaceLock mli) = "place lock"
+	++ maybe "" ((' ':).(:"").lockIndexChar) mli
 describeCommand CmdRegister = "register codename"
 describeCommand CmdAuth = "authenticate"
 describeCommand CmdBind = "bind key"
+describeCommand CmdToggleColourMode = "toggle lock colour mode"
 describeCommand CmdQuit = "quit"
 describeCommand CmdHelp = "help"
 describeCommand _ = ""
diff --git a/CursesRender.hs b/CursesRender.hs
--- a/CursesRender.hs
+++ b/CursesRender.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
@@ -19,25 +19,26 @@
 import CVec
 import GameStateTypes
 import BoardColouring (PieceColouring)
+import AsciiLock
 
 -- From Curses.CursesHelper:
 -- | Converts a list of 'Curses.Color' pairs (foreground color and
 --   background color) into the curses representation 'Curses.Pair'.
 colorsToPairs :: [(Curses.Color, Curses.Color)] -> IO [Curses.Pair]
-colorsToPairs cs =
-    do p <- Curses.colorPairs
-       let nColors = length cs
-           blackWhite = p < nColors
-       if blackWhite then do
-	    print ("Terminal does not support enough colors. Number of " ++
-                      " colors requested: " ++ show nColors ++
-                      ". Number of colors supported: " ++ show p)
-	    return $ replicate nColors $ Curses.Pair 0
-          else mapM toPairs (zip [1..] cs)
-     where toPairs (n, (fg, bg)) =
-               let p = Curses.Pair n
-               in do Curses.initPair p fg bg
-                     return p
+colorsToPairs cs = do
+    p <- Curses.colorPairs
+    let nColors = length cs
+	blackWhite = p < nColors
+    if blackWhite then do
+	print ("Terminal does not support enough colors. Number of " ++
+		  " colors requested: " ++ show nColors ++
+		  ". Number of colors supported: " ++ show p)
+	return $ replicate nColors $ Curses.Pair 0
+    else mapM toPairs (zip [1..] cs)
+    where toPairs (n, (fg, bg)) = do
+	    let p = Curses.Pair n
+	    Curses.initPair p fg bg
+	    return p
 
 type AttrChar = (Char, Curses.Attr)
 type ColPair = Int
@@ -52,19 +53,21 @@
 data Glyph = Glyph Char ColPair Curses.Attr
 a0 = Curses.attr0
 bold = Curses.setBold a0 True
+
 tileChar :: Tile -> AttrChar
 tileChar (BlockTile _) = ('#',a0)
-tileChar (PivotTile dir) | dir == zero = ('o',bold)
+tileChar (PivotTile dir)
+    | dir == zero = ('o',bold)
     | canonDir dir == hu = ('-',bold)
     | canonDir dir == hv = ('\\',bold)
     | canonDir dir == hw = ('/',bold)
-tileChar (ArmTile dir principal) = let
-    cdir = canonDir dir
-    c | cdir == hu = '-'
-      | cdir == hv = '\\'
-      | cdir == hw = '/'
-      | otherwise = '?'
-    a = if principal then bold else a0
+tileChar (ArmTile dir principal) =
+    let cdir = canonDir dir
+	c | cdir == hu = '-'
+	  | cdir == hv = '\\'
+	  | cdir == hw = '/'
+	  | otherwise = '?'
+	a = if principal then bold else a0
     in (c,a)
 tileChar HookTile = ('@',bold)
 tileChar (WrenchTile mom) = ('*',if mom /= zero then bold else a0)
@@ -74,8 +77,10 @@
 tileChar (SpringTile Stretched _) = ('s',bold)
 tileChar _ = ('?',bold)
 
-ownedTileGlyph :: PieceColouring -> [PieceIdx] -> OwnedTile -> Glyph
-ownedTileGlyph colouring reversed (owner,t) =
+ownedTileGlyph :: Bool -> PieceColouring -> [PieceIdx] -> OwnedTile -> Glyph
+ownedTileGlyph mono@True colouring reversed ot =
+    Glyph (monochromeOTileChar colouring ot) white a0
+ownedTileGlyph mono@False colouring reversed (owner,t) =
     let (ch,attr) = tileChar t
 	pair = case Map.lookup owner colouring of
 		    Nothing -> 0
diff --git a/CursesUI.hs b/CursesUI.hs
--- a/CursesUI.hs
+++ b/CursesUI.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
@@ -35,19 +35,21 @@
 import CursesRender
 import CVec
 
-data UIState = UIState { dispCPairs::[Curses.Pair], dispCentre::HexPos
-    , dispLastCol::PieceColouring, uiKeyBindings :: Map InputMode KeyBindings
+data UIState = UIState
+    { dispCPairs::[Curses.Pair]
+    , dispCentre::HexPos
+    , dispLastCol::PieceColouring
+    , uiKeyBindings :: Map InputMode KeyBindings
+    , monochrome::Bool
     , message::Maybe (Curses.Attr, ColPair, String)}
 type UIM = StateT UIState IO
-nullUIState = UIState [] (PHS zero) Map.empty Map.empty Nothing
+nullUIState = UIState [] (PHS zero) Map.empty Map.empty False Nothing
 
 readBindings :: UIM ()
-readBindings = do 
+readBindings = void.runMaybeT $ do
     path <- liftIO $ confFilePath "bindings"
-    mbdgs <- liftIO $ readReadFile path
-    case mbdgs of
-	Just bdgs -> modify $ \s -> s {uiKeyBindings = bdgs}
-	Nothing -> return ()
+    bdgs <- MaybeT $ liftIO $ readReadFile path
+    lift $ modify $ \s -> s {uiKeyBindings = bdgs}
 writeBindings :: UIM ()
 writeBindings = do
     path <- liftIO $ confFilePath "bindings"
@@ -56,15 +58,14 @@
     liftIO $ writeFile path $ show bdgs
 
 getBindings mode = do
-    uibdgs <- Map.findWithDefault [] mode `liftM` gets uiKeyBindings
+    uibdgs <- Map.findWithDefault [] mode <$> gets uiKeyBindings
     return $ uibdgs ++ bindings mode
 
 bindingsStr :: InputMode -> [Command] -> UIM String
 bindingsStr mode cmds = do
-    uibdgs <- Map.findWithDefault [] mode `liftM` gets uiKeyBindings
-    return $ (\x -> "["++x++"]") $ intercalate "," $
-	[ maybe "" showKey $ findBinding (uibdgs ++ bindings mode) cmd
-	    | cmd <- cmds ]
+    bdgs <- getBindings mode
+    return $ (("["++).(++"]")) $ intercalate "," $
+	map (maybe "" showKey . findBinding bdgs) cmds
 
 
 erase :: UIM ()
@@ -74,7 +75,7 @@
 
 type Geom = (CVec, HexPos)
 getGeom :: UIM Geom
-getGeom = do 
+getGeom = do
     (h,w) <- liftIO Curses.scrSize
     centre <- gets dispCentre
     return (CVec (h`div`2) (w`div`2), centre)
@@ -101,7 +102,7 @@
 drawCursorAt :: Maybe HexPos -> UIM ()
 drawCursorAt Nothing =
     void $ liftIO $ Curses.cursSet Curses.CursorInvisible
-drawCursorAt (Just pos) = do 
+drawCursorAt (Just pos) = do
     geom@(scrCentre,centre) <- getGeom
     liftIO $ Curses.cursSet Curses.CursorVisible
     liftIO $ move $ scrCentre <+> (hexVec2CVec $ pos <-> centre)
@@ -112,11 +113,11 @@
     colouring <- drawStateWithGeom reversed colourFixed lastCol st =<< getGeom
     modify $ \ds -> ds { dispLastCol = colouring }
 
--- TODO: monochrome mode
 drawStateWithGeom reversed colourFixed lastCol st geom = do
     let colouring = boardColouring st (colouredPieces colourFixed st) lastCol
-    sequence_ [ drawAtWithGeom glyph pos geom | 
-	(pos,glyph) <- Map.toList $ fmap (ownedTileGlyph colouring reversed) $ stateBoard st
+    mono <- gets monochrome
+    sequence_ [ drawAtWithGeom glyph pos geom |
+	(pos,glyph) <- Map.toList $ fmap (ownedTileGlyph mono colouring reversed) $ stateBoard st
 	]
     return colouring
 
@@ -135,6 +136,6 @@
     (h,w) <- liftIO Curses.scrSize
     drawStrCentred a0 white (CVec 0 (w`div`2)) title
 drawTitle Nothing = return ()
-    
+
 say = setMsgLine bold white
 sayError = setMsgLine bold red
diff --git a/CursesUIMInstance.hs b/CursesUIMInstance.hs
--- a/CursesUIMInstance.hs
+++ b/CursesUIMInstance.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
@@ -47,15 +47,15 @@
 import CVec
 
 
-drawName :: Bool -> CVec -> Codename -> StateT MainState UIM ()
+drawName :: Bool -> CVec -> Codename -> MainStateT UIM ()
 drawName showScore pos name = do
     ourName <- (authUser <$>) <$> gets curAuth
     relScore <- getRelScore name
     let (attr,col) = case relScore of
 	    Just 0 -> (a0,yellow)
-	    Just 1 -> (bold,cyan) 
-	    Just 2 -> (a0,green) 
-	    Just 3 -> (bold,green) 
+	    Just 1 -> (bold,cyan)
+	    Just 2 -> (a0,green)
+	    Just 3 -> (bold,green)
 	    Just (-1) -> (bold,magenta)
 	    Just (-2) -> (a0,red)
 	    Just (-3) -> (bold,red)
@@ -63,14 +63,30 @@
     lift $ drawStrCentred attr col pos
 	(name ++ if showScore then " " ++ maybe "" show relScore else "")
 
-drawActiveLock :: CVec -> ActiveLock -> StateT MainState UIM ()
-drawActiveLock pos (ActiveLock name i) = do
+drawActiveLock :: CVec -> ActiveLock -> MainStateT UIM ()
+drawActiveLock pos al@(ActiveLock name i) = do
+    accessed <- accessedAL al
+    drawNameWithChar pos name
+	(if accessed then green else white)
+	(lockIndexChar i)
+
+drawNameWithChar :: CVec -> Codename -> ColPair -> Char -> MainStateT UIM ()
+drawNameWithChar pos name charcol char = do
     drawName False (pos <+> CVec 0 (-1)) name
-    lift $ drawStr bold white (pos <+> CVec 0 1) [':',lockIndexChar i]
+    lift $ drawStr bold charcol (pos <+> CVec 0 1) [':',char]
 
+drawNote :: CVec -> NoteInfo -> MainStateT UIM ()
+drawNote pos note = case noteBehind note of
+    Just al -> drawActiveLock pos al
+    Nothing -> drawPublicNote pos (noteAuthor note)
+    where
+        drawPublicNote pos name =
+            drawNameWithChar pos name magenta 'P'
+
+
 data Gravity = GravUp | GravLeft | GravRight | GravDown | GravCentre
     deriving (Eq, Ord, Show, Enum)
-fillBox :: CVec -> CVec -> Int -> Gravity -> [CVec -> StateT MainState UIM ()] -> StateT MainState UIM Int
+fillBox :: CVec -> CVec -> Int -> Gravity -> [CVec -> MainStateT UIM ()] -> MainStateT UIM Int
 fillBox (CVec t l) (CVec b r) width grav draws = do
     let half = width`div`2
 	starty = (if grav == GravDown then b else t)
@@ -117,17 +133,19 @@
 	]
 
     startOn <-
-	if (public lockinfo) 
+	if (public lockinfo)
 	then lift $ drawStrCentred bold white (CVec (lockTop-1) vcentre) "Everyone!"
 	    >> return (lockTop-1)
 	else if null $ accessedBy lockinfo
 	    then lift $ drawStrCentred a0 white (CVec (lockTop-1) vcentre) "No-one"
 		>> return (lockTop-1)
 	    else
-		fillBox (CVec (top+1) (left+1)) (CVec (lockTop-1) (right-1)) 3 GravDown $
-		    [ \pos -> drawName False pos name | name <- accessedBy lockinfo ]
+		fillBox (CVec (top+1) (left+1)) (CVec (lockTop-1) (right-1)) 5 GravDown $
+        [ \pos -> drawNote pos note | note <- lockSolutions lockinfo ] ++
+        [ \pos -> drawName False pos name
+		    | name <- accessedBy lockinfo \\ map noteAuthor (lockSolutions lockinfo) ]
     lift $ drawStrCentred a0 white (CVec (startOn-1) vcentre) "Accessed by:"
-    
+
     undecls <- gets undeclareds
     if isJust $ guard . (|| public lockinfo) . (`elem` accessedBy lockinfo) =<< ourName
     then lift $ drawStrCentred a0 green (CVec (lockBottom+1) vcentre) "Accessed!"
@@ -186,7 +204,7 @@
 	drawMainState' (EditState { esGameStateStack=(st:_), selectedPiece=selPiece, selectedPos=selPos }) = lift $ do
 	    drawState (maybeToList selPiece) True [] st
 	    drawCursorAt $ if isNothing selPiece then Just selPos else Nothing
-	drawMainState' (MetaState saddr undecls cOnly auth names _ _ rnamestvar _ _ mretired path lock _) = do
+	drawMainState' (MetaState saddr undecls cOnly auth names _ _ _ rnamestvar _ _ mretired path lock _) = do
 	    let ourName = liftM authUser auth
 	    let selName = listToMaybe names
 	    let home = isJust ourName && ourName == selName
@@ -243,10 +261,10 @@
 		    void $ fillBox (CVec 2 5) (CVec 5 (w`div`3)) 3 GravCentre
 			[ \pos -> drawName False pos name | name <- rnames ]
 	    when (ourName /= selName) $ void $ runMaybeT $ do
-		sel <- MaybeT $ return selName
-		us <- MaybeT $ return ourName
+		sel <- liftMaybe selName
+		us <- liftMaybe ourName
 		ourUInfo <- mgetUInfo us
-		let accessed = [ ActiveLock us i 
+		let accessed = [ ActiveLock us i
 			| i<-[0..2]
 			, Just lock <- [ userLocks ourUInfo ! i ]
 			, public lock || selName `elem` map Just (accessedBy lock) ]
@@ -262,7 +280,7 @@
 
     reportAlerts _ alerts =
 	do mapM_ drawAlert alerts
-	   unless (null alerts) 
+	   unless (null alerts)
 	    $ do refresh
 		 liftIO $ threadDelay $ 5*10^4
 	where
@@ -306,13 +324,14 @@
 	bdgs <- getBindings mode
 	return $ maybe "" showKey $ findBinding bdgs cmd
 
-    initUI = 
-	do liftIO CursesH.start 
-	   cpairs <- liftIO $ colorsToPairs [ (f, CursesH.black) | f <-
-		[ CursesH.white, CursesH.red, CursesH.green, CursesH.yellow, CursesH.blue, CursesH.magenta, CursesH.cyan] ] 
-	   modify $ \s -> s {dispCPairs = cpairs}
-	   readBindings
-	   return True
+    initUI = do
+	liftIO CursesH.start
+	cpairs <- liftIO $ colorsToPairs [ (f, CursesH.black)
+	    | f <- [ CursesH.white, CursesH.red, CursesH.green, CursesH.yellow
+		, CursesH.blue, CursesH.magenta, CursesH.cyan] ]
+	modify $ \s -> s {dispCPairs = cpairs}
+	readBindings
+	return True
 
     endUI = do
 	writeBindings
@@ -320,8 +339,8 @@
     unblockInput = return $ Curses.ungetCh 0
     suspend = do
 	liftIO $ do
-	    CursesH.suspend 
-	    Curses.resetParams 
+	    CursesH.suspend
+	    Curses.resetParams
 	redraw
     redraw = liftIO $ do
 	Curses.endWin
@@ -329,6 +348,8 @@
 
     warpPointer _ = return ()
     setYNButtons = return ()
+
+    toggleColourMode = modify $ \s -> s {monochrome = not $ monochrome s}
 
     getDrawImpatience = return $ \_ -> return ()
 
diff --git a/Database.hs b/Database.hs
--- a/Database.hs
+++ b/Database.hs
@@ -3,15 +3,15 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
 
 module Database where
 
--- TODO: use ByteString everywhere
-
+import Data.Maybe
+import Data.Tuple (swap)
 import Control.Applicative
 import Control.Monad
 import System.IO
@@ -22,10 +22,6 @@
 import qualified Data.ByteString.Lazy.Char8 as CL
 import qualified Data.ByteString.Char8 as CS
 
---import OpenSSL.Digest (MessageDigest(SHA1), toHex)
---import OpenSSL.Digest.ByteString.Lazy (digest)
---import Data.Digest.Pure.SHA (sha1, showDigest)
---see also OpenSSL.EVP.Digest from HsOpenSSL
 import Crypto.Hash (hashlazy, Digest, SHA1, digestToHexByteString)
 
 import Protocol
@@ -33,8 +29,6 @@
 import Lock
 import Mundanities
 
---hash :: String -> IO String
---hash str = fmap (>>=toHex) $ digest SHA1 $ CL.pack $ str
 sha1 :: CL.ByteString -> Digest SHA1
 sha1 = hashlazy
 hash :: String -> String
@@ -84,7 +78,9 @@
 askForRecord _ = error "no corresponding request"
 
 type DBM = ReaderT FilePath IO
-	    
+withDB :: FilePath -> DBM a -> IO a
+withDB = flip runReaderT
+
 recordExists :: Record -> DBM Bool
 recordExists rec = recordPath rec >>= liftIO . doesFileExist
 
@@ -103,19 +99,19 @@
 getRecordh (RecRetiredLocks name) h = ((RCLockSpecs <$>) . tryRead) <$> hGetStrict h
 getRecordh RecServerInfo h = ((RCServerInfo <$>) . tryRead) <$> hGetStrict h
 
-hGetStrict h = CS.unpack `liftM` concatMWhileNonempty (repeat $ CS.hGet h 1024)
+hGetStrict h = CS.unpack <$> concatMWhileNonempty (repeat $ CS.hGet h 1024)
     where concatMWhileNonempty (m:ms) = do
 	    bs <- m
 	    if CS.null bs
 		then return bs
-		else (bs `CS.append`) `liftM` concatMWhileNonempty ms
+		else (bs `CS.append`) <$> concatMWhileNonempty ms
 
 putRecord :: Record -> RecordContents -> DBM ()
 putRecord rec rc = do
     path <- recordPath rec
     liftIO $ do
-	mkdirhierto path 
-	h <- openFile path WriteMode 
+	mkdirhierto path
+	h <- openFile path WriteMode
 	putRecordh rc h
 	hClose h
 putRecordh (RCPassword hpw) h = hPutStr h $ show hpw
@@ -129,12 +125,12 @@
 
 modifyRecord :: Record -> (RecordContents -> RecordContents) -> DBM ()
 modifyRecord rec f = do
-    h <- recordPath rec >>= liftIO . flip openFile ReadWriteMode 
+    h <- recordPath rec >>= liftIO . flip openFile ReadWriteMode
     liftIO $ do
 	Just rc <- getRecordh rec h
 	hSeek h AbsoluteSeek 0
 	putRecordh (f rc) h
-	hTell h >>= hSetFileSize h 
+	hTell h >>= hSetFileSize h
 	hClose h
 
 delRecord :: Record -> DBM ()
@@ -156,18 +152,19 @@
 listUsers :: DBM [Codename]
 listUsers = do
     dbpath <- ask
-    liftIO $ (map unpathifyName . filter ((==3).length)) <$> getDirectoryContents (dbpath++[pathSeparator]++"users")
+    liftIO $ (map unpathifyName . filter ((==3).length)) <$>
+	getDirectoryContents (dbpath++[pathSeparator]++"users")
 
 recordPath :: Record -> DBM FilePath
-recordPath rec = do
-	dbpath <- ask
-	return $ dbpath ++ [pathSeparator] ++ recordPath' rec
+recordPath rec =
+    (++ ([pathSeparator] ++ recordPath' rec)) <$> ask
     where
 	recordPath' (RecPassword name) = userDir name ++ "passwd"
 	recordPath' (RecUserInfo name) = userDir name ++ "info"
 	recordPath' (RecUserInfoLog name) = userDir name ++ "log"
 	recordPath' (RecLock ls) = locksDir ++ show ls
-	recordPath' (RecNote (NoteInfo name _  alock)) = userDir name ++ "notes" ++ [pathSeparator] ++ alockFN alock
+	recordPath' (RecNote (NoteInfo name _  alock)) =
+	    userDir name ++ "notes" ++ [pathSeparator] ++ alockFN alock
 	recordPath' (RecRetiredLocks name) = userDir name ++ "retired"
 	recordPath' RecLockHashes = "lockHashes"
 	recordPath' RecServerInfo = "serverInfo"
@@ -176,26 +173,30 @@
 	alockFN (ActiveLock name idx) = pathifyName name ++":"++ show idx
 	locksDir = "locks"++[pathSeparator]
 
--- dummy out characters which are disallowed on unix or windows:
-pathifyName = map $ \c -> case c of 
-    '/'->'s'
-    '.'->'d'
-    '\\'->'b'
-    '<'->'l'
-    '>'->'g'
-    ':'->'c'
-    '|'->'p'
-    '?'->'q'
-    '*'->'a'
-    _ -> c
-unpathifyName = map $ \c -> case c of 
-    's'->'/'
-    'd'->'.'
-    'b'->'\\'
-    'l'->'<'
-    'g'->'>'
-    'c'->':'
-    'p'->'|'
-    'q'->'?'
-    'a'->'*'
-    _ -> c 
+-- Dummy out characters which are disallowed on unix or dos.
+-- We use lowercase characters as dummies.
+-- To avoid collisions on case-insensitive filesystems, we use '_' as an
+-- escape character.
+pathifyName = concatMap $ \c ->
+    fromMaybe [c] (('_':) . pure <$> lookup c pathifyAssocs)
+unpathifyName = concatMap $ \c -> case c of
+	'_' -> ""
+	_ -> pure $ fromMaybe c (lookup c $ map swap pathifyAssocs)
+pathifyAssocs =
+    [ ('/','s')
+    , ('.','d')
+    , ('\\','b')
+    , ('<','l')
+    , ('>','g')
+    , (':','c')
+    , ('|','p')
+    , ('?','q')
+    , ('*','a')
+    , ('+','t')
+    , (',','m')
+    , (';','i')
+    , ('=','e')
+    , ('[','k')
+    , (']','j')
+    , ('_','u')
+    ]
diff --git a/Debug.hs b/Debug.hs
--- a/Debug.hs
+++ b/Debug.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
@@ -17,4 +17,3 @@
 prettyTrace = Trace.trace . ppShow
 prettyTraceVal :: Show a => a -> a
 prettyTraceVal x = prettyTrace x x
-
diff --git a/EditGameState.hs b/EditGameState.hs
--- a/EditGameState.hs
+++ b/EditGameState.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
@@ -22,7 +22,7 @@
 import GameState
 import GameStateTypes
 --import Debug
-	
+
 modTile :: Maybe Tile -> HexPos -> HexPos -> Bool -> GameState -> GameState
 modTile tile pos lastPos painting st =
     let board = stateBoard st
@@ -78,7 +78,7 @@
 	       in case addToIdx of
 		  Nothing -> addPiece $ Block [zero]
 		  Just b -> addBlockPos b pos
-	   Just (ArmTile armdir _) -> 
+	   Just (ArmTile armdir _) ->
 	       let adjacentPivots = [ idx |
 		       dir <- if armdir == zero then hexDirs else [armdir, neg armdir]
 		       , Just (idx, PivotTile _) <- [Map.lookup (dir <+> pos) board'] ]
@@ -117,7 +117,7 @@
 		      Just conn -> addConn conn
 	   Just (PivotTile _) -> addPiece $ Pivot []
 	   Just (WrenchTile _) -> addPiece $ Wrench zero
-	   Just HookTile -> let arm = listToMaybe [ dir | 
+	   Just HookTile -> let arm = listToMaybe [ dir |
 				    dir <- hexDirs
 				    , isNothing $ Map.lookup (dir <+> pos) board' ]
 			    in case arm of Just armdir -> addPiece $ Hook armdir NullHF
@@ -152,5 +152,4 @@
 	    let st' = fst $ delPiecePos idx pos st
 	    (idx'',_) <- Map.lookup (dir<+>pos) $ stateBoard st'
 	    return $ addPivotArm idx'' pos st'
-
 	_ -> mzero
diff --git a/Frame.hs b/Frame.hs
--- a/Frame.hs
+++ b/Frame.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
@@ -22,7 +22,7 @@
 
 frameSize :: Frame -> Int
 frameSize (BasicFrame size) = size
- 
+
 bolthole, entrance :: Frame -> HexVec
 bolthole (BasicFrame size) = size<*>hu <+> (size`div`2)<*>hv
 entrance f = neg $ bolthole f
@@ -33,7 +33,7 @@
 
 baseState :: Frame -> GameState
 baseState f =
-    GameState 
+    GameState
 	(Vector.fromList $ [ framePiece f, bolt ] ++ (initTools f))
 	[]
     where
@@ -49,7 +49,7 @@
 	++ (map (entrance f <+>) [neg hu <+> hv, 2 <*> neg hu, neg hu <+> hw,
 		2 <*> hw, neg hv <+> hw])
 	++ (concat [
-		map (rotate r) [ (n<*>hu) <+> (size<*>hw) | n <- [0..size-1] ] | r <- [0..5] ] \\ 
+		map (rotate r) [ (n<*>hu) <+> (size<*>hw) | n <- [0..size-1] ] | r <- [0..5] ] \\
 	    [bolthole f, entrance f])
     where bw = boltWidth f
 
diff --git a/GameState.hs b/GameState.hs
--- a/GameState.hs
+++ b/GameState.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
@@ -35,7 +35,7 @@
 getpp st idx = (placedPieces st) ! idx
 
 setpp :: PieceIdx -> PlacedPiece -> GameState -> GameState
-setpp idx pp st@(GameState pps _) = 
+setpp idx pp st@(GameState pps _) =
     let displacement = (placedPos $ getpp st idx) <-> placedPos pp
 	updateConn conn@(Connection root@(ridx,rpos) end@(eidx,epos) link)
 	    | ridx == idx = Connection (ridx,rpos<+>displacement) end link
@@ -61,7 +61,7 @@
 
 floodfill :: HexVec -> Set HexVec -> (Set HexVec, Set HexVec)
 floodfill start patt = floodfill' start `execState` (patt, Set.empty)
-    where 
+    where
 	floodfill' :: HexVec -> State (Set HexVec, Set HexVec) ()
 	floodfill' start = do
 	      (patt, dels) <- get
@@ -87,7 +87,7 @@
 	_ -> st
 
 setPiece :: PieceIdx -> Piece -> GameState -> GameState
-setPiece idx p st = 
+setPiece idx p st =
     setpp idx (PlacedPiece (placedPos $ getpp st idx) p) st
 
 adjustPieces :: (Piece -> Piece) -> GameState -> GameState
@@ -123,23 +123,23 @@
 springsAtIdx,springsEndAtIdx,springsRootAtIdx :: GameState -> PieceIdx -> [Connection]
 springsAtIdx st idx =
     [ c | c@(Connection (ridx,_) (eidx, _) (Spring _ _)) <- connections st
-	  , idx `elem` [ridx,eidx] ]
+    , idx `elem` [ridx,eidx] ]
 springsAtIdxIgnoring st idx idx' =
     [ c | c@(Connection (ridx,_) (eidx, _) (Spring _ _)) <- connections st
-	  , idx `elem` [ridx,eidx], idx' `notElem` [ridx,eidx] ]
+    , idx `elem` [ridx,eidx], idx' `notElem` [ridx,eidx] ]
 springsEndAtIdx st idx =
     [ c | c@(Connection _ (eidx, _) (Spring _ _)) <- connections st
-	  , eidx==idx ]
+    , eidx==idx ]
 springsRootAtIdx st idx =
     [ c | c@(Connection (ridx, _) _ (Spring _ _)) <- connections st
-	  , ridx==idx ]
+    , ridx==idx ]
 connectionsBetween :: GameState -> PieceIdx -> PieceIdx -> [Connection]
 connectionsBetween st idx idx' =
     filter connIsBetween $ connections st
     where
 	connIsBetween conn =
 	    isPerm (idx,idx') (fst $ connectionRoot conn, fst $ connectionEnd conn)
-	isPerm (x,y) (x',y') = (x==x'&&y==y')||(x==y'&&y==x')
+	isPerm = (==) `on` (\(x,y) -> Set.fromList [x,y])
 
 connGraphPathExists :: GameState -> PieceIdx -> PieceIdx -> Bool
 connGraphPathExists st ridx eidx = (ridx == eidx) ||
@@ -150,15 +150,16 @@
 connGraphHeight st idx =
     maximum (0 : map ((+1) . connGraphHeight st . fst . connectionRoot) (springsEndAtIdx st idx))
 
-type DiGraph a = Map a (Set a)
+type Digraph a = Map a (Set a)
 checkConnGraphAcyclic :: GameState -> Bool
 checkConnGraphAcyclic st =
     let idxs = ppidxs st
 	leaves dg = map fst $ filter (Set.null . snd) $ Map.toList dg
-	checkDiGraphAcyclic dg = case listToMaybe $ leaves dg of
+	checkDigraphAcyclic :: Ord a => Digraph a -> Bool
+	checkDigraphAcyclic dg = case listToMaybe $ leaves dg of
 	    Nothing -> Map.null dg
-	    Just leaf -> checkDiGraphAcyclic $ Map.delete leaf $ fmap (Set.delete leaf) dg
-    in checkDiGraphAcyclic $ Map.fromList 
+	    Just leaf -> checkDigraphAcyclic $ Map.delete leaf $ fmap (Set.delete leaf) dg
+    in checkDigraphAcyclic $ Map.fromList
 	[ (idx, Set.fromList $ map (fst.connectionRoot) $ springsEndAtIdx st idx) | idx <- idxs ]
 
 repossessConns :: GameState -> GameState -> GameState
@@ -201,17 +202,23 @@
 			$ foldr (addpp . ppOfComp) st newComps, Just idx)
 	_ -> (st,Nothing)
 
-springExtended,springCompressed,springFullyExtended,springFullyCompressed :: GameState -> Connection -> Bool
-springExtended st c@(Connection _ _ (Spring _ natLen)) = connectionLength st c > natLen
+springExtended,springCompressed,springFullyExtended
+    ,springFullyCompressed :: GameState -> Connection -> Bool
+springExtended st c@(Connection _ _ (Spring _ natLen)) =
+    connectionLength st c > natLen
 springExtended _ _ = False
-springCompressed st c@(Connection _ _ (Spring _ natLen)) = connectionLength st c < natLen
+springCompressed st c@(Connection _ _ (Spring _ natLen)) =
+    connectionLength st c < natLen
 springCompressed _ _ = False
-springFullyExtended st c@(Connection _ _ (Spring _ natLen)) = connectionLength st c >= 2*natLen
+springFullyExtended st c@(Connection _ _ (Spring _ natLen)) =
+    connectionLength st c >= 2*natLen
 springFullyExtended _ _ = False
-springFullyCompressed st c@(Connection _ _ (Spring _ natLen)) = connectionLength st c <= (natLen+1)`div`2
+springFullyCompressed st c@(Connection _ _ (Spring _ natLen)) =
+    connectionLength st c <= (natLen+1)`div`2
 springFullyCompressed _ _ = False
-springExtensionValid st c@(Connection _ _ (Spring _ natLen)) = let l = connectionLength st c in 
-    l >= (natLen+1)`div`2 && l <= 2*natLen
+springExtensionValid st c@(Connection _ _ (Spring _ natLen)) =
+    let l = connectionLength st c
+    in l >= (natLen+1)`div`2 && l <= 2*natLen
 springExtensionValid _ _ = True
 
 stateBoard :: GameState -> GameBoard
@@ -238,15 +245,14 @@
 
 plPieceMap :: PlacedPiece -> Map HexPos Tile
 plPieceMap (PlacedPiece pos (Block pattern)) =
-    Map.fromList [ (rel <+> pos, BlockTile adjs) |
-	rel <- pattern
+    Map.fromList [ (rel <+> pos, BlockTile adjs)
+	| rel <- pattern
 	, let adjs = filter (\dir -> rel <+> dir `elem` pattern) hexDirs ]
 plPieceMap (PlacedPiece pos (Pivot arms)) =
     let overarmed = length arms > 2 in
-    Map.fromList $ (pos, PivotTile $ if overarmed then (head arms) else zero ) : 
-	[ (rel <+> pos, ArmTile rel main) |
-	    (rel,main) <- zip arms $ repeat False -- overarmed:$repeat False
-	    ]
+    Map.fromList $ (pos, PivotTile $ if overarmed then (head arms) else zero ) :
+	[ (rel <+> pos, ArmTile rel main)
+	| (rel,main) <- zip arms $ repeat False ]
 plPieceMap (PlacedPiece pos (Hook arm _)) =
     Map.fromList $ (pos, HookTile) : [ (arm <+> pos, ArmTile arm True) ]
 plPieceMap (PlacedPiece pos (Wrench mom)) = Map.singleton pos $ WrenchTile mom
@@ -318,7 +324,7 @@
 	    && (validEnd st end)
 	    | c@(Connection root@(ridx,_) end@(eidx,_) (Spring dir _)) <- conns
 	    , let [rpos,epos] = map (locusPos st) [root,end] ]
-    , and [ 1 == length (components $ Set.fromList patt) 
+    , and [ 1 == length (components $ Set.fromList patt)
 	    | Block patt <- map placedPiece $ Vector.toList pps ]
     ]
 
diff --git a/GameStateTypes.hs b/GameStateTypes.hs
--- a/GameStateTypes.hs
+++ b/GameStateTypes.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
diff --git a/GraphColouring.hs b/GraphColouring.hs
--- a/GraphColouring.hs
+++ b/GraphColouring.hs
@@ -3,12 +3,12 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
 
-module GraphColouring where
+module GraphColouring (fiveColour) where
 
 import qualified Data.Map as Map
 import Data.Map (Map)
@@ -22,71 +22,61 @@
 type Graph a = (Set a, Set (Set a))
 type PlanarGraph a = Map a [a]
 
-fourColour :: Ord a => Graph a -> Colouring a -> Colouring a
-fourColour (nodes,edges) lastCol =
-    -- bruteforce 
-    if Map.keysSet lastCol == nodes && isColouring lastCol
-	then lastCol
-	else head $ filter isColouring colourings
-    where 
-	isColouring mapping = and [
-	    Map.lookup s mapping /= Map.lookup e mapping |
-		edge <- Set.toList edges
-		, [s,e] <- [Set.toList edge] ]
-	colourings = colourings' $ Set.toList nodes
-	colourings' [] = [ Map.empty ]
-	colourings' (n:ns) = [ Map.insert n c m |
-	    m <- colourings' ns
-	    , c <- [0..3] ]
-
 fiveColour :: Ord a => PlanarGraph a -> Colouring a -> Colouring a
 -- ^algorithm based on that presented in
--- http://people.math.gatech.edu/~thomas/PAP/fcstoc.pdf 
+-- http://people.math.gatech.edu/~thomas/PAP/fcstoc.pdf
 -- Key point: a planar graph can't have all vertices of degree >= 6
 -- (Proof: suppose it does, so |E| >= 3|V|; WLOG the graph is triangulated,
 -- so then |F| <= 2/3 |E|. So \xi = |V|-|E|+|F| <= (1/3 - 1 + 2/3)|E| = 0.
 -- But a planar graph has Euler characteristic 1.)
+-- Aims to minimise changes from given (partial) colouring lastCol.
 fiveColour g lastCol =
-    if Map.keysSet lastCol == Map.keysSet g && isColouring lastCol
+    if Map.keysSet lastCol == Map.keysSet g && isColouring g lastCol
 	then lastCol
-	else fiveColour' g
-    where
-    isColouring mapping = and [
-	Map.lookup s mapping /= Map.lookup e mapping |
-	    s <- Map.keys g
-	    , e <- g Map.! s ]
-    --fiveColour' :: PlanarGraph a -> Colouring a
-    fiveColour' g
-	| g == Map.empty = Map.empty
-	| otherwise =
-	let 
-	    adjsOf v = (nub $ g Map.! v) \\ [v]
-	    v = head $ filter ((<=5) . length . adjsOf) $ Map.keys g
-	    adjs = adjsOf v
-	    addTo c = let vc = head $ possCols v \\ map (c Map.!) adjs
-		      in Map.insert v vc c
-	in if length adjs < 5
-	   then addTo $ fiveColour' $ deleteNode v g
-	   else let (v',v'') = if adjs!!2 `elem` (g Map.! (adjs!!0))
-			then (adjs!!1,adjs!!3)
-			else (adjs!!0,adjs!!2)
-		in addTo $ demerge v' v'' $ fiveColour' $ merge v v' v'' g
-    --possCols :: a -> [Int]
-    possCols v = maybe [0..4] (\lvc -> lvc:([0..4] \\ [lvc])) $ Map.lookup v lastCol
-    --demerge :: a -> a -> Colouring a -> Colouring a
-    demerge v v' c = Map.insert v' (c Map.! v) c
-    --merge :: a -> a -> a -> PlanarGraph a -> PlanarGraph a
-    merge v v' v'' g =
-	deleteNode v $ contractNodes v' v''
-	    $ Map.adjust (concatAdjsOver v $ g Map.! v'') v' g
-    --concatAdjsOver :: a -> [a] -> [a] -> [a]
-    concatAdjsOver v adjs adjs' =
-	let (s,_:e) = splitAt (fromJust $ elemIndex v adjs) adjs
-	in s ++ adjs' ++ e
-    deleteNode v =
-	fmap (filter (/= v)) . Map.delete v
-    contractNodes v v' =
-	fmap (map (\v'' -> if v'' == v' then v else v'')) . Map.delete v'
-    
+	else fiveColour' lastCol g
 
+isColouring :: Ord a => PlanarGraph a -> Colouring a -> Bool
+isColouring g mapping = and
+    [ Map.lookup s mapping /= Map.lookup e mapping
+    | s <- Map.keys g
+    , e <- g Map.! s ]
 
+fiveColour' :: Ord a => Colouring a -> PlanarGraph a -> Colouring a
+fiveColour' pref g | g == Map.empty = Map.empty
+fiveColour' pref g =
+    let adjsOf v = (nub $ g Map.! v) \\ [v]
+	v0 = head $ filter ((<=5) . length . adjsOf) $ Map.keys g
+	adjs = adjsOf v0
+	addTo c =
+	    let vc = head $ possCols pref v0 \\ map (c Map.!) adjs
+	    in Map.insert v0 vc c
+    in if length adjs < 5
+       then addTo $ fiveColour' pref $ deleteNode v0 g
+       else let (v',v'') = if adjs!!2 `elem` (g Map.! (adjs!!0))
+		    then (adjs!!1,adjs!!3)
+		    else (adjs!!0,adjs!!2)
+	    in addTo $ demerge v' v'' $ fiveColour' pref $ merge v0 v' v'' g
+
+possCols :: Ord a => Colouring a -> a -> [Int]
+possCols pref v = maybe [0..4] (\lvc -> lvc:([0..4] \\ [lvc])) $ Map.lookup v pref
+
+demerge :: Ord a => a -> a -> Colouring a -> Colouring a
+demerge v v' c = Map.insert v' (c Map.! v) c
+
+merge :: Ord a => a -> a -> a -> PlanarGraph a -> PlanarGraph a
+merge v v' v'' g =
+    deleteNode v $ contractNodes v' v''
+	$ Map.adjust (concatAdjsOver v $ g Map.! v'') v' g
+
+concatAdjsOver :: Ord a => a -> [a] -> [a] -> [a]
+concatAdjsOver v adjs adjs' =
+    let (s,_:e) = splitAt (fromJust $ elemIndex v adjs) adjs
+    in s ++ adjs' ++ e
+
+deleteNode :: Ord a => a -> PlanarGraph a -> PlanarGraph a
+deleteNode v =
+    fmap (filter (/= v)) . Map.delete v
+
+contractNodes :: Ord a => a -> a -> PlanarGraph a -> PlanarGraph a
+contractNodes v v' =
+    fmap (map (\v'' -> if v'' == v' then v else v'')) . Map.delete v'
diff --git a/Init.hs b/Init.hs
--- a/Init.hs
+++ b/Init.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
@@ -20,43 +20,46 @@
 import System.Exit
 import System.Environment
 import System.Directory
+import System.FilePath
 import System.Console.GetOpt
 
-import Mundanities
-import AsciiLock
 import Lock
 import MainState
 import Interact
+import Util
 
-data Opt = LockSize Int | ForceCurses
+data Opt = LockSize Int | ForceCurses | Help
     deriving (Eq, Ord, Show)
 options =
     [ Option ['c'] ["curses"] (NoArg ForceCurses) "force curses UI"
-    -- , Option ['s'] ["locksize"] (ReqArg (LockSize . read) "SIZE") "locksize"
+    , Option ['s'] ["locksize"] (ReqArg (LockSize . read) "SIZE") "locksize"
+    , Option ['h'] ["help"] (NoArg Help) "show usage information"
     ]
+
+usage :: String
+usage = usageInfo header options
+    where header = "Usage: intricacy [OPTION...] [file]"
+
 parseArgs :: [String] -> IO ([Opt],[String])
 parseArgs argv =
     case getOpt Permute options argv of
 	(o,n,[]) -> return (o,n)
-	(_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
-    where header = "Usage: intricacy [OPTION...] [file]"
+	(_,_,errs) -> ioError (userError (concat errs ++ usage))
 
 setup :: IO (Maybe Lock,[Opt],Maybe String)
 setup = do
     argv <- getArgs
     (opts,args) <- parseArgs argv
-    --let frameSize = fromMaybe 8 $ listToMaybe [ size | LockSize size <- opts ]
-    (fromJust <$>) $ runMaybeT $ msum [ do
-	rpath <- MaybeT $ return $ listToMaybe args
-	msum [ do
-	    path <- MaybeT $ (Just <$> canonicalizePath rpath)
-			`catchIO` (const $ return Nothing)
-	    lock <- reframe.fst <$> MaybeT (readLock path)
-	    return (Just lock,opts,Just path)
-	    , do
-		lift $ putStrLn $ "Failed to open lock file: "++rpath
-		lift $ exitFailure
-		mzero ]
+    when (Help `elem` opts) $ putStr usage >> exitSuccess
+    let size = fromMaybe 8 $ listToMaybe [ size | LockSize size <- opts ]
+    curDir <- getCurrentDirectory
+    (fromJust <$>) $ runMaybeT $ msum
+	[ do
+	    path <- liftMaybe ((curDir </>) <$> listToMaybe args)
+	    msum [ do
+		    lock <- reframe.fst <$> MaybeT (readLock path)
+		    return (Just lock,opts,Just path)
+		, return (Just $ baseLock size, opts, Just path) ]
 	, return (Nothing,opts,Nothing) ]
 
 main' :: (UIMonad s, UIMonad c) =>
@@ -68,13 +71,13 @@
 	    Nothing -> initMetaState
 	    Just lock -> return $ newEditState lock Nothing mpath
     void $ runMaybeT $ msum [ do
-	    finalState <- msum 
+	    finalState <- msum
 		[ do
 		    guard $ ForceCurses `notElem` opts
-		    sdlUI <- MaybeT . return $ msdlUI
+		    sdlUI <- liftMaybe $ msdlUI
 		    MaybeT $ sdlUI $ interactUI `execStateT` initMState
 		, do
-		    cursesUI <- MaybeT . return $ mcursesUI
+		    cursesUI <- liftMaybe $ mcursesUI
 		    MaybeT $ cursesUI $ interactUI `execStateT` initMState
 		]
 	    when (isNothing mlock) $ lift $ writeMetaState finalState
diff --git a/InputMode.hs b/InputMode.hs
--- a/InputMode.hs
+++ b/InputMode.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
diff --git a/Interact.hs b/Interact.hs
--- a/Interact.hs
+++ b/Interact.hs
@@ -3,12 +3,12 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
 
-module Interact (interactUI) where 
+module Interact (interactUI) where
 
 import Control.Monad.State
 import Control.Applicative
@@ -27,6 +27,7 @@
 import System.FilePath
 import Data.Array
 import Data.Function (on)
+import Safe (readMay)
 
 import Hex
 import Command
@@ -47,16 +48,17 @@
 import InputMode
 import Maxlocksize
 import InteractUtil
+import Util
 
-interactUI :: UIMonad uiM => StateT MainState uiM InteractSuccess
+newtype InteractSuccess = InteractSuccess Bool
+instance Error InteractSuccess where
+    noMsg = InteractSuccess False
+
+interactUI :: UIMonad uiM => MainStateT uiM InteractSuccess
 interactUI = do
     lift $ drawMessage ""
-    (IMMeta==) . ms2im <$> get >>= flip when (void $ do
-	flag <- gets newAsync
-	unblock <- lift unblockInput
-	_ <- liftIO $ forkIO $ forever $ do
-	    atomically $ readTVar flag >>= check >> writeTVar flag False
-	    unblock
+    (==IMMeta) <$> gets ms2im >>? do
+	spawnUnblockerThread
 
 	-- draw before testing auth, lest a timeout mean a blank screen
 	drawMainState
@@ -64,60 +66,64 @@
 	testAuth
 	refreshUInfoUI
 	tbdg <- lift $ getUIBinding IMMeta CmdTutorials
-	(isNothing <$> gets curAuth >>=) $ flip when $
+	isNothing <$> gets curAuth >>?
 	    lift $ drawMessage $ "Welcome. To play the tutorial levels, press '"++tbdg++"'."
-	)
     setMark startMark
-    loop
+    interactLoop
 
     where
-	loop = do
+	interactLoop = do
 	    mainSt <- get
 	    let im = ms2im mainSt
 	    when (im == IMPlay) checkWon
-	    when (im == IMMeta) $ (checkAsyncErrors >>) $ void.runMaybeT $ 
-		mourNameSelected >>=
-		    flip when (lift purgeInvalidUndecls)
+	    when (im == IMMeta) $ (checkAsync >>) $ void.runMaybeT $
+		mourNameSelected >>? lift purgeInvalidUndecls
 	    drawMainState
 	    cmds <- lift $ getSomeInput im
-	    runErrorT (mapM_ (processCommand im) cmds) >>= \x -> case x of
-		Left ret -> do
-		    lift $ drawMessage ""
-		    return ret
-		Right _ -> loop
+	    runErrorT (mapM_ (processCommand im) cmds) >>=
+		either
+		    ((lift (drawMessage "") >>) . return)
+		    (const interactLoop)
 
--- | TODO: neater would be to use a stream (see package 'pipes') for
--- input?
+	-- | unblock input whenever the newAsync TVar is set to True
+	spawnUnblockerThread = do
+	    flag <- gets newAsync
+	    unblock <- lift unblockInput
+	    liftIO $ forkIO $ forever $ do
+		atomically $ readTVar flag >>= check >> writeTVar flag False
+		unblock
+
 getSomeInput im = do
     cmds <- getInput im
     if null cmds then getSomeInput im else return cmds
 
-newtype InteractSuccess = InteractSuccess Bool
-instance Error InteractSuccess where
-    noMsg = InteractSuccess False
-
-processCommand :: UIMonad uiM => InputMode -> Command -> ErrorT InteractSuccess (StateT MainState uiM) ()
+processCommand :: UIMonad uiM => InputMode -> Command -> ErrorT InteractSuccess (MainStateT uiM) ()
 processCommand im CmdQuit = do
     case im of
 	IMReplay -> throwError $ InteractSuccess False
-	IMPlay -> lift (gets psIsSub) >>= flip when (throwError $ InteractSuccess False)
-	IMEdit -> lift editStateUnsaved >>= flip unless (throwError $ InteractSuccess True)
+	IMPlay -> lift (or <$> sequence [gets psIsSub, null <$> gets psGameStateMoveStack])
+	    >>? throwError $ InteractSuccess False
+	IMEdit -> lift editStateUnsaved >>! throwError $ InteractSuccess True
 	_ -> return ()
     title <- lift $ getTitle
-    really <- lift $ lift $ confirm $ "Really quit" ++ maybe "" (" from "++) title ++ "?"
-    when really $ throwError $ InteractSuccess False
+    (lift . lift . confirm) ("Really quit"
+	    ++ (if im == IMEdit then " without saving" else "")
+	    ++ maybe "" (" from "++) title ++ "?")
+	>>? throwError $ InteractSuccess False
 processCommand im CmdForceQuit = throwError $ InteractSuccess False
 processCommand IMPlay CmdOpen = do
     st <- gets psCurrentState
     frame <- gets psFrame
-    if checkSolved (frame,st) then throwError $ InteractSuccess True else lift.lift $ drawError "Locked!"
+    if checkSolved (frame,st)
+	then throwError $ InteractSuccess True
+	else lift.lift $ drawError "Locked!"
 processCommand im cmd = lift $ processCommand' im cmd
 
-processCommand' :: UIMonad uiM => InputMode -> Command -> StateT MainState uiM ()
+processCommand' :: UIMonad uiM => InputMode -> Command -> MainStateT uiM ()
 processCommand' im CmdHelp = lift $ do
     showHelp im
     void $ textInput "[press a key or RMB]" 1 False True Nothing Nothing
-processCommand' im CmdBind = lift $ flip (>>) (drawMessage "") $ void $ runMaybeT $ do
+processCommand' im CmdBind = lift $ (>> drawMessage "") $ runMaybeT $ do
 	lift $ drawMessage "Command to bind: "
 	cmd <- msum $ repeat $ do
 	    cmd <- MaybeT $ listToMaybe <$> getInput im
@@ -127,26 +133,27 @@
 	ch <- MaybeT getChRaw
 	guard $ ch /= '\ESC'
 	lift $ setUIBinding im cmd ch
-
-processCommand' _ CmdSuspend = lift $ suspend
-processCommand' _ CmdRedraw = lift $ redraw
+processCommand' _ CmdToggleColourMode = lift toggleColourMode
+processCommand' _ CmdSuspend = lift suspend
+processCommand' _ CmdRedraw = lift redraw
 processCommand' im CmdMark = void.runMaybeT $ do
     guard $ im `elem` [IMEdit, IMPlay, IMReplay]
     str <- MaybeT $ lift $ textInput "Mark: " 1 False True Nothing Nothing
-    ch <- MaybeT $ return $ listToMaybe str
+    ch <- liftMaybe $ listToMaybe str
     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 (\"'\" to unjump): " 1 False True Nothing Nothing
-    ch <- MaybeT $ return $ listToMaybe str
+    ch <- liftMaybe $ listToMaybe str
     lift $ jumpMark ch
 processCommand' im CmdReset = jumpMark startMark
 processCommand' IMMeta (CmdSelCodename mname) = void.runMaybeT $ do
-    name <- msum [ MaybeT $ return $ mname
+    name <- msum [ liftMaybe $ mname
 	, do
-	    newCodename <- (map toUpper <$>) $ MaybeT $ lift $ textInput "Codename:" 3 False True Nothing Nothing
+	    newCodename <- (map toUpper <$>) $ MaybeT $ lift $
+		textInput "Codename:" 3 False True Nothing Nothing
 	    guard $ length newCodename == 3
 	    return newCodename
 	]
@@ -168,14 +175,13 @@
 processCommand' IMMeta CmdSetServer = void.runMaybeT $ do
     saddr <- gets curServer
     saddrs <- liftIO $ knownServers
-    newSaddrstr <- MaybeT $ lift $ textInput "Set server:" 256 False False
+    newSaddr <- MaybeT $ ((>>= strToSaddr) <$>) $
+	lift $ textInput "Set server:" 256 False False
 	    (Just $ map saddrStr saddrs) (Just $ saddrStr saddr)
-    newSaddr <- MaybeT $ return $ strToSaddr newSaddrstr
     modify $ \ms -> ms { curServer = newSaddr }
-    unless (nullSaddr newSaddr) $
-	msum [ void $ MaybeT $ getFreshRecBlocking RecServerInfo
-	, modify $ \ms -> ms { curServer = saddr }
-	]
+    guard.not $ nullSaddr newSaddr
+    msum [ void.MaybeT $ getFreshRecBlocking RecServerInfo
+	, modify $ \ms -> ms { curServer = saddr } ]
 processCommand' IMMeta CmdToggleCacheOnly =
     not <$> gets cacheOnly >>= \c -> modify $ \ms -> ms {cacheOnly = c}
 
@@ -186,7 +192,8 @@
     confirmOrBail $ if isUs then "Really reset password?" else "Register codename "++newName++"?"
     passwd <- (hashPassword newName <$>) $ MaybeT $ lift $
 	textInput "Enter new password:" 64 True False Nothing Nothing
-    lift $ if isUs then do
+    lift $ if isUs
+	then do
 	    resp <- curServerAction $ ResetPassword passwd
 	    case resp of
 		ServerAck -> do
@@ -228,13 +235,13 @@
 processCommand' IMMeta (CmdSolve midx) = void.runMaybeT $ do
     name <- mgetCurName
     uinfo <- mgetUInfo name
-    idx <- msum [ MaybeT $ return midx
+    idx <- msum [ liftMaybe midx
 	, askLockIndex "Solve which lock?" "No lock to solve!" (\i -> isJust $ userLocks uinfo ! i) ]
-    ls <- MaybeT $ return $ lockSpec <$> userLocks uinfo ! idx
+    ls <- liftMaybe $ lockSpec <$> userLocks uinfo ! idx
     undecls <- lift (gets undeclareds)
     msum [ do
-	    undecl <- MaybeT $ return $ find (\(Undeclared _ ls' _) -> ls == ls') undecls
-	    _ <- MaybeT $ gets curAuth
+	    undecl <- liftMaybe $ find (\(Undeclared _ ls' _) -> ls == ls') undecls
+	    MaybeT $ gets curAuth
 	    confirmOrBail "Declare existing solution?"
 	    void.lift.runMaybeT $ -- ignores MaybeT failures
 		declare undecl
@@ -244,9 +251,9 @@
 		"solving " ++ name ++ ":" ++ [lockIndexChar idx] ++ "  (#" ++ show ls ++")"
 	    mourName <- lift $ (authUser <$>) <$> gets curAuth
 	    guard $ mourName /= Just name
-	    let undecl = Undeclared soln ls (ActiveLock name idx) 
+	    let undecl = Undeclared soln ls (ActiveLock name idx)
 	    msum [ do
-		    _ <- MaybeT $ gets curAuth
+		    MaybeT $ gets curAuth
 		    confirmOrBail "Declare solution?"
 		    declare undecl
 		, unless (any (\(Undeclared _ ls' _) -> ls == ls') undecls) $
@@ -254,41 +261,44 @@
 		]
 	]
 processCommand' IMMeta (CmdPlayLockSpec mls) = void.runMaybeT $ do
-    ls <- msum [ MaybeT $ return mls
-	, do 
+    ls <- msum [ liftMaybe mls
+	, do
 	    tls <- MaybeT . lift $ textInput "Lock number:" 16 False False Nothing Nothing
-	    MaybeT . return $ fst <$> (listToMaybe $ (reads :: ReadS Int) tls)
+	    liftMaybe $ readMay tls
 	]
     RCLock lock <- MaybeT $ getFreshRecBlocking $ RecLock ls
     solveLock lock $ Just $ "solving " ++ show ls
-    
+
 processCommand' IMMeta (CmdDeclare mundecl) = void.runMaybeT $ do
-    mourNameSelected >>= guard
+    guard =<< mourNameSelected
     name <- mgetCurName
     undecls <- lift $ gets undeclareds
     guard $ not $ null undecls
-    declare =<< msum [ MaybeT $ return mundecl
+    declare =<< msum [ liftMaybe mundecl
 	, if length undecls == 1
 	then return $ head undecls
 	else do
 	    which <- MaybeT $ lift $ textInput
 		("Declare which solution?")
 		5 False True Nothing Nothing
-	    MaybeT $ return $ msum
+	    liftMaybe $ msum
 		[ do
-		    i <- fst <$> (listToMaybe $ (reads :: ReadS Int) which)
+		    i <- readMay which
 		    guard $ 0 < i && i <= length undecls
 		    return $ undecls !! (i-1)
-		, listToMaybe $ [ undecl
+		, listToMaybe $
+		    [ undecl
 		    | undecl@(Undeclared _ _ (ActiveLock name' i)) <- undecls
-		    , or [ take (length which) (name' ++ ":" ++ [lockIndexChar i]) ==
-			    map toUpper which 
+		    , or
+			[ take (length which) (name' ++ ":" ++ [lockIndexChar i]) ==
+			    map toUpper which
 			, name'==name && [lockIndexChar i] == which
-			] ]
+			]
+		    ]
 		]
 	]
 processCommand' IMMeta (CmdViewSolution mnote) = void.runMaybeT $ do
-    note <- msum [ MaybeT $ return mnote, do
+    note <- liftMaybe mnote `mplus` do
 	ourName <- mgetOurName
 	name <- mgetCurName
 	uinfo <- mgetUInfo name
@@ -296,21 +306,20 @@
 	    [ case mlockinfo of
 		Nothing -> return []
 		Just lockinfo -> (++lockSolutions lockinfo) <$> do
-			ns <- getNotesReadOn lockinfo 
+			ns <- getNotesReadOn lockinfo
 			return $ if length ns < 3 then [] else ns
 	    | mlockinfo <- elems $ userLocks uinfo ]
 	idx <- askLockIndex "View solution to which lock?" "No solutions to view" $ not.null.(noteses!!)
 	let notes = noteses!!idx
 	    authors = map noteAuthor notes
 	author <- if length notes == 1
-	    then return $ noteAuthor $ head notes 
+	    then return $ noteAuthor $ head notes
 	    else (map toUpper <$>) $ MaybeT $ lift $
 		textInput ("View solution by which player? ["
 		    ++ intercalate "," (take 3 authors)
 		    ++ if length authors > 3 then ",...]" else "]")
 		3 False True (Just $ authors) Nothing
-	MaybeT $ return $ find ((==author).noteAuthor) notes
-	]
+	liftMaybe $ find ((==author).noteAuthor) notes
     let ActiveLock name idx = noteOn note
     uinfo <- mgetUInfo name
     ls <- lockSpec <$> MaybeT (return $ userLocks uinfo ! idx)
@@ -320,26 +329,22 @@
 	"viewing solution by " ++ noteAuthor note ++ " to " ++ name ++ [':',lockIndexChar idx]
 
 processCommand' IMMeta (CmdPlaceLock midx) = void.runMaybeT $ do
-    mourNameSelected >>= guard
+    guard =<< mourNameSelected
     ourName <- mgetOurName
-    (lock,msoln) <- msum [MaybeT $ gets curLock
-	, do
-	    ebdg <- lift.lift $ getUIBinding IMMeta CmdEdit
-	    lift.lift $ drawError $ "No lock selected; '"++ebdg++"' to edit one."
-	    mzero]
+    (lock,msoln) <- MaybeT (gets curLock) `mplus` 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
-	, askLockIndex ("Place " ++ show lockpath ++ " in which slot?") "bug" $ const True
-	]
+    idx <- (liftMaybe midx `mplus`) $
+	askLockIndex ("Place " ++ show lockpath ++ " in which slot?") "bug" $ const True
     when (isJust $ userLocks ourUInfo ! idx) $
 	confirmOrBail "Really retire existing lock?"
-    soln <- msum [ MaybeT $ return msoln,
-	solveLock lock $ Just $ "testing lock" ]
-    lift $ do 
-	curServerActionAsync $ SetLock lock idx soln
-	invalidateUInfo ourName
-	refreshUInfoUI
+    soln <- (liftMaybe msoln `mplus`) $ solveLock lock $ Just $ "testing lock"
+    lift $ curServerActionAsyncThenInvalidate
+	(SetLock lock idx soln)
+	(Just (SomeCodenames [ourName]))
 
 processCommand' IMMeta CmdSelectLock = void.runMaybeT $ do
     lockdir <- liftIO $ confFilePath "locks"
@@ -355,24 +360,23 @@
 processCommand' IMMeta CmdPrevPage =
     modify $ \ms -> ms { listOffset = max 0 $ listOffset ms - 1 }
 processCommand' IMMeta CmdEdit = void.runMaybeT $ do
-    (lock, msoln) <- msum [ MaybeT $ gets curLock
-	, do
-	    frame <- BasicFrame <$> msum [ do
-		    _ <- gets curServer
-		    RCServerInfo (ServerInfo size _) <- MaybeT $ getFreshRecBlocking RecServerInfo
-		    return size
-		, do
-		    sizet <- MaybeT $ lift $ textInput
-			("Lock size: [3-" ++ show maxlocksize ++ "]") 2 False False Nothing Nothing
-		    size <- MaybeT $ return $ fst <$> (listToMaybe $ (reads :: ReadS Int) sizet)
-		    guard $ 3 <= size && size <= maxlocksize
-		    return size
-		]
-	    return ((frame, baseState frame), Nothing)
-	]
+    (lock, msoln) <- (MaybeT $ gets curLock) `mplus` do
+	size <- msum
+	    [ do
+		gets curServer
+		RCServerInfo (ServerInfo size _) <- MaybeT $ getFreshRecBlocking RecServerInfo
+		return size
+	    , do
+		sizet <- MaybeT $ lift $ textInput
+		    ("Lock size: [3-" ++ show maxlocksize ++ "]") 2 False False Nothing Nothing
+		size <- liftMaybe $ readMay sizet
+		guard $ 3 <= size && size <= maxlocksize
+		return size
+	    ]
+	return (baseLock size, Nothing)
     path <- lift $ gets curLockPath
-    newPath <- MaybeT $ lift $ (esPath <$>) $ execStateT interactUI $ newEditState (reframe lock)
-	msoln (if null path then Nothing else Just path)
+    newPath <- MaybeT $ lift $ (esPath <$>) $ execStateT interactUI $
+	newEditState (reframe lock) msoln (if null path then Nothing else Just path)
     lift $ setLockPath newPath
 processCommand' IMMeta CmdTutorials = void.runMaybeT $ do
     tutdir <- liftIO $ getDataPath "tutorial"
@@ -383,7 +387,7 @@
 	mzero
     -- s <- MaybeT $ lift $ textInput ("Play which tutorial level? [1-"++show (length tuts)++"]")
 	    -- (length (show (length tuts))) False True Nothing Nothing
-    -- i <- MaybeT $ return $ fst <$> (listToMaybe $ (reads :: ReadS Int) s)
+    -- i <- liftMaybe $ readMay s
     -- guard $ 1 <= i && i <= length tuts
     let i = 1
     let dotut i = do
@@ -391,11 +395,11 @@
 	let pref = tutdir ++ [pathSeparator] ++ name
 	(lock,_) <- MaybeT $ liftIO $ readLock (pref ++ ".lock")
 	text <- liftIO $ (fromMaybe "" . listToMaybe) <$> (readStrings (pref ++ ".text") `catchIO` const (return []))
-	_ <- solveLock lock $ Just $ "Tutorial " ++ show i ++ ": " ++ text
+	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) ++ ")?"
 		dotut $ i+1
-	    else lift $ do 
+	    else lift $ do
 		mauth <- gets curAuth
 		cbdg <- lift $ getUIBinding IMMeta $ CmdSelCodename Nothing
 		rbdg <- lift $ getUIBinding IMMeta CmdRegister
@@ -412,7 +416,7 @@
 	    return $ Just lss
 	Just _ -> return Nothing
     lift $ modify $ \ms -> ms {retiredLocks = newRL}
-    
+
 processCommand' IMPlay CmdUndo = do
     st <- gets psCurrentState
     stack <- gets psGameStateMoveStack
@@ -423,7 +427,7 @@
 	    psLastAlerts = [], psUndoneStack = (st,pm):ustms}
 processCommand' IMPlay CmdRedo = do
     ustms <- gets psUndoneStack
-    case ustms of 
+    case ustms of
 	[] -> return ()
 	ustm:ustms' -> do
 	    pushPState ustm
@@ -432,11 +436,11 @@
     board <- stateBoard <$> gets psCurrentState
     wsel <- gets wrenchSelected
     void.runMaybeT $ msum $ [ do
-	    tile <- MaybeT $ return $ snd <$> Map.lookup pos board
+	    tile <- liftMaybe $ snd <$> Map.lookup pos board
 	    guard $ case tile of {WrenchTile _ -> True; HookTile -> True; _ -> False}
 	    lift $ processCommand' IMPlay $ CmdTile tile
 	] ++ [ do
-	    tile <- MaybeT $ return $ snd <$> Map.lookup (d<+>pos) board
+	    tile <- liftMaybe $ snd <$> Map.lookup (d<+>pos) board
 	    guard $ tileType tile == if wsel then WrenchTile zero else HookTile
 	    lift $ processCommand' IMPlay $ CmdDir WHSSelected $ neg d
 	    | d <- hexDirs ]
@@ -444,12 +448,12 @@
     board <- stateBoard <$> gets psCurrentState
     wsel <- gets wrenchSelected
     void.runMaybeT $ do
-	tile <- MaybeT $ return $ snd <$> Map.lookup pos board
+	tile <- liftMaybe $ snd <$> Map.lookup pos board
 	guard $ case tile of {WrenchTile _ -> True; HookTile -> True; _ -> False}
 	lift $ processCommand' IMPlay $ CmdDir WHSSelected $ dir
 	board' <- stateBoard <$> gets psCurrentState
 	msum [ do
-		tile' <- MaybeT $ return $ snd <$> Map.lookup pos' board'
+		tile' <- liftMaybe $ snd <$> Map.lookup pos' board'
 		guard $ tileType tile' == if wsel then WrenchTile zero else HookTile
 		lift.lift $ warpPointer $ pos'
 	    | pos' <- map (<+>pos) $ hexDisc 2 ]
@@ -457,11 +461,11 @@
 processCommand' IMPlay cmd = do
     wsel <- gets wrenchSelected
     st <- gets psCurrentState
-    let push whs dir 
+    let push whs dir
 	    | whs == WHSWrench || (whs == WHSSelected && wsel) =
 		Just $ WrenchPush dir
 	    | otherwise = Just $ HookPush dir
-	torque whs dir 
+	torque whs dir
 	    | whs == WHSHook || (whs == WHSSelected && not wsel)=
 		Just $ HookTorque dir
 	    | otherwise = Nothing
@@ -487,6 +491,7 @@
 processCommand' IMReplay (CmdReplayBack 1) = void.runMaybeT $ do
     (st',pm) <- MaybeT $ listToMaybe <$> gets rsGameStateMoveStack
     lift $ modify $ \rs -> rs {rsCurrentState=st'
+	, rsLastAlerts = []
 	, rsGameStateMoveStack = tail $ rsGameStateMoveStack rs
 	, rsMoveStack = pm:rsMoveStack rs}
 processCommand' IMReplay (CmdReplayBack n) = replicateM_ n $
@@ -495,8 +500,9 @@
     pm <- MaybeT $ listToMaybe <$> gets rsMoveStack
     lift $ do
 	st <- gets rsCurrentState
-	(st',_) <- lift $ doPhysicsTick pm st
+	(st',alerts) <- lift $ doPhysicsTick pm st
 	modify $ \rs -> rs {rsCurrentState = st'
+	    , rsLastAlerts = alerts
 	    , rsGameStateMoveStack = (st,pm):rsGameStateMoveStack rs
 	    , rsMoveStack = tail $ rsMoveStack rs}
 processCommand' IMReplay (CmdReplayForward n) = replicateM_ n $
@@ -524,7 +530,7 @@
     unless (null sts) $ modify $ \es -> es {esGameStateStack = sts, esUndoneStack = st:usts}
 processCommand' IMEdit CmdRedo = do
     usts <- gets esUndoneStack
-    case usts of 
+    case usts of
 	[] -> return ()
 	ust:usts' -> do
 	    pushEState ust
@@ -554,12 +560,12 @@
     board <- stateBoard.head <$> gets esGameStateStack
     void.runMaybeT $ do
 	selIdx <- MaybeT $ gets selectedPiece
-	idx <- MaybeT $ return $ fst <$> Map.lookup pos board
+	idx <- liftMaybe $ fst <$> Map.lookup pos board
 	guard $ idx == selIdx
 	lift $ processCommand' IMEdit $ CmdDir WHSSelected $ dir
 	board' <- stateBoard.head <$> gets esGameStateStack
 	msum [ do
-		idx' <- MaybeT $ return $ fst <$> Map.lookup pos' board'
+		idx' <- liftMaybe $ fst <$> Map.lookup pos' board'
 		guard $ idx' == selIdx
 		lift.lift $ warpPointer $ pos'
 	    | pos' <- [dir<+>pos, pos] ]
@@ -613,7 +619,7 @@
     newPath <- MaybeT $ lift $ textInput "Save lock as:" 1024 False False Nothing path
     guard $ not $ null newPath
     fullPath <- liftIO $ fullLockPath newPath
-    (liftIO (doesFileExist fullPath `catchIO` const (return True)) >>=) $ flip when $
+    liftIO (doesFileExist fullPath `catchIO` const (return True)) >>?
 	confirmOrBail $ "Really overwrite '"++fullPath++"'?"
     lift $ do
 	st <- gets $ head.esGameStateStack
@@ -631,11 +637,11 @@
 -- ^ salt password
 hashPassword name password = hash $ "IY" ++ name ++ password
 
-subPlay :: UIMonad uiM => Lock -> StateT MainState uiM ()
+subPlay :: UIMonad uiM => Lock -> MainStateT uiM ()
 subPlay lock =
     pushEState =<< psCurrentState <$> (lift $ execStateT interactUI $ newPlayState lock Nothing True)
 
-solveLock :: UIMonad uiM => Lock -> Maybe String -> MaybeT (StateT MainState uiM) Solution
+solveLock :: UIMonad uiM => Lock -> Maybe String -> MaybeT (MainStateT uiM) Solution
 solveLock lock title = do
     (InteractSuccess solved, ps) <- lift.lift $ runStateT interactUI $ newPlayState (reframe lock) title False
     guard $ solved
diff --git a/InteractUtil.hs b/InteractUtil.hs
--- a/InteractUtil.hs
+++ b/InteractUtil.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
@@ -12,7 +12,6 @@
 
 import Control.Monad.State
 import Control.Applicative
-import qualified Data.Vector as Vector
 import qualified Data.Map as Map
 import Data.Map (Map)
 import Control.Monad.Writer
@@ -37,8 +36,9 @@
 import Metagame
 import MainState
 import InputMode
+import Util
 
-checkWon :: UIMonad uiM => StateT MainState uiM ()
+checkWon :: UIMonad uiM => MainStateT uiM ()
 checkWon = do
     st <- gets psCurrentState
     frame <- gets psFrame
@@ -50,19 +50,11 @@
 	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 
-	liftIO $ writeFile (wfname++".solution") $ show pms
-	liftIO $ B.writeFile (wfname++".solution.bin") $ Bin.encode $ pms
-	-}
+	    else drawMessage ""
+
 doForce force = do
     st:_ <- gets esGameStateStack
-    let (st',alerts) = runWriter $ resolveForces
-	    (Vector.singleton (ForceChoice [force])) Vector.empty
-	    (\_ _->False) st
+    let (st',alerts) = runWriter $ resolveSinglePlForce force st
     lift (reportAlerts st' alerts) >> pushEState st'
 drawTile pos tile painting = do
     modify $ \es -> es {selectedPiece = Nothing}
@@ -74,17 +66,17 @@
     else let from' = (hexVec2HexDirOrZero $ to<->from) <+> from
 	in drawTile from' tile True >> paintTilePath tile from' to
 
-pushEState :: UIMonad uiM => GameState -> StateT MainState uiM ()
+pushEState :: UIMonad uiM => GameState -> MainStateT uiM ()
 pushEState st = do
     st':sts <- gets esGameStateStack
     when (st' /= st) $ modify $ \es -> es {esGameStateStack = st:st':sts, esUndoneStack = []}
-pushPState :: UIMonad uiM => (GameState,PlayerMove) -> StateT MainState uiM ()
+pushPState :: UIMonad uiM => (GameState,PlayerMove) -> MainStateT uiM ()
 pushPState (st,pm) = do
     st' <- gets psCurrentState
     stms <- gets psGameStateMoveStack
     when (st' /= st) $ modify $ \ps -> ps {psCurrentState = st,
 	    psGameStateMoveStack = (st',pm):stms, psUndoneStack = []}
-modifyEState :: UIMonad uiM => (GameState -> GameState) -> StateT MainState uiM ()
+modifyEState :: UIMonad uiM => (GameState -> GameState) -> MainStateT uiM ()
 modifyEState f = do
     st:_ <- gets esGameStateStack
     pushEState $ f st
@@ -118,32 +110,31 @@
 	("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
-	curServerActionAsync $ DeclareSolution soln ls al idx
+    lift $ curServerActionAsyncThenInvalidate
+	(DeclareSolution soln ls al idx)
 	-- rather than recurse through the tree to find what scores may have
 	-- changed as a result of this declaration, or leave it to timeouts
 	-- and explicit refreshes to reveal it, we just invalidate all UInfos.
-	invalidateAllUInfo
-	refreshUInfoUI
+	(Just AllCodenames)
 
 startMark = '^'
 
-jumpMark :: UIMonad uiM => Char -> StateT MainState uiM ()
+jumpMark :: UIMonad uiM => Char -> MainStateT uiM ()
 jumpMark ch = do
     mst <- get
     void.runMaybeT $ case ms2im mst of
 	IMEdit -> do
-	    st <- MaybeT $ return $ ch `Map.lookup` esMarks mst
+	    st <- liftMaybe $ ch `Map.lookup` esMarks mst
 	    lift $ setMark '\'' >> pushEState st
 	IMPlay -> do
-	    mst' <- MaybeT $ return $ ch `Map.lookup` psMarks mst
+	    mst' <- liftMaybe $ ch `Map.lookup` psMarks mst
 	    put mst' { psMarks = Map.insert '\'' mst $ psMarks mst }
 	IMReplay -> do
-	    mst' <- MaybeT $ return $ ch `Map.lookup` rsMarks mst
+	    mst' <- liftMaybe $ ch `Map.lookup` rsMarks mst
 	    put mst' { rsMarks = Map.insert '\'' mst $ rsMarks mst }
 	_ -> return ()
 
-setMark :: (Monad m) => Char -> StateT MainState m ()
+setMark :: (Monad m) => Char -> MainStateT m ()
 setMark ch = get >>= \mst -> case mst of
     -- ugh... remind me why I'm not using lens?
     EditState { esMarks = marks, esGameStateStack = (st:_) } ->
diff --git a/KeyBindings.hs b/KeyBindings.hs
--- a/KeyBindings.hs
+++ b/KeyBindings.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
@@ -104,6 +104,7 @@
     , (ctrl 'B', CmdBind)
     , (ctrl 'L', CmdRedraw)
     , (ctrl 'Z', CmdSuspend)
+    , ('%', CmdToggleColourMode)
     ]
 
 lockGlobal = keypadHex ++ qwertyViHex ++ miscGlobal ++ miscLockGlobal
diff --git a/Lock.hs b/Lock.hs
--- a/Lock.hs
+++ b/Lock.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
@@ -26,6 +26,11 @@
 
 lockSize (f,_) = frameSize f
 
+baseLock :: Int -> Lock
+baseLock size =
+    let frame = BasicFrame size
+    in (frame, baseState frame)
+
 deframe :: Lock -> Lock
 deframe = delTools . liftLock (setpp 0 nullpp)
 nullpp = PlacedPiece (PHS zero) (Block [])
@@ -37,54 +42,53 @@
 validLock lock@(f,st) = and
     [ st == stepPhysics st
     , lock == reframe lock
-    , validGameState st 
+    , validGameState st
     ]
 
-stepPhysics :: GameState -> GameState
-stepPhysics = fst.runWriter.physicsTick NullPM
-
 type Solution = [PlayerMove]
 
 checkSolution :: Lock -> Solution -> Bool
 checkSolution lock pms =
     let (frame,st) = reframe lock
-    in any (\st' -> checkSolved (frame,st')) $
-		scanl (((fst.runWriter).).flip physicsTick) st pms
+	tick :: GameState -> PlayerMove -> GameState
+	tick st pm = fst . runWriter $ physicsTick pm st
+    in any (\st' -> checkSolved (frame,st')) $ scanl tick st pms
 
 checkSolved :: Lock -> Bool
 checkSolved (f,st) =
-    let b = stateBoard st in
-	and [ isNothing $ Map.lookup p b | p <- boltArea f ]
+    and [ isNothing $ Map.lookup p (stateBoard st) | p <- boltArea f ]
 
 
 canonify :: Lock -> Lock
 canonify = addTools . stabilise . delTools . delOOB
 delTools :: Lock -> Lock
-delTools = liftLock delTools'
-    where
+delTools = liftLock delTools' where
 	delTools' :: GameState -> GameState
 	delTools' st =
-	    case listToMaybe [ idx | (idx,pp) <- enumVec $ placedPieces st
-			      , isTool $ placedPiece pp ] of
-		Nothing -> st
-		Just idx -> delTools' $ delPiece idx st
+	    fromMaybe st $ listToMaybe 
+		[ delTools' $ delPiece idx st
+		| (idx,pp) <- enumVec $ placedPieces st
+		, isTool $ placedPiece pp ]
 addTools :: Lock -> Lock
 addTools (f,st) =
     let st' = clearToolArea f st
     in (f, foldr addpp st' $ initTools f)
+
+-- |An important property of the game physics is that any state stabilises in
+-- finite time. Proof: in any spontaneous state change some spring gets closer
+-- to being of natural length, and none get further from it.
 stabilise :: Lock -> Lock
-stabilise = liftLock stabilise'
-    where
+stabilise = liftLock stabilise' where
 	stabilise' :: GameState -> GameState
 	stabilise' st =
 	    let st' = stepPhysics st
 	    in if st == st' then st else stabilise' st'
 
 delOOB :: Lock -> Lock
-delOOB l@(f,st) = case listToMaybe [ idx |
-	(idx,_) <- enumVec $ placedPieces st
+delOOB l@(f,st) =
+    fromMaybe l $ listToMaybe
+	[ delOOB $ liftLock (delPiece idx) l
+	| (idx,_) <- enumVec $ placedPieces st
 	, not $ isFrame idx
 	, all (not.inBounds f) $ fullFootprint st idx
-	, null $ springsEndAtIdx st idx] of
-    Nothing -> l
-    Just idx -> delOOB $ liftLock (delPiece idx) l
+	, null $ springsEndAtIdx st idx]
diff --git a/MainBoth.hs b/MainBoth.hs
deleted file mode 100644
--- a/MainBoth.hs
+++ /dev/null
@@ -1,22 +0,0 @@
--- This file is part of Intricacy
--- Copyright (C) 2013 Martin Bays <mbays@sdf.org>
---
--- This program is free software: you can redistribute it and/or modify
--- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
---
--- You should have received a copy of the GNU General Public License
--- along with this program.  If not, see http://www.gnu.org/licenses/.
-
-module Main where
-
-import Init
-import qualified SDLUI (UIM)
-import SDLUIMInstance ()
-import qualified CursesUI (UIM)
-import CursesUIMInstance ()
-import MainState
-
-main = main' 
-    (Just (doUI::SDLUI.UIM MainState -> IO (Maybe MainState)))
-    (Just (doUI::CursesUI.UIM MainState -> IO (Maybe MainState)))
diff --git a/MainBoth.hsMainSDL.hsMainCurses.hs b/MainBoth.hsMainSDL.hsMainCurses.hs
new file mode 100644
--- /dev/null
+++ b/MainBoth.hsMainSDL.hsMainCurses.hs
diff --git a/MainCurses.hs b/MainCurses.hs
deleted file mode 100644
--- a/MainCurses.hs
+++ /dev/null
@@ -1,20 +0,0 @@
--- This file is part of Intricacy
--- Copyright (C) 2013 Martin Bays <mbays@sdf.org>
---
--- This program is free software: you can redistribute it and/or modify
--- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
---
--- You should have received a copy of the GNU General Public License
--- along with this program.  If not, see http://www.gnu.org/licenses/.
-
-module Main where
-
-import Init
-import qualified CursesUI (UIM)
-import CursesUIMInstance ()
-import MainState
-
-main = main' 
-    (Nothing :: (Maybe (CursesUI.UIM MainState -> IO (Maybe MainState))))
-    (Just (doUI::CursesUI.UIM MainState -> IO (Maybe MainState)))
diff --git a/MainSDL.hs b/MainSDL.hs
deleted file mode 100644
--- a/MainSDL.hs
+++ /dev/null
@@ -1,20 +0,0 @@
--- This file is part of Intricacy
--- Copyright (C) 2013 Martin Bays <mbays@sdf.org>
---
--- This program is free software: you can redistribute it and/or modify
--- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
---
--- You should have received a copy of the GNU General Public License
--- along with this program.  If not, see http://www.gnu.org/licenses/.
-
-module Main where
-
-import Init
-import qualified SDLUI
-import SDLUIMInstance ()
-import MainState
-
-main = main' 
-    (Just (doUI::SDLUI.UIM MainState -> IO (Maybe MainState)))
-    (Nothing :: (Maybe (SDLUI.UIM MainState -> IO (Maybe MainState))))
diff --git a/MainState.hs b/MainState.hs
--- a/MainState.hs
+++ b/MainState.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
@@ -28,6 +28,7 @@
 import Data.Time.Clock
 import Data.Array
 import Data.Function (on)
+import Safe
 
 import Hex
 import Mundanities
@@ -43,12 +44,13 @@
 import Metagame
 import ServerAddr
 import InputMode
+import Util
 
 class (Applicative m, MonadIO m) => UIMonad m where
     runUI :: m a -> IO a
     initUI :: m Bool
     endUI :: m ()
-    drawMainState :: StateT MainState m ()
+    drawMainState :: MainStateT m ()
     reportAlerts :: GameState -> [Alert] -> m ()
     drawMessage :: String -> m ()
     drawError :: String -> m ()
@@ -59,6 +61,7 @@
     setUIBinding :: InputMode -> Command -> Char -> m ()
     getUIBinding :: InputMode -> Command -> m String
     getDrawImpatience :: m ( Int -> IO () )
+    toggleColourMode :: m ()
     warpPointer :: HexPos -> m ()
     setYNButtons :: m ()
     suspend,redraw :: m ()
@@ -69,7 +72,7 @@
 	if ok then m >>= (endUI >>).return.Just else return Nothing
 
 -- | this could be neatened using GADTs
-data MainState 
+data MainState
     = PlayState
 	{ psCurrentState::GameState
 	, psFrame::Frame
@@ -84,6 +87,7 @@
 	}
     | ReplayState
 	{ rsCurrentState::GameState
+	, rsLastAlerts::[Alert]
 	, rsMoveStack::[PlayerMove]
 	, rsGameStateMoveStack::[(GameState, PlayerMove)]
 	, rsTitle::Maybe String
@@ -109,8 +113,9 @@
 	, codenameStack :: [Codename]
 	, newAsync :: TVar Bool
 	, asyncError :: TVar (Maybe String)
+	, asyncInvalidate :: TVar (Maybe Codenames)
 	, randomCodenames :: TVar [Codename]
-	, userInfos :: Map Codename (TVar FetchedRecord, UTCTime)
+	, userInfoTVs :: Map Codename (TVar FetchedRecord, UTCTime)
 	, indexedLocks :: Map LockSpec (TVar FetchedRecord)
 	, retiredLocks :: Maybe [LockSpec]
 	, curLockPath :: FilePath
@@ -118,13 +123,23 @@
 	, listOffset :: Int
 	}
 
+type MainStateT = StateT MainState
+
+ms2im :: MainState -> InputMode
+ms2im mainSt = case mainSt of
+    PlayState {} -> IMPlay
+    ReplayState {} -> IMReplay
+    EditState {} -> IMEdit
+    MetaState {} -> IMMeta
+
 newPlayState (frame,st) title sub = PlayState st frame [] False False [] [] title sub Map.empty
-newReplayState st soln title = ReplayState st soln [] title Map.empty
+newReplayState st soln title = ReplayState st [] soln [] title Map.empty
 newEditState (frame,st) msoln mpath = EditState [st] [] frame mpath
     ((\s->(st,s))<$>msoln) (Just (st, isJust msoln)) Nothing (PHS zero) (PHS zero) Map.empty
 initMetaState = do
     flag <- atomically $ newTVar False
     errtvar <- atomically $ newTVar Nothing
+    invaltvar <- atomically $ newTVar Nothing
     rnamestvar <- atomically $ newTVar []
     (saddr, auth, path) <- confFilePath "metagame.conf" >>=
 	liftM (fromMaybe (defaultServerAddr, Nothing, "")) . readReadFile
@@ -133,117 +148,109 @@
 	confFilePath ("undeclared" ++ [pathSeparator] ++ saddrStr saddr) >>=
 	liftM (fromMaybe []) . readReadFile
     mlock <- fullLockPath path >>= readLock
-    return $ MetaState saddr undecls False auth names flag errtvar rnamestvar Map.empty Map.empty Nothing path mlock 0
+    return $ MetaState saddr undecls False auth names flag errtvar invaltvar rnamestvar Map.empty Map.empty Nothing path mlock 0
 
 readLock :: FilePath -> IO (Maybe (Lock, Maybe Solution))
 readLock path = runMaybeT $ msum
 	[ (\l->(l,Nothing)) <$> (MaybeT $ readReadFile path)
 	, do
 	    (mlock,msoln) <- lift $ readAsciiLockFile path
-	    lock <- MaybeT $ return mlock
+	    lock <- liftMaybe mlock
 	    return $ (lock,msoln) ]
 -- writeLock :: FilePath -> Lock -> IO ()
 -- writeLock path lock = fullLockPath path >>= flip writeReadFile lock
-fullLockPath path = if isAbsolute path
-    then return path
-    else (++(pathSeparator:path)) <$> confFilePath "locks"
 
 writeMetaState (MetaState { curServer=saddr, undeclareds=undecls, curAuth=auth, curLockPath=path }) = do
     confFilePath "metagame.conf" >>= flip writeReadFile (saddr, auth, path)
     unless (nullSaddr saddr) $
 	confFilePath ("undeclared" ++ [pathSeparator] ++ saddrStr saddr) >>= flip writeReadFile undecls
 
-ms2im :: MainState -> InputMode
-ms2im mainSt = case mainSt of
-    PlayState {} -> IMPlay
-    ReplayState {} -> IMReplay
-    EditState {} -> IMEdit
-    MetaState {} -> IMMeta
-
-getTitle :: UIMonad uiM => StateT MainState uiM (Maybe String)
+getTitle :: UIMonad uiM => MainStateT uiM (Maybe String)
 getTitle = ms2im <$> get >>= \im -> case im of
     IMEdit -> do
 	mpath <- gets esPath
 	unsaved <- editStateUnsaved
 	isTested <- isJust <$> getCurTestSoln
-	return $ Just $ "editing " ++ fromMaybe "[unnamed lock]" mpath ++ 
+	return $ Just $ "editing " ++ fromMaybe "[unnamed lock]" mpath ++
 	    (if isTested then " (Tested)" else "") ++
 	    (if unsaved then " [+]" else "    ")
     IMPlay -> gets psTitle
     IMReplay -> gets rsTitle
     _ -> return Nothing
 
-editStateUnsaved :: UIMonad uiM => StateT MainState uiM Bool
+editStateUnsaved :: UIMonad uiM => MainStateT uiM Bool
 editStateUnsaved = (isNothing <$>) $ runMaybeT $ do
     (sst,tested) <- MaybeT $ gets lastSavedState
-    st <- lift $ gets $ head.esGameStateStack
+    st <- MaybeT $ gets $ headMay.esGameStateStack
     guard $ sst == st
     nowTested <- isJust <$> lift getCurTestSoln
     guard $ tested == nowTested
 
-getCurTestSoln :: UIMonad uiM => StateT MainState uiM (Maybe Solution)
+getCurTestSoln :: UIMonad uiM => MainStateT uiM (Maybe Solution)
 getCurTestSoln = runMaybeT $ do
     (st',soln) <- MaybeT $ gets esTested
-    st <- lift $ gets $ head.esGameStateStack
+    st <- MaybeT $ gets $ headMay.esGameStateStack
     guard $ st == st'
     return soln
 
 instance Error () where noMsg = ()
 
-mgetOurName :: (UIMonad uiM) => MaybeT (StateT MainState uiM) Codename
+mgetOurName :: (UIMonad uiM) => MaybeT (MainStateT uiM) Codename
 mgetOurName = MaybeT $ (authUser <$>) <$> gets curAuth
-mgetCurName :: (UIMonad uiM) => MaybeT (StateT MainState uiM) Codename
-mgetCurName = MaybeT $ listToMaybe <$> gets codenameStack 
+mgetCurName :: (UIMonad uiM) => MaybeT (MainStateT uiM) Codename
+mgetCurName = MaybeT $ listToMaybe <$> gets codenameStack
 
-getUInfoFetched :: UIMonad uiM => Integer -> Codename -> StateT MainState uiM FetchedRecord
-getUInfoFetched staleTime name =
-    gets ((Map.lookup name) . userInfos) >>=
-	\x -> case x of
-	    Nothing -> set
-	    Just (tvar, time) -> do
-		now <- liftIO getCurrentTime
-		if floor (diffUTCTime now time) > staleTime
-		    then set
-		    else liftIO $ atomically $ readTVar tvar
-    where set = do
-	    tvar <- setUInfoTVar name
+getUInfoFetched :: UIMonad uiM => Integer -> Codename -> MainStateT uiM FetchedRecord
+getUInfoFetched staleTime name = do
+    uinfott <- gets (Map.lookup name . userInfoTVs)
+    ($uinfott) $ maybe set $ \(tvar,time) -> do
+	now <- liftIO getCurrentTime
+	if floor (diffUTCTime now time) > staleTime
+	    then set
+	    else liftIO $ atomically $ readTVar tvar
+    where
+	set = do
+	    now <- liftIO getCurrentTime
+	    tvar <- getRecordCachedFromCur True $ RecUserInfo name
+	    modify $ \ms -> ms {userInfoTVs = Map.insert name (tvar, now) $ userInfoTVs ms}
 	    liftIO $ atomically $ readTVar tvar
 
-mgetUInfo :: UIMonad uiM => Codename -> MaybeT (StateT MainState uiM) UserInfo
+mgetUInfo :: UIMonad uiM => Codename -> MaybeT (MainStateT uiM) UserInfo
 mgetUInfo name = do
     RCUserInfo (_,uinfo) <- MaybeT $ (fetchedRC <$>) $ getUInfoFetched defaultStaleTime name
     return uinfo
     where defaultStaleTime = 300
 
-setUInfoTVar :: UIMonad uiM => Codename -> StateT MainState uiM (TVar FetchedRecord)
-setUInfoTVar name = do
-    now <- liftIO getCurrentTime
-    tvar <- getRecordCachedFromCur True $ RecUserInfo name
-    modify $ \ms -> ms {userInfos = Map.insert name (tvar, now) $ userInfos ms}
-    return tvar
 
-invalidateUInfo :: UIMonad uiM => Codename -> StateT MainState uiM ()
-invalidateUInfo name = 
-    modify $ \ms -> ms {userInfos = Map.delete name $ userInfos ms}
+invalidateUInfo :: UIMonad uiM => Codename -> MainStateT uiM ()
+invalidateUInfo name =
+    modify $ \ms -> ms {userInfoTVs = Map.delete name $ userInfoTVs ms}
 
-invalidateAllUInfo :: UIMonad uiM => StateT MainState uiM ()
+invalidateAllUInfo :: UIMonad uiM => MainStateT uiM ()
 invalidateAllUInfo =
-    modify $ \ms -> ms {userInfos = Map.empty}
+    modify $ \ms -> ms {userInfoTVs = Map.empty}
 
-mgetLock :: UIMonad uiM => LockSpec -> MaybeT (StateT MainState uiM) Lock
+data Codenames = AllCodenames | SomeCodenames [Codename]
+
+invalidateUInfos :: UIMonad uiM => Codenames -> MainStateT uiM ()
+invalidateUInfos AllCodenames = invalidateAllUInfo
+invalidateUInfos (SomeCodenames names) = mapM_ invalidateUInfo names
+
+
+mgetLock :: UIMonad uiM => LockSpec -> MaybeT (MainStateT uiM) Lock
 mgetLock ls = do
-    tvar <- msum [ MaybeT $ (Map.lookup ls) <$> gets indexedLocks 
+    tvar <- msum [ MaybeT $ (Map.lookup ls) <$> gets indexedLocks
 	, lift $ do
-	    tvar <- getRecordCachedFromCur True $ RecLock ls 
+	    tvar <- getRecordCachedFromCur True $ RecLock ls
 	    modify $ \ms -> ms { indexedLocks = Map.insert ls tvar $ indexedLocks ms }
 	    return tvar ]
     RCLock lock <- MaybeT $ (fetchedRC<$>) $ liftIO $ atomically $ readTVar tvar
     return $ reframe lock
 
-refreshUInfoUI :: (UIMonad uiM) => StateT MainState uiM ()
+refreshUInfoUI :: (UIMonad uiM) => MainStateT uiM ()
 refreshUInfoUI = void.runMaybeT $ do
     modify $ \ms -> ms { listOffset = 0 }
-    mourNameSelected >>= flip when getRandomNames
+    mourNameSelected >>? getRandomNames
     lift $ modify $ \ms -> ms {retiredLocks = Nothing}
     lift.lift $ drawMessage ""
     where
@@ -256,15 +263,15 @@
 		resp <- makeRequest saddr $
 		    ClientRequest protocolVersion Nothing $ GetRandomNames 19
 		case resp of
-		    ServedRandomNames names -> atomically $ do 
+		    ServedRandomNames names -> atomically $ do
 			    writeTVar rnamestvar names
 			    writeTVar flag True
 		    _ -> return ()
 
-mourNameSelected :: (UIMonad uiM) => MaybeT (StateT MainState uiM) Bool
+mourNameSelected :: (UIMonad uiM) => MaybeT (MainStateT uiM) Bool
 mourNameSelected = liftM2 (==) mgetCurName mgetOurName
 
-purgeInvalidUndecls :: (UIMonad uiM) => StateT MainState uiM ()
+purgeInvalidUndecls :: (UIMonad uiM) => MainStateT uiM ()
 purgeInvalidUndecls = do
     undecls' <- gets undeclareds >>= filterM ((not<$>).invalid)
     modify $ \ms -> ms { undeclareds = undecls' }
@@ -273,15 +280,14 @@
 	    (fromMaybe False <$>) $ runMaybeT $ do
 		uinfo <- mgetUInfo name
 		ourName <- mgetOurName
-		msum [ do
-			linfo <- MaybeT $ return $ userLocks uinfo ! idx
-			return $ public linfo 
-			    || ourName `elem` accessedBy linfo 
-			    || lockSpec linfo /= ls
-		    , return True
-		    ]
+		(`mplus` return True) $ do
+		    linfo <- liftMaybe $ userLocks uinfo ! idx
+		    return $ public linfo
+			|| ourName `elem` accessedBy linfo
+			|| lockSpec linfo /= ls
 
-curServerAction :: UIMonad uiM => Protocol.Action -> StateT MainState uiM ServerResponse
+
+curServerAction :: UIMonad uiM => Protocol.Action -> MainStateT uiM ServerResponse
 curServerAction act = do
     saddr <- gets curServer
     auth <- gets curAuth
@@ -289,29 +295,36 @@
     if cOnly then return $ ServerError "Can't contact server in cache-only mode"
 	else lift $ withImpatience $ liftIO $ makeRequest saddr $ ClientRequest protocolVersion auth act
 
-curServerActionAsync :: UIMonad uiM => Protocol.Action -> StateT MainState uiM ()
-curServerActionAsync act = do
+curServerActionAsyncThenInvalidate :: UIMonad uiM => Protocol.Action -> Maybe Codenames -> MainStateT uiM ()
+curServerActionAsyncThenInvalidate act names = do
     saddr <- gets curServer
     auth <- gets curAuth
     flag <- gets newAsync
     errtvar <- gets asyncError
+    invaltvar <- gets asyncInvalidate
     cOnly <- gets cacheOnly
     void $ liftIO $ forkIO $ do
 	resp <- if cOnly then return $ ServerError "Can't contact server in cache-only mode"
 		else makeRequest saddr $ ClientRequest protocolVersion auth act
 	case resp of
 	    ServerError err -> atomically $ writeTVar errtvar $ Just err
-	    _ -> return ()
+	    _ -> atomically $ writeTVar invaltvar names
 	atomically $ writeTVar flag True
 
-checkAsyncErrors :: UIMonad uiM => StateT MainState uiM ()
-checkAsyncErrors = void.runMaybeT $ do
-    errtvar <- lift $ gets asyncError
-    err <- MaybeT $ liftIO $ atomically $ readTVar errtvar
-    lift.lift $ drawError err
-    liftIO $ atomically $ writeTVar errtvar Nothing
+checkAsync :: UIMonad uiM => MainStateT uiM ()
+checkAsync = do
+    void.runMaybeT $ do
+	errtvar <- lift $ gets asyncError
+	err <- MaybeT $ liftIO $ atomically $
+		readTVar errtvar <* writeTVar errtvar Nothing
+	lift.lift $ drawError err
+    void.runMaybeT $ do
+	invaltvar <- lift $ gets asyncInvalidate
+	names <- MaybeT $ liftIO $ atomically $
+		readTVar invaltvar <* writeTVar invaltvar Nothing
+	lift $ invalidateUInfos names >> refreshUInfoUI
 
-getRecordCachedFromCur :: UIMonad uiM => Bool -> Record -> StateT MainState uiM (TVar FetchedRecord)
+getRecordCachedFromCur :: UIMonad uiM => Bool -> Record -> MainStateT uiM (TVar FetchedRecord)
 getRecordCachedFromCur flagIt rec = do
     saddr <- gets curServer
     auth <- gets curAuth
@@ -320,7 +333,7 @@
     liftIO $ getRecordCached saddr auth
 	(if flagIt then Just flag else Nothing) cOnly rec
 
-getFreshRecBlocking :: UIMonad uiM => Record -> StateT MainState uiM (Maybe RecordContents)
+getFreshRecBlocking :: UIMonad uiM => Record -> MainStateT uiM (Maybe RecordContents)
 getFreshRecBlocking rec = do
     tvar <- getRecordCachedFromCur False rec
     cOnly <- gets cacheOnly
@@ -349,7 +362,8 @@
     liftIO $ forkIO $ waitImpatiently 0
     m <* (liftIO $ atomically $ writeTVar finishedTV True)
 
-getRelScore :: (UIMonad uiM) => Codename -> StateT MainState uiM (Maybe Int)
+
+getRelScore :: (UIMonad uiM) => Codename -> MainStateT uiM (Maybe Int)
 getRelScore name = (fst<$>) <$> getRelScoreDetails name
 getRelScoreDetails name = runMaybeT $ do
     ourName <- mgetOurName
@@ -359,24 +373,24 @@
     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 
+	countUnaccessedBy ui name = length $ filter isNothing $ getAccessInfo ui name
 
-accessedAL :: (UIMonad uiM) => ActiveLock -> StateT MainState uiM Bool
+accessedAL :: (UIMonad uiM) => ActiveLock -> MainStateT uiM Bool
 accessedAL (ActiveLock name idx) = (isJust <$>) $ runMaybeT $ do
     ourName <- mgetOurName
     guard $ ourName /= name
     uinfo <- mgetUInfo name
-    guard $ snd $ getAccessInfo uinfo ourName !! idx
+    guard $ isJust $ getAccessInfo uinfo ourName !! idx
 
-getNotesReadOn :: UIMonad uiM => LockInfo -> StateT MainState uiM [NoteInfo]
+getNotesReadOn :: UIMonad uiM => LockInfo -> MainStateT uiM [NoteInfo]
 getNotesReadOn lockinfo = (fromMaybe [] <$>) $ runMaybeT $ do
     ourName <- mgetOurName
     ourUInfo <- mgetUInfo ourName
     return $ filter (\n -> isNothing (noteBehind n)
 	    || n `elem` notesRead ourUInfo) $ lockSolutions lockinfo
 
-testAuth :: UIMonad uiM => StateT MainState uiM ()
-testAuth = (isJust <$> gets curAuth >>=) $ flip when $ do
+testAuth :: UIMonad uiM => MainStateT uiM ()
+testAuth = isJust <$> gets curAuth >>? do
     resp <- curServerAction $ Authenticate
     case resp of
 	ServerMessage msg -> (lift $ drawMessage $ "Server: " ++ msg)
diff --git a/Maxlocksize.hs b/Maxlocksize.hs
--- a/Maxlocksize.hs
+++ b/Maxlocksize.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
diff --git a/Metagame.hs b/Metagame.hs
--- a/Metagame.hs
+++ b/Metagame.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
@@ -38,14 +38,19 @@
 
 initLockInfo ls = LockInfo ls False [] [] []
 
-getAccessInfo :: UserInfo -> Codename -> [(Bool,Bool)]
--- | getAccessInfo ui name = [(ith lock is public, ith lock is accessed by name) | i]
+data AccessedReason = AccessedPrivy | AccessedEmpty | AccessedPub
+    deriving (Eq, Ord, Show, Read)
+getAccessInfo :: UserInfo -> Codename -> [Maybe AccessedReason]
 getAccessInfo ui name =
     let mlinfos = elems $ userLocks ui
 	accessedSlot = maybe accessedAllExisting accessedLock
 	accessedAllExisting = all (maybe True accessedLock) mlinfos
-	accessedLock linfo = public linfo || name `elem` accessedBy linfo 
-    in map (\mlinfo -> (maybe False public mlinfo, accessedSlot mlinfo)) mlinfos
+	accessedLock linfo = public linfo || name `elem` accessedBy linfo
+    in map (maybe
+	    (if accessedAllExisting then Just AccessedEmpty else Nothing)
+	    (\linfo -> if public linfo then Just AccessedPub
+		else if accessedLock linfo then Just AccessedPrivy else Nothing))
+	mlinfos
 
 data UserInfoDelta
     = AddRead NoteInfo
@@ -62,7 +67,7 @@
     | SetPublic
     deriving (Eq, Ord, Show, Read)
 
-data NoteInfo = NoteInfo {noteAuthor::Codename, noteBehind::Maybe ActiveLock, noteOn::ActiveLock} 
+data NoteInfo = NoteInfo {noteAuthor::Codename, noteBehind::Maybe ActiveLock, noteOn::ActiveLock}
     deriving (Eq, Ord, Show, Read)
 
 data ActiveLock = ActiveLock {lockOwner::Codename, lockIndex :: LockIndex}
@@ -81,7 +86,7 @@
 type Hint = GameState
 
 lockIndexChar :: LockIndex -> Char
-lockIndexChar i = toEnum $ i + fromEnum 'A' 
+lockIndexChar i = toEnum $ i + fromEnum 'A'
 charLockIndex c = fromEnum (toUpper c) - fromEnum 'A'
 
 applyDeltas :: UserInfo -> [UserInfoDelta] -> UserInfo
@@ -137,7 +142,7 @@
 
 instance Binary LockInfo where
     put (LockInfo spec pk notes solved accessed) = put spec >> put pk >> put notes >> put solved >> put accessed
-    get = liftM5 LockInfo get get get get get 
+    get = liftM5 LockInfo get get get get get
 
 instance Binary NoteInfo where
     put (NoteInfo author behind on) = put author >> put behind >> put on
diff --git a/Mundanities.hs b/Mundanities.hs
--- a/Mundanities.hs
+++ b/Mundanities.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
@@ -70,3 +70,7 @@
     annotated <- (\p -> (,) p <$> doesDirectoryExist p) `mapM` contents
     let (dirs,files) = join (***) (map fst) $ partition snd annotated
     (files++) . concat <$> getDirContentsRec `mapM` dirs
+
+fullLockPath path = if isAbsolute path
+    then return path
+    else (++(pathSeparator:path)) <$> confFilePath "locks"
diff --git a/NEWS b/NEWS
--- a/NEWS
+++ b/NEWS
@@ -1,73 +1,38 @@
-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:
-    Misc minor UI improvements.
-0.3.1:
-    Misc minor UI improvements;
-    Help screens in SDL mode.
+This is an abbreviated summary; see the git log for gory details.
+
+0.4.1:
+    Concurrency on server; no more freezes while it checks a solution.
+    Misc minor UI fixes.
+    
+0.4:
+    Sound effects (thanks linley).
+    Animate to show the two physics phases (thanks dormir).
+    Help screens.
+    Help text for buttons and metagame.
+    Deneutralised metagame terminology.
+    Tutorial tweaked.
+    Various UI improvements (thanks Quicksand-S and dormir)
+
 0.3:
-    Minor fixes; first version uploaded to hackage
-0.2.8:
-    Implemented click-and-drag movement in play and edit modes.
-0.2.7:
+    Mouse control.
     Improvements to curses UI - handle resizing; show keys; allow rebinding.
-    Fixed some bugs with viewing notes.
-0.2.6.3:
-    Update default server address
-0.2.6.2:
-    Fix silly crash bug introduced by 0.2.6.1
-0.2.6.1:
-    Add mouse control of tools
-0.2.6:
-    Minor UI tweaks.
-0.2.5:
     Shortened tutorial drastically. Other levels now in 'tutorial-extra/'.
-    Improved video setup handling.
-    Fixed bug with text disappearing on resize.
-0.2.4:
     Improve handling inaccessible servers.
     Added background.
-    Fixed bug with prompts being quickly dismissed when using the mouse.
-0.2.3:
-    Minor graphical improvements.
-0.2.2:
-    Visible changes:
-	scoring tweak: empty slots are accessed iff all non-empty slots are;
-	'q'uit confirmation now reminds you what you're quitting from;
-	we now consider testedness when deciding if a lock is modified;
-	added detailed game info to the README;
-	added hover text for UI buttons.
-    Bugs fixed:
+    First version uploaded to hackage.
+    Scoring tweak: empty slots are accessed iff all non-empty slots are.
+    Detailed game info in README.
+    Hover text for UI buttons.
+    Marks.
+    Lock testing in edit mode.
+    Significant bugs fixed:
 	editor, lockfile reader, and validity checker were not in accordance
-	    on what is allowed as the root of a spring;
-	SDL UI was redrawing the screen on every mouse movement;
+	    on what is allowed as the root of a spring.
+	SDL UI was redrawing the screen on every mouse movement.
 	curses UI wasn't refreshing properly on async flag.
-0.2.1:
-    New features:
-	The "reset tools" command has become a "test lock" command. Successful
-	    tests are saved along with the lock, meaning you can then place the
-	    lock without having to test it again.
-
-	You can now use marks in 'play' mode, and there's a default mark for the
-	    initial state, effectively giving a "reset" command.
-
-    Bugs fixed: 
-	stale notes weren't getting refreshed
-	retired display got stuck on changing codename
-	you couldn't move into the bolthole with keyboard commands
+	stale notes weren't getting refreshed.
+	retired display got stuck on changing codename.
+	you couldn't move into the bolthole with keyboard commands.
     
 0.2:
     First public release
diff --git a/Physics.hs b/Physics.hs
--- a/Physics.hs
+++ b/Physics.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
@@ -79,12 +79,12 @@
 	    , natLen /= curLen
 	    , let dir = if natLen > curLen then outDir else neg outDir ]
 
-    in ( Vector.map (ForceChoice . replicate 1 . snd) rootedForces, 
+    in ( Vector.map (ForceChoice . replicate 1 . snd) rootedForces,
 	\f1 f2 -> Just True == do
 		rootIdx <- fst $ rootedForces!f2
 		return $ connGraphPathExists st (forceIdx.snd $ rootedForces!f1) rootIdx )
-	
 
+
 setTools :: PlayerMove -> GameState -> GameState
 setTools pm st =
     let hf = case pm of
@@ -104,6 +104,9 @@
 	tell $ [AlertIntermediateState st']
 	resolveForces Vector.empty efs dominates $ setTools NullPM st'
 
+stepPhysics :: GameState -> GameState
+stepPhysics = fst.runWriter.physicsTick NullPM
+
 type Source = Int
 data SourcedForce = SForce Source Force Bool Bool
     deriving (Eq, Ord, Show)
@@ -115,14 +118,14 @@
 		[False,False] -> eDominates (i-pln) (j-pln)
 		_ -> False
 	initGrps = fmap (propagate st True) plForces Vector.++
-		fmap (propagate st False) eForces 
+		fmap (propagate st False) eForces
 	blockInconsistent :: Int -> Int -> StateT (Vector (Writer Any [Force])) (Writer [Alert]) ()
 	blockInconsistent i j = do
 	    grps <- mapM gets [(!i),(!j)]
 	    blocks <- lift $ checkInconsistent i j $ map (fst.runWriter) grps
 	    modify $ Vector.imap (\k -> if k `elem` blocks then (tell (Any True) >>) else id)
 	checkInconsistent :: Int -> Int -> [[Force]] -> Writer [Alert] [Int]
-	checkInconsistent i j fss = 
+	checkInconsistent i j fss =
 	    let st' = foldr applyForce st $ nub $ concat fss
 		(inconsistencies,cols) = runWriter $ sequence
 		    [ tell cols >> return [f,f']
@@ -148,7 +151,7 @@
 	    | Push idx dir <- fs
 	    , Wrench mom <- [placedPiece $ getpp st idx]
 	    , mom `notElem` [zero,dir] ]
-    in do 
+    in do
 	let unresisted = [ s | (s, (_, Any False)) <- enumVec $ fmap runWriter initGrps ]
 
 	-- check for inconsistencies within, and between pairs of, forcegroups
@@ -163,7 +166,12 @@
 	tell $ map AlertAppliedForce unblocked
 	tell $ map AlertDivertedWrench $ divertedWrenches unblocked
 	return $ stopBlockedWrenches blocked $ foldr applyForce st unblocked
-    
+
+resolveSinglePlForce :: Force -> GameState -> Writer [Alert] GameState
+resolveSinglePlForce force st = resolveForces
+    (Vector.singleton (ForceChoice [force])) Vector.empty
+    (\_ _->False) st
+
 applyForce :: Force -> GameState -> GameState
 applyForce f s =
     let idx = forceIdx f
@@ -171,7 +179,7 @@
 	pp'' = case (placedPiece pp',f) of
 		   ( Wrench _ , Push _ dir ) -> pp' {placedPiece = Wrench dir}
 		   _ -> pp'
-	in 
+	in
 	s { placedPieces = (placedPieces s) // [(idx, pp'')] }
 
 collisionsWithForce :: GameState -> Force -> PieceIdx -> [HexPos]
@@ -190,7 +198,7 @@
 applyForceTo pp _ = pp
 
 -- A force on a piece which resists it is immediately blocked
-pieceResists :: GameState -> Force -> Bool 
+pieceResists :: GameState -> Force -> Bool
 pieceResists st force =
     let idx = forceIdx force
 	PlacedPiece _ piece = getpp st idx
@@ -201,7 +209,7 @@
 		     (Wrench mom) -> case force of
 			    Push _ v -> v /= mom
 			    _ -> True
-		     (Hook _ hf) -> case force of 
+		     (Hook _ hf) -> case force of
 			    Push _ v -> hf /= PushHF v
 			    Torque _ dir -> hf /= TorqueHF dir
 		     _ -> False
diff --git a/Protocol.hs b/Protocol.hs
--- a/Protocol.hs
+++ b/Protocol.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
@@ -70,7 +70,7 @@
 
 data ServerInfo = ServerInfo {serverLockSize :: Int, serverInfoString::String}
     deriving (Eq, Ord, Show, Read)
-defaultServerInfo = ServerInfo 8 ""
+defaultServerInfo locksize = ServerInfo locksize ""
 
 instance Binary ClientRequest where
     put (ClientRequest pv mauth act) = putPackedInt pv >> put mauth >> put act
diff --git a/SDLRender.hs b/SDLRender.hs
--- a/SDLRender.hs
+++ b/SDLRender.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
@@ -22,6 +22,7 @@
 import qualified Data.Map as Map
 import Data.List (maximumBy)
 import Data.Function (on)
+import GHC.Int (Int16)
 
 import Hex
 import GameState
@@ -57,6 +58,18 @@
     filledCircleAt surf centre rad fillCol
     circleAt surf centre rad $ opaquify rimCol
 
+thickLine :: Surface -> (Int16,Int16) -> (Int16,Int16) -> Float -> Pixel -> IO ()
+thickLine surf from@(x,y) to@(x',y') thickness col = do
+    let (dx,dy) = (x'-x,y'-y)
+	[rdx,rdy] = map fromIntegral [dx,dy]
+	s = thickness / (sqrt $ rdx^2 + rdy^2)
+	perp@(px,py) = (round $ s*rdy, round $ s*(-rdx))
+	mperp = (-px,-py)
+	addHalf (a,b) (c,d) = ( (2*a + c) `div` 2, (2*b + d) `div` 2 )
+    rimmedPolygon surf
+	(map (uncurry addHalf) [(from,perp),(to,perp),(from,mperp),(to,mperp)])
+	(dim col) (bright col)
+
 type Glyph = SVec -> Int -> Surface -> IO ()
 
 ysize :: Int -> Int
@@ -100,7 +113,7 @@
 
 tileGlyph (BlockTile adjs) col centre size surf =
     rimmedPolygon surf corners col $ bright col
-	where 
+	where
 	    corners = concat [
 		if or $ map adjAt [0,1]
 		then [corner centre size $ hextant dir]
@@ -140,7 +153,7 @@
 	    to = edge centre rad dir
 
 tileGlyph (ArmTile dir _) col centre size surf =
-    void $ aaLine surf `uncurry` from `uncurry` to $ bright col
+    void $ thickLine surf from to 1 col
 	where
 	    dir' = if dir == zero then hu else dir
 	    from = edge centre size $ neg dir'
@@ -154,7 +167,7 @@
 tileGlyph (WrenchTile mom) col centre size surf = do
     rimmedCircle surf centre (size`div`3) col $ bright col
     when (mom /= zero) $
-	let 
+	let
 	    (fx,fy) = innerCorner centre size $ neg mom
 	    (tx,ty) = edge centre size $ neg mom
 	    shifts = map (map (`div` 2)) $
@@ -209,7 +222,7 @@
 
 	--from' = corner centre size $ hextant dir
 	--to' = corner centre size $ (hextant dir) - 1
-	
+
 collisionMarker :: Glyph
 collisionMarker centre@(SVec x y) size surf = void $ do
     -- rimmedCircle surf centre (size`div`3) (bright purple) $ bright purple
@@ -333,7 +346,7 @@
 blue = colourWheel 4
 purple = colourWheel 5
 
-colourOf colouring idx = 
+colourOf colouring idx =
     case Map.lookup idx colouring of
 	    Nothing -> white
 	    Just n -> colourWheel n
@@ -347,7 +360,7 @@
     deriving (Eq, Ord, Show)
 instance Monoid SVec where
     mempty = SVec 0 0
-    mappend (SVec x y) (SVec x' y') = SVec (x+x') (y+y') 
+    mappend (SVec x y) (SVec x' y') = SVec (x+x') (y+y')
 instance Grp SVec where
     neg (SVec x y) = SVec (-x) (-y)
 type CCoord = PHS SVec
@@ -462,7 +475,7 @@
 	liftM3 (,,) renderSurf renderSCentre renderSize
     let SVec _ y = scrCentre <+> (hexVec2SVec size v)
 	w = surfaceGetWidth surf
-	h = ceiling $ fromIntegral size * 2 * sqrt 3
+	h = ceiling $ fromIntegral size * 2 / sqrt 3
     fillRectBG $ Just $ Rect 0 (y-h`div`2) w h
 
 drawCursorAt :: Maybe HexPos -> RenderM ()
diff --git a/SDLUI.hs b/SDLUI.hs
--- a/SDLUI.hs
+++ b/SDLUI.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
@@ -50,6 +50,7 @@
 import SDLRender
 import InputMode
 import Maxlocksize
+import Util
 
 data UIState = UIState { scrHeight::Int, scrWidth::Int
     , gsSurface::Maybe Surface
@@ -114,7 +115,7 @@
 
 
 refresh :: UIM ()
-refresh = do 
+refresh = do
     surface <- liftIO getVideoSurface
     liftIO $ SDL.flip surface
 
@@ -139,38 +140,18 @@
 getButtons mode = do
     mwhs <- gets $ whsButtons.uiOptions
     cntxtButtons <- gets contextButtons
-    return $ cntxtButtons ++ global ++ case mode of 
+    return $ cntxtButtons ++ global ++ case mode of
 	IMEdit -> [
 	    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 [("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 -> 
+	    , singleButton (br<+>2<*>hu) CmdWriteState 2 [("save", hu<+>neg hw)] ]
+	    ++ whsBGs mwhs mode
+	    ++ [ ([Button (paintButtonStart <+> hu <+> i<*>hv) (paintTileCmds!!i) []
+		| i <- take (length paintTiles) [0..] ],(5,0)) ]
+	IMPlay ->
 	    [ 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) ) ])
+	    ++ whsBGs mwhs mode
 	    ++ [ singleButton tr CmdOpen 1 [("open", hu<+>neg hw)] ]
 	IMReplay -> [ markGroup ]
 	IMMeta ->
@@ -181,7 +162,7 @@
 	    , 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 [("set",hu<+>neg hw),("mark",hu<+>neg hv)]
@@ -190,19 +171,41 @@
 	    global = if mode == IMTextInput then [] else
 		[ singleButton br CmdQuit 0 [("quit",hu<+>neg hw)]
 		, singleButton (tr <+> 3<*>hv <+> 3<*>hu) CmdHelp 3 [("help",hu<+>neg hw)] ]
+	    whsBGs :: Maybe WrHoSel -> InputMode -> [ ButtonGroup ]
+	    whsBGs Nothing _ = []
+	    whsBGs (Just whs) mode =
+		let edit = mode == IMEdit
+		in [ ( [ Button bl (if edit then CmdSelect else CmdWait) [] ], (0,0))
+		, ( [ Button (bl<+>dir) (CmdDir whs dir)
+			(if dir==hu then [("move",hu<+>neg hw),(if edit then "piece" else 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 || mode == IMEdit 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) ) ])
 	    tr = periphery 0
 	    tl = periphery 2
 	    bl = periphery 3
 	    br = periphery 5
 
-data AccessedMethod = AccessedSolved | AccessedPublic | AccessedReadNotes | AccessedUndeclared
+data AccessedInfo = AccessedSolved | AccessedPublic | AccessedReadNotes | AccessedUndeclared
     deriving (Eq, Ord, Show)
 data Selectable = SelOurLock
     | SelLock ActiveLock
     | SelLockUnset Bool ActiveLock
     | SelSelectedCodeName Codename
     | SelRelScore Int
-    | SelScoreLock (Maybe Codename) Bool ActiveLock
+    | SelScoreLock (Maybe Codename) (Maybe AccessedReason) ActiveLock
     | SelUndeclared Undeclared
     | SelReadNote NoteInfo
     | SelReadNoteSlot
@@ -212,7 +215,10 @@
     | SelSecured NoteInfo
     | SelOldLock LockSpec
     | SelPublicLock
-    | SelAccessedMethod AccessedMethod
+    | SelAccessedInfo AccessedInfo
+    | SelLockPath
+    | SelPrivyHeader
+    | SelNotesHeader
     deriving (Eq, Ord, Show)
 
 registerSelectable v r s =
@@ -247,6 +253,7 @@
 commandOfSelectable IMMeta (SelSecured note) False = CmdSelCodename $ Just $ lockOwner $ noteOn note
 commandOfSelectable IMMeta (SelSecured note) True = CmdViewSolution $ Just note
 commandOfSelectable IMMeta (SelOldLock ls) _ = CmdPlayLockSpec $ Just ls
+commandOfSelectable IMMeta (SelLockPath) _ = CmdSelectLock
 commandOfSelectable IMTextInput (SelLock (ActiveLock _ i)) _ = CmdInputSelLock i
 commandOfSelectable IMTextInput (SelScoreLock _ _ (ActiveLock _ i)) _ = CmdInputSelLock i
 commandOfSelectable IMTextInput (SelLockUnset _ (ActiveLock _ i)) _ = CmdInputSelLock i
@@ -257,34 +264,66 @@
 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 SelOurLock = Just
+    "Design a lock."
+helpOfSelectable (SelSelectedCodeName name) = Just $
+    "Currently viewing "++name++"."
+helpOfSelectable (SelRelScore score) = Just $
+    "The extent to which you are held in higher esteem than this fellow guild member."
+helpOfSelectable (SelLock (ActiveLock name i)) = Just $
+    name++"'s lock "++[lockIndexChar i]++"."
+helpOfSelectable (SelLockUnset True _) = Just
+    "Place a lock."
+helpOfSelectable (SelLockUnset False _) = Just
+    "An empty lock slot."
+helpOfSelectable (SelUndeclared _) = Just
+    "Declare yourself privy to a lock's secrets by securing a note on it behind a lock of your own."
+helpOfSelectable (SelRandom _) = Just
+    "Random set of guild members. Colours show relative esteem, bright red (-3) to bright green (+3)."
+helpOfSelectable (SelScoreLock (Just name) Nothing _) = Just $
+    "Your lock, to the secrets of which "++name++" is not privy."
+helpOfSelectable (SelScoreLock (Just name) (Just AccessedPrivy) _) = Just $
+    "Your lock, to the secrets of which "++name++" is privy: -1 to relative esteem."
+helpOfSelectable (SelScoreLock (Just name) (Just AccessedPub) _) = Just $
+    "Your lock, the secrets of which have been publically revealed: -1 to relative esteem."
+helpOfSelectable (SelScoreLock (Just name) (Just AccessedEmpty) _) = Just $
+    "Your empty lock slot; "++name++" is privy to the secrets of all your locks: -1 to relative esteem."
+helpOfSelectable (SelScoreLock Nothing Nothing (ActiveLock name _)) = Just $
+    name++"'s lock, to the secrets of which you are not privy."
+helpOfSelectable (SelScoreLock Nothing (Just AccessedPrivy) (ActiveLock name _)) = Just $
+    name++"'s lock, to the secrets of which you are privy: +1 to relative esteem."
+helpOfSelectable (SelScoreLock Nothing (Just AccessedPub) (ActiveLock name _)) = Just $
+    name++"'s lock, the secrets of which have been publically revealed: +1 to relative esteem."
+helpOfSelectable (SelScoreLock Nothing (Just AccessedEmpty) (ActiveLock name _)) = Just $
+    name++"'s empty lock slot; you are privy to the secrets of all "++name++"'s locks: +1 to relative esteem."
+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 piece together enough to unriddle its secrets."
 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."
+    Just $ "Secured note on "++owner++"'s lock "++[lockIndexChar idx]++"."
 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
+helpOfSelectable (SelAccessed name) = Just $
+    name ++ " did not pick this lock, but is privy to its secrets."
+helpOfSelectable (SelPublicLock) = Just
+    "Notes behind retired or public locks are public; locks with three public notes are public."
+helpOfSelectable (SelAccessedInfo meth) = Just $ case meth of
+    AccessedSolved -> "You picked this lock and declared your solution, so may read any notes it secures."
+    AccessedPublic -> "The secrets of this lock have been publically revealed."
+    AccessedUndeclared -> "You have picked this lock, but are yet to declare your solution."
+    AccessedReadNotes ->
+	"Having read three notes on others' solutions to this lock, you have unravelled its secrets."
+helpOfSelectable (SelOldLock ls) = Just $
+    "Retired lock, #"++show ls++". Any notes which were secured by the lock are now public knowledge."
+helpOfSelectable SelLockPath = Just $
+    "Select a lock by its name. The names you give your locks are not revealed to others."
+helpOfSelectable SelPrivyHeader = Just $
+    "Guild members privy to this lock's secrets, hence able to read its secured notes."
+helpOfSelectable SelNotesHeader = Just $
+    "Secured notes. Notes are obfuscated sketches of method, proving success but revealing little."
 
 cmdAtMousePos pos@(mPos,central) im selMode = do
     buttons <- (concat . map fst) <$> getButtons im
@@ -298,8 +337,8 @@
 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 }
 
@@ -317,9 +356,9 @@
 uiOB3 = UIOptButton whsButtons (\v o -> o {whsButtons=v}) [Nothing, Just WHSSelected, Just WHSWrench, Just WHSHook]
 	(periphery 3 <+> 3 <*> hv) whsButtonsButton
 	(\v -> case v of
-	    Nothing -> "Click to show keyboard control buttons for tools."
+	    Nothing -> "Showing mouse controls; click to show keyboard control buttons."
 	    Just whs -> "Showing buttons for controlling " ++ case whs of
-		WHSSelected -> "selected tool"
+		WHSSelected -> "selected piece"
 		WHSWrench -> "wrench"
 		WHSHook -> "hook")
 uiOB4 = UIOptButton showButtonText (\v o -> o {showButtonText=v}) [True,False]
@@ -333,14 +372,13 @@
 
 drawUIOptionButtons :: InputMode -> UIM ()
 drawUIOptionButtons mode = do
-    when (mode `elem` [IMPlay, IMEdit]) $ do
+    when (mode `elem` [IMPlay, IMEdit, IMReplay]) $ do
 	drawUIOptionButton uiOB1
 	drawUIOptionButton uiOB2
+	unless (mode == IMReplay) $ drawUIOptionButton uiOB3
 #ifdef SOUND
 	drawUIOptionButton uiOB5
 #endif
-    when (mode == IMPlay) $
-	drawUIOptionButton uiOB3
     drawUIOptionButton uiOB4
 drawUIOptionButton b = do
     value <- gets $ (getUIOpt b).uiOptions
@@ -356,7 +394,7 @@
     modifyUIOptions $ setopt value'
 
 readUIConfigFile :: UIM ()
-readUIConfigFile = do 
+readUIConfigFile = do
     path <- liftIO $ confFilePath "SDLUI.conf"
     mOpts <- liftIO $ readReadFile path
     case mOpts of
@@ -370,7 +408,7 @@
     liftIO $ writeFile path $ show opts
 
 readBindings :: UIM ()
-readBindings = do 
+readBindings = do
     path <- liftIO $ confFilePath "bindings"
     mbdgs <- liftIO $ readReadFile path
     case mbdgs of
@@ -412,7 +450,7 @@
 drawPaintButtons :: UIM ()
 drawPaintButtons = do
     pti <- getEffPaintTileIndex
-    renderToMain $ sequence_ [ 
+    renderToMain $ sequence_ [
 	do
 	    let gl = case paintTiles!!i of
 		    Nothing -> hollowInnerGlyph $ dim purple
@@ -435,8 +473,8 @@
 screenWidthHexes = 32
 screenHeightHexes = 25
 getGeom :: UIM (SVec, Int)
-getGeom = do 
-    h <- gets scrHeight 
+getGeom = do
+    h <- gets scrHeight
     w <- gets scrWidth
     let scrCentre = SVec (w`div`2) (h`div`2)
     -- |size is the greatest integer such that
@@ -458,7 +496,10 @@
 drawMainGameState' :: DrawArgs -> UIM ()
 drawMainGameState' args@(DrawArgs highlight colourFixed alerts st uiopts) = do
     lastArgs <- gets lastDrawArgs
-    when (lastArgs /= Just args) $
+    when (case lastArgs of
+	    Nothing -> True
+	    Just (DrawArgs _ _ lastAlerts lastSt _) ->
+		lastAlerts /= alerts || lastSt /= st) $
 	modify $ \ds -> ds { animFrame = 0, nextAnimFrameAt = Nothing }
 
     lastAnimFrame <- gets animFrame
@@ -494,7 +535,7 @@
 	    gsSurf <- liftM fromJust $ gets gsSurface
 	    renderToMainWithSurf gsSurf $ do
 		erase
-		sequence_ [ drawAt glyph pos | 
+		sequence_ [ drawAt glyph pos |
 		    (pos,glyph) <- Map.toList $ fmap (ownedTileGlyph colouring highlight) board
 		    ]
 
@@ -571,7 +612,7 @@
 		colouring = if useFiveColouring uiopts
 		    then boardColouring st coloured Map.empty
 		    else pieceTypeColouring st coloured
-		draw = sequence_ [ drawAt glyph pos | 
+		draw = sequence_ [ drawAt glyph pos |
 		    (pos,glyph) <- Map.toList $ fmap (ownedTileGlyph colouring []) $ stateBoard st ]
 	    liftIO $ runReaderT draw $
 		RenderContext surf Nothing (PHS zero) (SVec (width`div`2) (height`div`2)) minisize Nothing
@@ -581,7 +622,7 @@
 
 -- | TODO: do this more cleverly
 clearOldMiniLocks =
-    (>=50).Map.size <$> gets miniLocks >>= flip when clearMiniLocks
+    (>=50).Map.size <$> gets miniLocks >>? clearMiniLocks
 clearMiniLocks = modify $ \ds -> ds { miniLocks = Map.empty}
 
 drawEmptyMiniLock v =
@@ -602,7 +643,7 @@
     showBT <- showButtonText <$> gets uiOptions
     smallFont <- gets dispFontSmall
     renderToMain $ sequence_ $ concat [ [ do
-		drawAtRel (buttonGlyph col) v 
+		drawAtRel (buttonGlyph col) v
 		renderStrColAt buttonTextCol bdg v
 		when showBT $
 		    withFont smallFont $ recentreAt v $ rescaleRender (1/4) $
@@ -616,7 +657,7 @@
 initVideo :: Int -> Int -> UIM ()
 initVideo w h = do
     liftIO $ setVideoMode w h 0 [Resizable]
-    
+
     -- see what size we actually got:
     vinfo <- liftIO $ getVideoInfo
     let [w',h'] = map ($vinfo) [videoInfoWidth,videoInfoHeight]
@@ -646,7 +687,7 @@
     when (isNothing font) $ lift $ do
 	let text = "Warning: font file not found at "++fontpath++".\n"
 	putStr text
-	writeFile "error.log" text 
+	writeFile "error.log" text
 
 initAudio :: UIM ()
 #ifdef SOUND
@@ -697,12 +738,12 @@
 setMsgLineNoRefresh col str = do
     modify $ \s -> s { message = Just (col,str) }
     unless (null str) $ modify $ \s -> s { hoverStr = Nothing }
-    drawMsgLine 
+    drawMsgLine
 setMsgLine col str = setMsgLineNoRefresh col str >> refresh
 
 drawTitle (Just title) = renderToMain $ renderStrColAt messageCol title titlePos
 drawTitle Nothing = return ()
-    
+
 say = setMsgLine messageCol
 sayError = setMsgLine errorCol
 
diff --git a/SDLUIMInstance.hs b/SDLUIMInstance.hs
--- a/SDLUIMInstance.hs
+++ b/SDLUIMInstance.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
@@ -62,6 +62,7 @@
 	    drawButtons mode
 	    drawUIOptionButtons mode
 	    drawMsgLine
+	    drawShortMouseHelp mode
 	    refresh
 	where
 	drawMainState' (PlayState { psCurrentState=st, psLastAlerts=alerts, wrenchSelected=wsel }) = do
@@ -73,11 +74,11 @@
 			, or [wsel && isWrench p, not wsel && isHook p] ]
 		drawMainGameState selTools False alerts st
 		registerUndoButtons canUndo canRedo
-	drawMainState' (ReplayState { rsCurrentState=st } ) = do
+	drawMainState' (ReplayState { rsCurrentState=st, rsLastAlerts=alerts } ) = do
 	    canUndo <- null <$> gets rsGameStateMoveStack
 	    canRedo <- null <$> gets rsMoveStack
 	    lift $ do
-		drawMainGameState [] False [] st
+		drawMainGameState [] False alerts st
 		registerUndoButtons canUndo canRedo
 		renderToMain $ drawCursorAt Nothing
 	drawMainState' (EditState { esGameStateStack=(st:sts), esUndoneStack=undostack,
@@ -96,19 +97,19 @@
 		    (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
+	drawMainState' (MetaState saddr undecls cOnly auth names _ _ _ rnamestvar _ _ mretired path mlock offset) = do
 	    let ourName = authUser <$> auth
 	    let selName = listToMaybe names
 	    let home = isJust ourName && ourName == selName
 	    lift $ renderToMain $ (erase >> drawCursorAt Nothing)
-	    lift $ maybe (drawEmptyMiniLock miniLockPos)
-		(\lock -> do
-		    drawMiniLock lock miniLockPos
-		    registerSelectable miniLockPos 3 SelOurLock
-		    )
-		(fst<$>mlock)
+	    lift $ do
+		maybe (drawEmptyMiniLock miniLockPos)
+		    (\lock -> drawMiniLock lock miniLockPos)
+		    (fst<$>mlock)
+		registerSelectable miniLockPos 3 SelOurLock
 	    lift $ when (not $ null path) $ do
 		renderToMain $ renderStrColAtLeft messageCol path $ lockLinePos <+> hu
+		registerSelectable (lockLinePos <+> 2<*>hu) 1 SelLockPath
 		sequence_
 		    [ registerButton (miniLockPos <+> 2<*>neg hv <+> hu <+> dv) cmd 4
 			[(dirText,hu<+>neg hw),("lock",hu<+>neg hv)]
@@ -132,13 +133,13 @@
 			    renderToMain $ withFont smallFont $ renderStrColAtLeft (opaquify $ dim errorCol) "(stale)" $ serverWaitPos
 			maybe (return ()) (setMsgLineNoRefresh errorCol) err
 			when (fresh && (isNothing ourName || home || isNothing muirc)) $
-			    let reg = (isNothing muirc && isNothing ourName) || home  
+			    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 name)
 		    drawRelScore name (codenamePos<+>hu)
-		    for_ muirc $ \(RCUserInfo (_,uinfo)) -> case mretired of 
+		    for_ muirc $ \(RCUserInfo (_,uinfo)) -> case mretired of
 			    Just retired -> do
 				fillArea locksPos
 				    (map (locksPos<+>) $ zero:[rotate n $ 4<*>hu<->4<*>hw | n <- [0,2,3,5]])
@@ -177,29 +178,29 @@
 	    when (ourName /= selName) $ void $ runMaybeT $ do
 		when (isJust ourName) $
 		    lift.lift $ registerButton (codenamePos <+> neg hu <+> hw) CmdHome 4 [("home",hu<+>neg hv)]
-		sel <- MaybeT $ return selName
-		us <- MaybeT $ return ourName
+		sel <- liftMaybe selName
+		us <- liftMaybe ourName
 		ourUInfo <- mgetUInfo us
 		selUInfo <- mgetUInfo sel
 		let accesses = map (uncurry getAccessInfo) [(ourUInfo,sel),(selUInfo,us)]
-		lift $ do 
+		lift $ do
 		    fillArea (codenamePos<+>3<*>hv<+>hw) (map ((codenamePos<+>3<*>hv)<+>) [zero,hw,neg hv])
-			[ \pos -> (lift $ registerSelectable pos 0 (SelScoreLock (Just sel) access $ ActiveLock us i)) >>
+			[ \pos -> (lift $ registerSelectable pos 0 (SelScoreLock (Just sel) accessed $ ActiveLock us i)) >>
 			    drawNameWithCharAndCol us white (lockIndexChar i) col pos
 			| i <- [0..2]
-			, let (pub,access) = accesses !! 0 !! i
+			, let accessed = accesses !! 0 !! i
 			, let col
-				| pub = dim pubColour 
-				| access = dim $ scoreColour $ -3 
+				| accessed == Just AccessedPub = dim pubColour
+				| isJust accessed = 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 (SelScoreLock Nothing access $ ActiveLock sel i)) >>
+			[ \pos -> (lift $ registerSelectable pos 0 (SelScoreLock Nothing accessed $ ActiveLock sel i)) >>
 			    drawNameWithCharAndCol sel white (lockIndexChar i) col pos
 			| i <- [0..2]
-			, let (pub,access) = accesses !! 1 !! i
+			, let accessed = accesses !! 1 !! i
 			, let col
-				| pub = obscure pubColour 
-				| access = dim $ scoreColour $ 3 
+				| accessed == Just AccessedPub = obscure pubColour
+				| isJust accessed = 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
@@ -215,9 +216,9 @@
 
     getChRaw = do
 	events <- liftIO getEvents
-	case listToMaybe $ [ key | KeyDown key <- events ] of
-	    Nothing -> getChRaw
-	    Just (Keysym _ _ ch) -> return $ Just ch
+	maybe getChRaw (return.Just) $ listToMaybe $ [ ch
+	    | KeyDown (Keysym _ _ ch) <- events
+	    , ch /= '\0' ]
 
     setUIBinding mode cmd ch =
 	modify $ \s -> s { uiKeyBindings =
@@ -257,7 +258,7 @@
     getDrawImpatience = do
 	curState <- get
 	let pos = serverWaitPos
-	return $ \ticks -> void $ flip runStateT curState $ do 
+	return $ \ticks -> void $ flip runStateT curState $ do
 	    when (ticks>2) $ renderToMain $ do
 		mapM (drawAtRel (filledHexGlyph $ bright black)) [ pos <+> i<*>hu | i <- [0..3] ]
 		withFont (dispFontSmall curState) $
@@ -281,6 +282,9 @@
 	drawButtons IMTextInput
 	refresh
 
+    toggleColourMode = modify $ \s -> s {uiOptions = (uiOptions s){
+        useFiveColouring = not $ useFiveColouring $ uiOptions s}}
+
     getInput mode = do
 	fps <- gets fps
 	events <- liftIO $ nubMouseMotions <$> getEventsTimeout (10^6`div`fps)
@@ -430,21 +434,22 @@
 		return [ CmdRedraw ]
 	    processEvent VideoExpose = return [ CmdRedraw ]
 	    processEvent Quit = return [ CmdForceQuit ]
-		
+
 	    processEvent _ = return []
 
 	    doWheel dw = do
 		rb <- isJust <$> gets rightButtonDown
 		mb <- isJust <$> gets middleButtonDown
-		if ((rb||mb) && mode /= IMEdit) || (mb && mode == IMEdit)
+		if ((rb || mb || mode == IMReplay) && 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
 	    drawCmd (Just t) False = CmdTile t
 	    drawCmd Nothing _ = CmdDelete
@@ -468,23 +473,23 @@
     showHelp mode = do
 	bdgs <- nub <$> getBindings mode
 	smallFont <- gets dispFontSmall
-	renderToMain $ do 
+	renderToMain $ do
 	    erase
 	    let bdgWidth = (screenWidthHexes-6) `div` 3
 		showKeys chs = intercalate "/" (map showKeyFriendly chs)
 		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; 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 with right button held down to undo/redo."]
-		    IMMeta -> ["Left-clicking on something does most obvious thing;",
-			"Right-clicking does second-most obvious thing."]
-
+		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; 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 with right button held down to undo/redo."]
+			IMMeta -> ["Left-clicking on something does most obvious thing;",
+			    "Right-clicking does second-most obvious thing."]
 	    renderStrColAt messageCol "Keybindings:" $ (screenHeightHexes`div`4)<*>(hv<+>neg hw)
 	    sequence_ [ with $ renderStrColAtLeft messageCol
 			( keysStr ++ ": " ++ desc )
@@ -511,6 +516,35 @@
 		| (str,y) <- zip mouseHelpStrs [0..] ]
 	refresh
 
+drawShortMouseHelp mode = do
+    mwhs <- gets $ whsButtons.uiOptions
+    showBT <- showButtonText <$> gets uiOptions
+    when (showBT && isNothing mwhs) $ do
+	let helps = shortMouseHelp mode
+	smallFont <- gets dispFontSmall
+	renderToMain $ withFont smallFont $ sequence_
+	    [ renderStrColAtLeft (dim cyan) help
+		(periphery 3 <+> neg hu <+> (2-n)<*>hv )
+	    | (n,help) <- zip [0..] helps ]
+    where
+	shortMouseHelp IMPlay =
+	    [ "LMB: select/move tool"
+	    , "LMB+drag: move tool"
+	    , "Wheel: turn hook"
+	    , "RMB: wait a turn"
+	    , "RMB+Wheel: undo/redo"
+	    ]
+	shortMouseHelp IMEdit =
+	    [ "LMB: paint; Ctrl+LMB: delete"
+	    , "Wheel: set paint type"
+	    , "RMB: select piece; drag to move"
+	    , "RMB+LMB: wait; RMB+MMB: delete piece"
+	    , "MMB+Wheel: undo/redo"
+	    ]
+	shortMouseHelp IMReplay =
+	    [ "Wheel: advance/regress time" ]
+	shortMouseHelp _ = []
+
 getEvents = do
     e <- waitEvent
     es <- pollEvents
@@ -556,7 +590,7 @@
 		++ "]"
 
 
-fillArea :: HexVec -> [HexVec] -> [HexVec -> StateT MainState UIM ()] -> StateT MainState UIM () 
+fillArea :: HexVec -> [HexVec] -> [HexVec -> MainStateT UIM ()] -> MainStateT UIM ()
 fillArea centre area draws = do
     offset <- gets listOffset
     let na = length area
@@ -580,12 +614,12 @@
     , lift.lift.renderToMain $
 	    renderStrColAt messageCol (show ls) pos
     ]
-    
 
+
 drawName name pos = nameCol name >>= drawNameCol name pos
 drawNullName name pos = drawNameCol name pos $ invisible white
 drawNameCol name pos col = do
-    lift.renderToMain $ do 
+    lift.renderToMain $ do
 	drawAtRel (playerGlyph col) pos
 	renderStrColAt messageCol name pos
 drawRelScore name pos = do
@@ -617,7 +651,7 @@
     smallFont <- lift $ gets dispFontSmall
     lift.renderToMain $ do
 	drawAtRel (playerGlyph col) pos
-	displaceRender up $ 
+	displaceRender up $
 	    renderStrColAt messageCol name pos
 	displaceRender down $ withFont smallFont $
 	    renderStrColAt charcol [char] pos
@@ -633,14 +667,14 @@
 scoreColour :: Int -> Pixel
 scoreColour score = Pixel $ case score of
 	0 -> 0x80800000
-	1 -> 0x70a00000 
+	1 -> 0x70a00000
 	2 -> 0x40c00000
 	3 -> 0x00ff0000
-	(-1) -> 0xa0700000 
+	(-1) -> 0xa0700000
 	(-2) -> 0xc0400000
 	(-3) -> 0xff000000
 
-drawLockInfo :: ActiveLock -> Maybe LockInfo -> StateT MainState UIM ()
+drawLockInfo :: ActiveLock -> Maybe LockInfo -> MainStateT UIM ()
 drawLockInfo al@(ActiveLock name i) Nothing = do
     let centre = hw<+>neg hv <+> 7*(i-1)<*>hu
     lift $ drawEmptyMiniLock centre
@@ -664,13 +698,17 @@
 		lift $ registerSelectable centre 3 $ SelLock al
 	]
 
-    lift.renderToMain $ renderStrColAt dimWhiteCol "Accessed by:" $ accessedByPos <+> hv
+    size <- snd <$> lift getGeom
+    lift $ do
+	renderToMain $ displaceRender (SVec size 0) $ renderStrColAt (brightish white) "PRIVY" $ accessedByPos <+> hv
+	registerSelectable (accessedByPos <+> hv) 0 SelPrivyHeader
+	registerSelectable (accessedByPos <+> hv <+> hu) 0 SelPrivyHeader
     if public lockinfo
     then lift $ do
-	renderToMain $ renderStrColAt pubColour "Everyone!" accessedByPos
+	renderToMain $ renderStrColAt pubColour "All" accessedByPos
 	registerSelectable accessedByPos 1 SelPublicLock
     else if null $ accessedBy lockinfo
-	then lift.renderToMain $ renderStrColAt messageCol "No-one" accessedByPos
+	then lift.renderToMain $ renderStrColAt dimWhiteCol "No-one" accessedByPos
 	else fillArea accessedByPos
 		[ accessedByPos <+> d | j <- [0..2], i <- [-2..3]
 		    , i-j > -4, i-j < 3
@@ -679,7 +717,7 @@
 		    | note <- lockSolutions lockinfo ] ++
 		[ \pos -> (lift $ registerSelectable pos 0 (SelAccessed name)) >> drawName name pos
 		    | name <- accessedBy lockinfo \\ map noteAuthor (lockSolutions lockinfo) ]
-    
+
     undecls <- gets undeclareds
     case if isJust $ guard . (|| public lockinfo) . (`elem` map noteAuthor (lockSolutions lockinfo)) =<< ourName
 	    then if public lockinfo
@@ -691,22 +729,25 @@
 	of
 	Just (col,str,selstr) -> lift $ do
 	    renderToMain $ renderStrColAt col str accessedPos
-	    registerSelectable accessedPos 1 (SelAccessedMethod selstr)
+	    registerSelectable accessedPos 1 (SelAccessedInfo 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)
+		when (length read == 3) $ lift $ registerSelectable readPos 0 (SelAccessedInfo 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
+    lift $ do
+	renderToMain $ displaceRender (SVec size 0) $ renderStrColAt (brightish white) "NOTES" $ notesPos <+> hv
+	registerSelectable (notesPos <+> hv) 0 SelNotesHeader
+	registerSelectable (notesPos <+> hv <+> hu) 0 SelNotesHeader
     if null $ notesSecured lockinfo
-	then lift.renderToMain $ renderStrColAt messageCol "None" notesPos
+	then lift.renderToMain $ renderStrColAt dimWhiteCol "None" notesPos
 	else fillArea notesPos
 		[ notesPos <+> d | j <- [0..2], i <- [-2..3]
 		    , i-j > -4, i-j < 3
diff --git a/Server.hs b/Server.hs
--- a/Server.hs
+++ b/Server.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
@@ -12,7 +12,7 @@
 
 import Network.Fancy
 
-import Control.Concurrent (threadDelay)
+import Control.Concurrent (threadDelay,forkIO)
 import Control.Applicative
 import Control.Monad
 import Control.Monad.Trans.State
@@ -48,14 +48,19 @@
 import Database
 import AsciiLock
 import Mundanities
+import Maxlocksize
 
-port = 27001 -- 27001 == ('i'<<8) + 'y'
+defaultPort = 27001 -- 27001 == ('i'<<8) + 'y'
 
-data Opt = RequestDelay Int
+data Opt = RequestDelay Int | Daemon | LogFile FilePath | Port Int | DBDir FilePath | ServerLockSize Int
     deriving (Eq, Ord, Show)
 options =
-    [ Option ['d'] ["delay"] (ReqArg (RequestDelay . read) "MICROSECS") "delay before sending response (for testing) (default: 0)"
-    --, Option ['d'] ["dir"] (ReqArg (DBDir . read)) "directory for server database [default: intricacydb]"
+    [ Option ['p'] ["port"] (ReqArg (Port . read) "PORT") $ "TCP port to listen on (default: " ++ show defaultPort ++ ")"
+    , Option ['P'] ["delay"] (ReqArg (RequestDelay . read) "MICROSECS") "delay before sending response (for testing) (default: 0)"
+    -- , Option ['d'] ["daemon"] (NoArg Daemon) "Run as daemon"
+    , Option ['l'] ["logfile"] (ReqArg LogFile "PATH") "Log to file"
+    , Option ['d'] ["dir"] (ReqArg DBDir "PATH") "directory for server database [default: intricacydb]"
+    , Option ['s'] ["locksize"] (ReqArg (ServerLockSize . read) "SIZE") "size of locks (only takes effect when creating a new database) [default: 8]"
     ]
 parseArgs :: [String] -> IO ([Opt],[String])
 parseArgs argv =
@@ -64,31 +69,52 @@
 	(_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
     where header = "Usage: intricacy-server [OPTION...]"
 
-main = do 
+main = do
     argv <- getArgs
     (opts,_) <- parseArgs argv
+    {- FIXME: doesn't work
+    if Daemon `elem` opts
+        then void $ forkIO $ main' opts
+        else main' opts
+    -}
     let delay = fromMaybe 0 $ listToMaybe [ d | RequestDelay d <- opts ]
-    withDB setDefaultServerInfo
-    writeFile lockFilePath ""
-    streamServer serverSpec{address = IPv4 "" port, threading=Inline} $ handler delay
+	port = fromMaybe defaultPort $ listToMaybe [ p | Port p <- opts ]
+	dbpath = fromMaybe "intricacydb" $ listToMaybe [ p | DBDir p <- opts ]
+	locksize = min maxlocksize $ fromMaybe 8 $ listToMaybe [ s | ServerLockSize s <- opts ]
+    withDB dbpath $ setDefaultServerInfo locksize
+    writeFile (lockFilePath dbpath) ""
+    logh <- case listToMaybe [ f | LogFile f <- opts ] of
+	Nothing -> return stdout
+	Just path -> openFile path AppendMode
+    streamServer serverSpec{address = IPv4 "" port, threading=Threaded} $ handler dbpath delay logh
     sleepForever
 
--- database path is relative to current directory: ./intricacydb/
-dbpath = "intricacydb"
-withDB = flip runReaderT dbpath
-
-setDefaultServerInfo = do
+setDefaultServerInfo locksize = do
     alreadySet <- recordExists RecServerInfo
-    unless alreadySet $ putRecord RecServerInfo (RCServerInfo defaultServerInfo)
+    unless alreadySet $ putRecord RecServerInfo (RCServerInfo $ defaultServerInfo locksize)
 
-logit = putStrLn
+-- | We lock the whole database during each request, using haskell's native
+-- file locking, meaning that we have at any time one writer *xor* any number
+-- of readers.
+withDBLock dbpath lockMode m = do
+    h <- liftIO $ getDBLock lockMode
+    ret <- m
+    liftIO $ hClose h
+    return ret
+    where
+	getDBLock lockMode =
+	    catchIO (openFile (lockFilePath dbpath) lockMode) (\_ -> threadDelay (50*10^3) >> getDBLock lockMode)
 
-handler :: Int -> Handle -> Address -> IO ()
-handler delay hdl addr = handle ((\e -> return ()) :: SomeException -> IO ()) $
+lockFilePath dbpath = dbpath ++ [pathSeparator] ++ "lockfile"
+
+logit h s = hPutStrLn h s >> hFlush h
+
+handler :: FilePath -> Int -> Handle -> Handle -> Address -> IO ()
+handler dbpath delay logh hdl addr = handle ((\e -> return ()) :: SomeException -> IO ()) $
     handler' hdl addr
     where handler' hdl addr = do
 	    response <- handle (\e -> return $ ServerError $ show (e::SomeException)) $ do
-		request <- B.decode <$> L.hGetContents hdl 
+		request <- B.decode <$> L.hGetContents hdl
 		let hostname = case addr of
 			IP n _ -> n
 			IPv4 n _ -> n
@@ -96,11 +122,11 @@
 			Unix path -> path
 		    hashedHostname = take 8 $ hash hostname
 		now <- liftIO getCurrentTime
-		logit $ show now ++ ": " ++ hashedHostname ++ " >>> " ++ showRequest request
-		response <- handleRequest request
+		logit logh $ show now ++ ": " ++ hashedHostname ++ " >>> " ++ showRequest request
+		response <- handleRequest dbpath request
 		when (delay > 0) $ threadDelay delay
 		now' <- liftIO getCurrentTime
-		logit $ show now' ++ ": " ++ hashedHostname ++ " <<< " ++ showResponse response
+		logit logh $ show now' ++ ": " ++ hashedHostname ++ " <<< " ++ showResponse response
 		return response
 	    L.hPut hdl $ B.encode response
 
@@ -120,20 +146,8 @@
 showResponse (ServedSolution soln) = "ServedSolution [SOLN]"
 showResponse resp = show resp
 
--- | We lock the whole database during each request, using haskell's native
--- file locking, meaning that we have at any time one writer *xor* any number
--- of readers.
-withDBLock lockMode m = do
-    h <- getDBLock lockMode
-    ret <- m
-    hClose h
-    return ret
-    where getDBLock lockMode =
-	    catchIO (openFile lockFilePath lockMode) (\_ -> threadDelay (50*10^3) >> getDBLock lockMode)
-lockFilePath = dbpath ++ [pathSeparator] ++ "lockfile"
-
-handleRequest :: ClientRequest -> IO ServerResponse
-handleRequest req@(ClientRequest pv auth action) = do
+handleRequest :: FilePath -> ClientRequest -> IO ServerResponse
+handleRequest dbpath req@(ClientRequest pv auth action) = do
     let lockMode = case action of
 	    Authenticate -> ReadMode
 	    GetServerInfo -> ReadMode
@@ -143,16 +157,46 @@
 	    GetSolution _ -> ReadMode
 	    GetRandomNames _ -> ReadMode
 	    _ -> ReadWriteMode
-    eresp <- withDBLock lockMode $ runErrorT handleRequest'
+
+    -- check solutions prior to write-locking database:
+    eresp <- runErrorT $ do
+	withDBLock dbpath ReadMode $ checkRequest
+	withDBLock dbpath lockMode $ handleRequest'
     case eresp of
 	Left error -> return $ ServerError error
 	Right resp -> return resp
+
     where
-	handleRequest' = do
+	checkRequest = do
 	    when (pv /= protocolVersion) $ throwError "Bad protocol version"
 	    case action of
-		Authenticate -> do 
-		    checkAuth auth 
+		DeclareSolution soln ls target idx -> do
+		    info <- getUserInfoOfAuth auth
+		    lock <- getLock ls
+		    tinfo <- getALock target
+		    when (ls /= lockSpec tinfo) $ throwError "Lock no longer in use!"
+		    when (public tinfo) $ throwError "Lock solution already public knowledge!"
+		    let name = codename info
+		    let behind = ActiveLock name idx
+		    when (name `elem` map noteAuthor (lockSolutions tinfo)) $
+			throwError "Note already taken on that lock!"
+		    when (name == lockOwner target) $
+			throwError "That's your lock!"
+		    behindLock <- getALock behind
+		    when (public behindLock) $ throwError "Your lock is cracked!"
+		    unless (checkSolution lock soln) $ throwError "Bad solution"
+		SetLock lock@(frame,_) idx soln -> do
+		    ServerInfo serverSize _ <- getServerInfo
+		    when (frame /= BasicFrame serverSize) $ throwError $
+			"Server only accepts size "++show serverSize++" locks."
+		    unless (validLock $ reframe lock) $ throwError "Invalid lock!"
+		    unless (not.checkSolved $ reframe lock) $ throwError "Lock not locked!"
+		    unless (checkSolution lock soln) $ throwError "Bad solution"
+		_ -> return ()
+	handleRequest' =
+	    case action of
+		Authenticate -> do
+		    checkAuth auth
 		    return $ ServerMessage $ "Welcome, " ++ authUser (fromJust auth)
 		Register -> newUser auth >> return ServerAck
 		ResetPassword passwd -> resetPassword auth passwd >> return ServerAck
@@ -164,15 +208,15 @@
 			(fromJust<$>)$ runMaybeT $ msum [ do
 			    v <- MaybeT $ return mversion
 			    msum [ guard (v >= curV) >> return ServerFresh
-				, do 
-				    guard (v >= curV - 10) 
+				, do
+				    guard (v >= curV - 10)
 				    RCUserInfoDeltas deltas <- lift $ getRecordErrored $ RecUserInfoLog name
 				    return $ ServedUserInfoDeltas $ take (curV-v) deltas
 				]
 			    , return $ ServedUserInfo (curV,info)
 			    ]
 		    ) `catchError` \_ -> return ServerCodenameFree
-		GetSolution note -> do 
+		GetSolution note -> do
 		    uinfo <- getUserInfoOfAuth auth
 		    let uname = codename uinfo
 		    onLinfo <- getALock $ noteOn note
@@ -190,20 +234,9 @@
 			else throwError "You don't have access to that note."
 		DeclareSolution soln ls target idx -> do
 		    info <- getUserInfoOfAuth auth
-		    lock <- getLock ls
-		    tinfo <- getALock target
-		    when (ls /= lockSpec tinfo) $ throwError "Lock no longer in use!"
-		    when (public tinfo) $ throwError "Lock solution already public knowledge!"
 		    let name = codename info
 		    let behind = ActiveLock name idx
 		    let note = NoteInfo name (Just behind) target
-		    when (name `elem` map noteAuthor (lockSolutions tinfo)) $
-			throwError "Note already taken on that lock!"
-		    when (name == lockOwner target) $
-			throwError "That's your lock!"
-		    behindLock <- getALock behind
-		    when (public behindLock) $ throwError "Your lock is cracked!"
-		    unless (checkSolution lock soln) $ throwError "Bad solution"
 		    erroredDB $ putRecord (RecNote note) (RCSolution soln)
 		    execStateT (declareNote note behind) [] >>= applyDeltasToRecords
 		    return ServerAck
@@ -211,13 +244,6 @@
 		    info <- getUserInfoOfAuth auth
 		    let name = codename info
 		    let al = ActiveLock name idx
-		    ServerInfo serverSize _ <- getServerInfo
-		    when (frame /= BasicFrame serverSize) $ throwError $
-			"Server only accepts size "++show serverSize++" locks."
-		    unless (validLock $ reframe lock) $ throwError "Invalid lock!"
-		    unless (not.checkSolved $ reframe lock) $ throwError "Lock not locked!"
-		    unless (checkSolution lock soln) $ throwError "Bad solution"
-
 		    RCLockHashes hashes <- getRecordErrored RecLockHashes
 			    `catchError` const (return (RCLockHashes []))
 		    let hashed = hash $ show lock
@@ -262,17 +288,17 @@
 		Left e -> throwError $ "Server IO error: " ++ show e
 		Right x -> return x
 	erroredDB :: DBM a -> ErrorT String IO a
-	erroredDB = erroredIO . withDB
+	erroredDB = erroredIO . withDB dbpath
 	getRecordErrored :: Record -> ErrorT String IO RecordContents
 	getRecordErrored rec = do
-	    mrc <- lift $ withDB $ getRecord rec 
+	    mrc <- lift $ withDB dbpath $ getRecord rec
 	    case mrc of
 		Just rc -> return rc
 		Nothing -> throwError $ "Bad record on server! Record was: " ++ show rec
-	getLock ls = do 
+	getLock ls = do
 	    RCLock lock <- getRecordErrored $ RecLock ls
 	    return lock
-	getSolution note = do 
+	getSolution note = do
 	    RCSolution soln <- getRecordErrored $ RecNote note
 	    return soln
 	getServerInfo = do
@@ -289,14 +315,14 @@
 		Just lockinfo -> return lockinfo
 	checkValidLockIndex idx =
 	    unless (0<=idx && idx < maxLocks) $ throwError "Bad lock index"
-	getUserInfo name = do 
+	getUserInfo name = do
 	    RCUserInfo (version,info) <- getRecordErrored $ RecUserInfo name
 	    return info
-	getUserInfoOfAuth auth = do 
+	getUserInfoOfAuth auth = do
 	    checkAuth auth
 	    let Just (Auth name _) = auth
 	    getUserInfo name
-	    
+
 	checkAuth :: Maybe Auth -> ErrorT String IO ()
 	checkAuth Nothing = throwError "Authentication required"
 	checkAuth (Just (Auth name pw)) = do
@@ -319,11 +345,11 @@
 	checkCodeName :: Codename -> ErrorT String IO Bool
 	checkCodeName name = do
 	    unless (validCodeName name) $ throwError "Invalid codename"
-	    liftIO $ withDB $ recordExists $ RecPassword name
+	    liftIO $ withDB dbpath $ recordExists $ RecPassword name
 	--- | TODO: journalling so we can survive death during database writes?
 	applyDeltasToRecords :: [(Codename, UserInfoDelta)] -> ErrorT String IO ()
 	applyDeltasToRecords nds = sequence_ $ [applyDeltasToRecord name deltas
-		| group <- groupBy ((==) `on` fst) nds 
+		| group <- groupBy ((==) `on` fst) nds
 		, let name = fst $ head group
 		, let deltas = map snd group ]
 	applyDeltasToRecord name deltas = do
@@ -367,7 +393,7 @@
 	    unless publified $ do
 	    lock <- getCurrALock al
 	    accessorsOfNotesOnLock <- ((++ map noteAuthor (lockSolutions lock)).concat)
-		<$> (sequence 
+		<$> (sequence
 		    [ accessedBy <$> getCurrALock behind | NoteInfo _ (Just behind) _ <- lockSolutions lock ] )
 	    forM_ accessorsOfNotesOnLock $ checkSuffReadNotes al
 	checkSuffReadNotes target name = do
diff --git a/ServerAddr.hs b/ServerAddr.hs
--- a/ServerAddr.hs
+++ b/ServerAddr.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
diff --git a/Setup.hs b/Setup.hs
--- a/Setup.hs
+++ b/Setup.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
diff --git a/Util.hs b/Util.hs
--- a/Util.hs
+++ b/Util.hs
@@ -3,7 +3,7 @@
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of version 3 of the GNU General Public License as
--- published by the Free Software Foundation.
+-- published by the Free Software Foundation, or any later version.
 --
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
@@ -11,6 +11,21 @@
 module Util where
 import qualified Data.Vector as Vector
 import Data.Vector (Vector)
+import Control.Monad
+import Control.Monad.Trans.Maybe
 
 enumVec :: Vector a -> [(Int,a)]
 enumVec = Vector.toList . Vector.indexed
+
+liftMaybe :: Monad m => Maybe a -> MaybeT m a
+liftMaybe = MaybeT . return
+
+-- nice tip from one joeyh:
+whenM,unlessM,(>>?),(>>!) :: Monad m => m Bool -> m () -> m ()
+whenM c a = c >>= flip when a
+unlessM c a = c >>= flip unless a
+(>>?) = whenM
+(>>!) = unlessM
+-- same precedence as ($), allowing e.g. foo bar >>! error $ "failed " ++ meep
+infixr 0 >>?
+infixr 0 >>!
diff --git a/intricacy.cabal b/intricacy.cabal
--- a/intricacy.cabal
+++ b/intricacy.cabal
@@ -1,5 +1,5 @@
 name:                intricacy
-version:             0.3.8
+version:             0.4.1
 synopsis:            A game of competitive puzzle-design
 homepage:            http://mbays.freeshell.org/intricacy
 license:             GPL-3
@@ -57,6 +57,7 @@
         , array >=0.3, containers >=0.4, vector >=0.9
         , binary >=0.5, network-fancy >= 0.1.5
         , cryptohash >= 0.8
+        , safe >= 0.2
       if flag(SDL)
           build-depends: SDL >=0.6.5, SDL-ttf >=0.6, SDL-gfx >=0.6
           if flag(Sound)
diff --git a/tutorial/1-winning.text b/tutorial/1-winning.text
--- a/tutorial/1-winning.text
+++ b/tutorial/1-winning.text
@@ -1,1 +1,1 @@
-click and drag tools to pull bolt, then Open the lock
+use tools to pull bolt, then Open the lock