diff --git a/AsciiLock.hs b/AsciiLock.hs
--- a/AsciiLock.hs
+++ b/AsciiLock.hs
@@ -47,109 +47,109 @@
 lockOfAscii lines = do
     board <- asciiToBoard lines
     let size = maximum $ map (hx . (-^origin)) $ Map.keys board
-	frame = BasicFrame size
+        frame = BasicFrame size
     st <- asciiBoardState frame board
     return (frame, st)
 
 boardToAscii :: PieceColouring -> GameBoard -> AsciiLock
 boardToAscii colouring board =
     let asciiBoard :: Map CVec Char
-	asciiBoard = Map.mapKeys (hexVec2CVec . (-^origin))
-	    $ fmap (monochromeOTileChar colouring) board
-	(miny,maxy) = minmax $ map cy $ Map.keys asciiBoard
-	(minx,maxx) = minmax $ map cx $ Map.keys asciiBoard
-	asciiBoard' = Map.mapKeys (-^CVec miny minx) asciiBoard
+        asciiBoard = Map.mapKeys (hexVec2CVec . (-^origin))
+            $ fmap (monochromeOTileChar colouring) board
+        (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'
-	    | x <- [0..(maxx-minx)] ]
-	| y <- [0..(maxy-miny)] ]
+            | x <- [0..(maxx-minx)] ]
+        | y <- [0..(maxy-miny)] ]
 
 asciiToBoard :: AsciiLock -> Maybe GameBoard
 asciiToBoard lines =
     let asciiBoard :: Map CVec Char
-	asciiBoard = Map.fromList [(CVec y x,ch)
-	    | (line,y) <- zip lines [0..]
-	    , (ch,x) <- zip line [0..]
-	    , ch `notElem` "\t\r\n "]
-	(miny,maxy) = minmax $ map cy $ Map.keys asciiBoard
-	midy = miny+(maxy-miny)`div`2
-	midline = filter ((==midy).cy) $ Map.keys asciiBoard
-	(minx,maxx) = minmax $ map cx $ midline
-	centre = CVec midy (minx+(maxx-minx)`div`2)
+        asciiBoard = Map.fromList [(CVec y x,ch)
+            | (line,y) <- zip lines [0..]
+            , (ch,x) <- zip line [0..]
+            , ch `notElem` "\t\r\n "]
+        (miny,maxy) = minmax $ map cy $ Map.keys asciiBoard
+        midy = miny+(maxy-miny)`div`2
+        midline = filter ((==midy).cy) $ Map.keys asciiBoard
+        (minx,maxx) = minmax $ map cx $ midline
+        centre = CVec midy (minx+(maxx-minx)`div`2)
     in Map.mapKeys ((+^origin) . cVec2HexVec . (-^centre))
-	<$> T.mapM monoToOTile asciiBoard
+        <$> T.mapM monoToOTile asciiBoard
 
 asciiBoardState :: Frame -> GameBoard -> Maybe GameState
 asciiBoardState frame board =
     let addPreBase st = foldr addpp st (replicate 6 $ PlacedPiece origin $ Block [])
-	addBase st = foldr addBaseOT st $ Map.toList $
-	    Map.filter (isBaseTile.snd) board
-	isBaseTile (BlockTile _) = True
-	isBaseTile (PivotTile _) = True
-	isBaseTile HookTile = True
-	isBaseTile (WrenchTile _) = True
-	isBaseTile (BallTile) = True
-	isBaseTile _ = False
-	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 $ map fst $ sortBy (flip compare `on` snd)
-		    [ ((idx,pp),length vs)
-		    | (idx,pp) <- enumVec $ placedPieces st
-		    , Block vs <- [placedPiece pp]
-		    , let fp = plPieceFootprint pp
-		    , not $ null fp
-		    , all (not.inBounds frame) fp
-		    ]
-	    return $ delPiece idx $ setpp 0 pp st
-	baseSt = setFrame . componentifyNew . addBase . addPreBase $ GameState Vector.empty []
+        addBase st = foldr addBaseOT st $ Map.toList $
+            Map.filter (isBaseTile.snd) board
+        isBaseTile (BlockTile _) = True
+        isBaseTile (PivotTile _) = True
+        isBaseTile HookTile = True
+        isBaseTile (WrenchTile _) = True
+        isBaseTile (BallTile) = True
+        isBaseTile _ = False
+        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 $ map fst $ sortBy (flip compare `on` snd)
+                    [ ((idx,pp),length vs)
+                    | (idx,pp) <- enumVec $ placedPieces st
+                    , Block vs <- [placedPiece pp]
+                    , let fp = plPieceFootprint pp
+                    , not $ null fp
+                    , all (not.inBounds frame) fp
+                    ]
+            return $ delPiece idx $ setpp 0 pp st
+        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 _)) =
-	    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 _ dir)) =
-	    let rpos = (neg dir+^pos)
-	    in case Map.lookup rpos baseBoard of
-		Just (_,SpringTile _ _) -> Just st
-		Just _ -> do
-		    (_,epos) <- castRay pos dir baseBoard
-		    let twiceNatLen = sum [ extnValue extn
-			    | i <- [1..hexLen (epos-^rpos)-1]
-			    , let pos' = i*^dir+^rpos
-			    , Just (_,SpringTile extn _) <- [ Map.lookup pos' board ] ]
-			extnValue Compressed = 4
-			extnValue Relaxed = 2
-			extnValue Stretched = 1
-			Just root = posLocus baseSt rpos
-			Just end = posLocus baseSt epos
-		    Just $ flip addConn st $ Connection root end $ Spring dir $ twiceNatLen`div`2
-		_ -> Just st
-	addAppendageOT _ _ = Nothing
+        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 _)) =
+            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 _ dir)) =
+            let rpos = (neg dir+^pos)
+            in case Map.lookup rpos baseBoard of
+                Just (_,SpringTile _ _) -> Just st
+                Just _ -> do
+                    (_,epos) <- castRay pos dir baseBoard
+                    let twiceNatLen = sum [ extnValue extn
+                            | i <- [1..hexLen (epos-^rpos)-1]
+                            , let pos' = i*^dir+^rpos
+                            , Just (_,SpringTile extn _) <- [ Map.lookup pos' board ] ]
+                        extnValue Compressed = 4
+                        extnValue Relaxed = 2
+                        extnValue Stretched = 1
+                        Just root = posLocus baseSt rpos
+                        Just end = posLocus baseSt epos
+                    Just $ flip addConn st $ Connection root end $ Spring dir $ twiceNatLen`div`2
+                _ -> Just st
+        addAppendageOT _ _ = Nothing
     in addAppendages baseSt
 
 monochromeOTileChar :: PieceColouring -> OwnedTile -> Char
 monochromeOTileChar colouring (idx,BlockTile _) =
     case Map.lookup idx colouring of
-	Just 1 -> '%'
-	Just 2 -> '"'
-	Just 3 -> '&'
-	Just 4 -> '~'
-	_ -> '#'
+        Just 1 -> '%'
+        Just 2 -> '"'
+        Just 3 -> '&'
+        Just 4 -> '~'
+        _ -> '#'
 monochromeOTileChar _ (_,t) = monochromeTileChar t
 monochromeTileChar :: Tile -> Char
 monochromeTileChar (PivotTile _) = 'o'
@@ -165,29 +165,29 @@
 monochromeTileChar BallTile = 'O'
 monochromeTileChar (SpringTile extn dir)
     | dir == hu = case extn of
-	Stretched                  -> 's'
-	Relaxed                    -> 'S'
-	Compressed                 -> '$'
+        Stretched                  -> 's'
+        Relaxed                    -> 'S'
+        Compressed                 -> '$'
     | dir == hv = case extn of
-	Stretched                  -> 'z'
-	Relaxed                    -> 'Z'
-	Compressed                 -> '5'
+        Stretched                  -> 'z'
+        Relaxed                    -> 'Z'
+        Compressed                 -> '5'
     | dir == hw = case extn of
-	Stretched                  -> '('
-	Relaxed                    -> '['
-	Compressed                 -> '{'
+        Stretched                  -> '('
+        Relaxed                    -> '['
+        Compressed                 -> '{'
     | dir == neg hu = case extn of
-	Stretched                  -> 'c'
-	Relaxed                    -> 'C'
-	Compressed                 -> 'D'
+        Stretched                  -> 'c'
+        Relaxed                    -> 'C'
+        Compressed                 -> 'D'
     | dir == neg hv = case extn of
-	Stretched                  -> ')'
-	Relaxed                    -> ']'
-	Compressed                 -> '}'
+        Stretched                  -> ')'
+        Relaxed                    -> ']'
+        Compressed                 -> '}'
     | dir == neg hw = case extn of
-	Stretched                  -> '1'
-	Relaxed                    -> '7'
-	Compressed                 -> '9'
+        Stretched                  -> '1'
+        Relaxed                    -> '7'
+        Compressed                 -> '9'
 monochromeTileChar _ = '?'
 monoToOTile :: Char -> Maybe OwnedTile
 monoToOTile '#' = Just $ (1,BlockTile [])
@@ -234,13 +234,13 @@
 readAsciiLockFile path = flip catchIO (const $ return (Nothing,Nothing)) $ do
     lines <- readStrings path
     return $ fromMaybe (lockOfAscii lines, Nothing) $ do
-	    guard $ length lines > 2
-	    let (locklines, [header,solnLine]) = splitAt (length lines - 2) lines
-	    guard $ isPrefixOf "Solution:" header
-	    return (lockOfAscii locklines, tryRead solnLine)
+            guard $ length lines > 2
+            let (locklines, [header,solnLine]) = splitAt (length lines - 2) lines
+            guard $ isPrefixOf "Solution:" header
+            return (lockOfAscii locklines, tryRead solnLine)
 
 writeAsciiLockFile :: FilePath -> Maybe Solution -> Lock -> IO ()
 writeAsciiLockFile path msoln lock = do
     writeStrings path $ lockToAscii lock ++ case msoln of
-	Nothing -> []
-	Just soln -> ["Solution:", show soln]
+        Nothing -> []
+        Just soln -> ["Solution:", show soln]
diff --git a/BinaryInstances.hs b/BinaryInstances.hs
--- a/BinaryInstances.hs
+++ b/BinaryInstances.hs
@@ -24,14 +24,14 @@
 instance Binary SmallNat where
     put (SmallNat n) = if n < 255 then putWord8 (fromIntegral n) else putWord8 255 >> put n
     get = do
-	n' <- get :: Get Word8
-	if n' == 255 then liftM SmallNat get else return $ SmallNat $ fromIntegral n'
+        n' <- get :: Get Word8
+        if n' == 255 then liftM SmallNat get else return $ SmallNat $ fromIntegral n'
 
 instance Binary SmallInt where
     put (SmallInt n) = if abs n < 127 then put ((fromIntegral n)::Int8) else put (127::Int8) >> put n
     get = do
-	n' <- get :: Get Int8
-	if n' == 127 then liftM SmallInt get else return $ SmallInt $ fromIntegral n'
+        n' <- get :: Get Int8
+        if n' == 127 then liftM SmallInt get else return $ SmallInt $ fromIntegral n'
 
 putPackedNat,putPackedInt :: Int -> Put
 putPackedNat n = put $ SmallNat n
@@ -44,8 +44,8 @@
 instance Binary a => Binary (ShortList a) where
     put (ShortList as) = putPackedNat (length as) >> mapM_ put as
     get = do
-	n <- getPackedNat
-	ShortList `liftM` getMany n
+        n <- getPackedNat
+        ShortList `liftM` getMany n
 
  -- | 'getMany n' get 'n' elements in order, without blowing the stack.
  -- [ copied from source of package 'binary' by Lennart Kolmodin ]
@@ -62,9 +62,9 @@
 instance Binary HexVec where
     put (HexVec x y _) = putPackedInt x >> putPackedInt y
     get = do
-	x <- getPackedInt
-	y <- getPackedInt
-	return $ tupxy2hv (x,y)
+        x <- getPackedInt
+        y <- getPackedInt
+        return $ tupxy2hv (x,y)
 instance Binary g => Binary (PHS g) where
     put (PHS v) = put v
     get = liftM PHS get
@@ -81,40 +81,40 @@
     put (Wrench mom) = put (3::Word8) >> put mom
     put Ball = put (4::Word8)
     get = do
-	tag <- get :: Get Word8
-	case tag of
-	    0 -> liftM (Block . fromShortList) get
-	    1 -> liftM (Pivot . fromShortList) get
-	    2 -> liftM2 Hook get get
-	    3 -> liftM Wrench get
-	    4 -> return Ball
+        tag <- get :: Get Word8
+        case tag of
+            0 -> liftM (Block . fromShortList) get
+            1 -> liftM (Pivot . fromShortList) get
+            2 -> liftM2 Hook get get
+            3 -> liftM Wrench get
+            4 -> return Ball
 instance Binary Connection where
     put (Connection (ri,rp) (ei,ep) l) = putPackedInt ri >> put rp >> putPackedInt ei >> put ep >> put l
     get = do
-	ri <- getPackedInt
-	rp <- get
-	ei <- getPackedInt
-	ep <- get
-	l <- get
-	return $ Connection (ri,rp) (ei,ep) l
+        ri <- getPackedInt
+        rp <- get
+        ei <- getPackedInt
+        ep <- get
+        l <- get
+        return $ Connection (ri,rp) (ei,ep) l
 instance Binary Link where
     put (Free p) = put (0::Word8) >> put p
     put (Spring d l) = put (1::Word8) >> put d >> putPackedInt l
     get = do
-	tag <- get :: Get Word8
-	case tag of
-	    0 -> liftM Free get
-	    1 -> liftM2 Spring get getPackedInt
+        tag <- get :: Get Word8
+        case tag of
+            0 -> liftM Free get
+            1 -> liftM2 Spring get getPackedInt
 instance Binary HookForce where
     put NullHF = put (0::Word8)
     put (TorqueHF dir) = put (1::Word8) >> putPackedInt dir
     put (PushHF v) = put (2::Word8) >> put v
     get = do
-	tag <- get :: Get Word8
-	case tag of
-	    0 -> return NullHF
-	    1 -> liftM TorqueHF getPackedInt
-	    2 -> liftM PushHF get
+        tag <- get :: Get Word8
+        case tag of
+            0 -> return NullHF
+            1 -> liftM TorqueHF getPackedInt
+            2 -> liftM PushHF get
 instance Binary Frame where
     put (BasicFrame s) = putPackedInt s
     get = liftM BasicFrame getPackedInt
@@ -125,9 +125,9 @@
     put (HookTorque dir) = put (2::Word8) >> putPackedInt dir
     put (WrenchPush v) = put (3::Word8) >> put v
     get = do
-	tag <- get :: Get Word8
-	case tag of
-	    0 -> return NullPM
-	    1 -> liftM HookPush get
-	    2 -> liftM HookTorque getPackedInt
-	    3 -> liftM WrenchPush get
+        tag <- get :: Get Word8
+        case tag of
+            0 -> return NullPM
+            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
@@ -32,61 +32,61 @@
 colouredPieces colourFixed st = [ idx |
     (idx, PlacedPiece _ p) <- enumVec $ placedPieces st
     , isPivot p ||
-	and [ isBlock p, idx > 0
-	      , or [ colourFixed, not $ null $ springsEndAtIdx st idx ] ] ]
+        and [ isBlock p, idx > 0
+              , or [ colourFixed, not $ null $ springsEndAtIdx st idx ] ] ]
 
 pieceTypeColouring :: GameState -> [PieceIdx] -> PieceColouring
 pieceTypeColouring st coloured = Map.fromList
     [ (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 ]
+        , 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
     where
-	board = stateBoard st
-	graph = Map.fromList [ (idx, nub $ neighbours idx)
-	    | idx <- coloured ]
-	neighbours idx =
-	    neighbours' idx (perim idx) []
-	perim :: PieceIdx -> Set (HexPos,HexDir)
-	perim idx =
-	    Set.fromList $ nubBy ((==)`on`fst) [ (pos', neg dir)
-		| dir <- hexDirs
-		, pos <- fullFootprint st idx
-		, let pos' = dir +^ pos
-		, Just True /= do
-		    (idx',_) <- Map.lookup pos' board
-		    return $ idx == idx'
-		]
-	neighbours' :: PieceIdx -> Set (HexPos,HexDir) -> [PieceIdx] -> [PieceIdx]
-	neighbours' idx as ns
-	    | Set.null as = ns
-	    | otherwise =
-		let a = head $ Set.elems as
-		    (path, ns') = march idx (fst a) a True
-		in neighbours' idx
-		    (Set.filter (\(pos,_) -> pos `notElem` path) as)
-		    (ns++ns')
-	-- |march around the piece's boundary, returning positions visited and
-	-- neighbouring pieces met (in order)
-	march idx startPos (pos,basedir) init
-	    | not init && pos == startPos = ([],[])
-	    | otherwise =
-	    let mn = do
-		    (idx',_) <- Map.lookup pos board
-		    guard $ idx' `elem` coloured
-		    return idx'
-		mNext = listToMaybe
-		    [ (pos', rotate (h-2) basedir)
-		    | 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 mn)++ns)
+        board = stateBoard st
+        graph = Map.fromList [ (idx, nub $ neighbours idx)
+            | idx <- coloured ]
+        neighbours idx =
+            neighbours' idx (perim idx) []
+        perim :: PieceIdx -> Set (HexPos,HexDir)
+        perim idx =
+            Set.fromList $ nubBy ((==)`on`fst) [ (pos', neg dir)
+                | dir <- hexDirs
+                , pos <- fullFootprint st idx
+                , let pos' = dir +^ pos
+                , Just True /= do
+                    (idx',_) <- Map.lookup pos' board
+                    return $ idx == idx'
+                ]
+        neighbours' :: PieceIdx -> Set (HexPos,HexDir) -> [PieceIdx] -> [PieceIdx]
+        neighbours' idx as ns
+            | Set.null as = ns
+            | otherwise =
+                let a = head $ Set.elems as
+                    (path, ns') = march idx (fst a) a True
+                in neighbours' idx
+                    (Set.filter (\(pos,_) -> pos `notElem` path) as)
+                    (ns++ns')
+        -- |march around the piece's boundary, returning positions visited and
+        -- neighbouring pieces met (in order)
+        march idx startPos (pos,basedir) init
+            | not init && pos == startPos = ([],[])
+            | otherwise =
+            let mn = do
+                    (idx',_) <- Map.lookup pos board
+                    guard $ idx' `elem` coloured
+                    return idx'
+                mNext = listToMaybe
+                    [ (pos', rotate (h-2) basedir)
+                    | 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 mn)++ns)
 
diff --git a/Cache.hs b/Cache.hs
--- a/Cache.hs
+++ b/Cache.hs
@@ -45,31 +45,31 @@
     unless (cOnly || fresh) $ void $ forkIO $ getRecordFromServer fromCache tvar
     return tvar
     where
-	getRecordFromServer fromCache tvar = do
-	    let action = case rec of
-		    RecUserInfo name ->
-			let curVersion = (\(RCUserInfo (v,_)) -> v) <$> fromCache
-			in GetUserInfo name curVersion
-		    _ -> askForRecord rec
-	    resp <- makeRequest saddr (ClientRequest
-		    protocolVersion (if needsAuth action then auth else Nothing) action)
-	    case resp of
-		ServerError err -> tellRec $ FetchedRecord True (Just err) fromCache
-		ServerCodenameFree -> tellRec $ FetchedRecord True Nothing Nothing
-		ServerFresh -> tellRec $ FetchedRecord True Nothing fromCache
-		ServedUserInfoDeltas deltas -> do
-		    let Just (RCUserInfo (v,info)) = fromCache
-		    let rc = RCUserInfo (v+length deltas, applyDeltas info deltas)
-		    withCache saddr $ putRecord rec rc
-		    tellRec $ FetchedRecord True Nothing (Just rc)
-		_ -> do
-		    let rc = rcOfServerResp resp
-		    withCache saddr $ putRecord rec rc
-		    tellRec $ FetchedRecord True Nothing (Just rc)
-	    where
-		tellRec fr = atomically $ do
-		    writeTVar tvar fr
-		    case mflag of {Just flag -> writeTVar flag True; _ -> return ()}
+        getRecordFromServer fromCache tvar = do
+            let action = case rec of
+                    RecUserInfo name ->
+                        let curVersion = (\(RCUserInfo (v,_)) -> v) <$> fromCache
+                        in GetUserInfo name curVersion
+                    _ -> askForRecord rec
+            resp <- makeRequest saddr (ClientRequest
+                    protocolVersion (if needsAuth action then auth else Nothing) action)
+            case resp of
+                ServerError err -> tellRec $ FetchedRecord True (Just err) fromCache
+                ServerCodenameFree -> tellRec $ FetchedRecord True Nothing Nothing
+                ServerFresh -> tellRec $ FetchedRecord True Nothing fromCache
+                ServedUserInfoDeltas deltas -> do
+                    let Just (RCUserInfo (v,info)) = fromCache
+                    let rc = RCUserInfo (v+length deltas, applyDeltas info deltas)
+                    withCache saddr $ putRecord rec rc
+                    tellRec $ FetchedRecord True Nothing (Just rc)
+                _ -> do
+                    let rc = rcOfServerResp resp
+                    withCache saddr $ putRecord rec rc
+                    tellRec $ FetchedRecord True Nothing (Just rc)
+            where
+                tellRec fr = atomically $ do
+                    writeTVar tvar fr
+                    case mflag of {Just flag -> writeTVar flag True; _ -> return ()}
 
 waitFetchedFresh :: TVar FetchedRecord -> IO ()
 waitFetchedFresh tvar = atomically $ readTVar tvar >>= check.fresh
@@ -79,19 +79,19 @@
     return $ ServerError "No server set."
 makeRequest saddr@(ServerAddr host port) request =
     handle (return . ServerError . (show::SomeException -> String)) $
-	withStream (IP host port) makeRequest'
-	    `catchIO` (const $ return $ ServerError $ "Cannot connect to "++saddrStr saddr++"!")
+        withStream (IP host port) makeRequest'
+            `catchIO` (const $ return $ ServerError $ "Cannot connect to "++saddrStr saddr++"!")
     where
-	makeRequest' hdl = do
-	    BS.hPut hdl $ BL.toStrict $ encode request
-	    hFlush hdl
-	    (decode . BL.fromStrict) `liftM` BS.hGetContents hdl
+        makeRequest' hdl = do
+            BS.hPut hdl $ BL.toStrict $ encode request
+            hFlush hdl
+            (decode . BL.fromStrict) `liftM` BS.hGetContents hdl
 
 knownServers :: IO [ServerAddr]
 knownServers = flip catchIO (const $ return []) $ do
     cachedir <- confFilePath "cache"
     saddrstrs <- getDirectoryContents cachedir >>= filterM (\dir ->
-	doesFileExist $ cachedir++[pathSeparator]++dir++[pathSeparator]++"serverInfo")
+        doesFileExist $ cachedir++[pathSeparator]++dir++[pathSeparator]++"serverInfo")
     return $ concat $ map (maybeToList . strToSaddr) saddrstrs
 
 withCache :: ServerAddr -> DBM a -> IO a
diff --git a/Command.hs b/Command.hs
--- a/Command.hs
+++ b/Command.hs
@@ -54,7 +54,7 @@
 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"
+        ++ " " ++ (if dir == 1 then "counter" else "") ++ "clockwise"
 describeCommand CmdWait = "nothing"
 describeCommand CmdToggle = "toggle tool"
 describeCommand CmdOpen = "open lock"
@@ -78,17 +78,17 @@
 describeCommand CmdSetServer = "set server"
 describeCommand CmdToggleCacheOnly = "toggle offline mode"
 describeCommand (CmdSelCodename mname) = "select player"
-	++ maybe "" (' ':) mname
+        ++ maybe "" (' ':) mname
 describeCommand CmdBackCodename = "select last player"
 describeCommand CmdHome = "select self"
 describeCommand (CmdSolve mli) = "solve lock"
-	++ maybe "" ((' ':).(:"").lockIndexChar) mli
+        ++ maybe "" ((' ':).(:"").lockIndexChar) mli
 describeCommand (CmdPlayLockSpec mls) = "find lock by number"
-	++ maybe "" ((' ':).show) mls
+        ++ maybe "" ((' ':).show) mls
 describeCommand (CmdDeclare mundecl) = "declare solution"
-	++ maybe "" (\_->" [specified solution]") mundecl
+        ++ maybe "" (\_->" [specified solution]") mundecl
 describeCommand (CmdViewSolution mnote) = "view lock solution"
-	++ maybe "" (\_->" [specified solution]") mnote
+        ++ maybe "" (\_->" [specified solution]") mnote
 describeCommand CmdSelectLock = "choose lock by name"
 describeCommand CmdNextLock = "next lock"
 describeCommand CmdPrevLock = "previous lock"
@@ -96,7 +96,7 @@
 describeCommand CmdPrevPage = "page back through lists"
 describeCommand CmdEdit = "edit lock"
 describeCommand (CmdPlaceLock mli) = "place lock"
-	++ maybe "" ((' ':).(:"").lockIndexChar) mli
+        ++ maybe "" ((' ':).(:"").lockIndexChar) mli
 describeCommand (CmdRegister False) = "register codename"
 describeCommand (CmdRegister True) = "adjust registration details"
 describeCommand CmdAuth = "authenticate"
diff --git a/CursesRender.hs b/CursesRender.hs
--- a/CursesRender.hs
+++ b/CursesRender.hs
@@ -28,17 +28,17 @@
 colorsToPairs cs = do
     p <- Curses.colorPairs
     let nColors = length cs
-	blackWhite = p < nColors
+        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
+        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
+            let p = Curses.Pair n
+            Curses.initPair p fg bg
+            return p
 
 type AttrChar = (Char, Curses.Attr)
 type ColPair = Int
@@ -63,11 +63,11 @@
     | 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
+        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)
@@ -82,10 +82,10 @@
     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
-		    Just n -> n+1
-	rev = owner `elem` reversed
+        pair = case Map.lookup owner colouring of
+                    Nothing -> 0
+                    Just n -> n+1
+        rev = owner `elem` reversed
     in Glyph ch pair (Curses.setReverse attr rev)
 
 addCh :: Char ->  IO ()
diff --git a/CursesUI.hs b/CursesUI.hs
--- a/CursesUI.hs
+++ b/CursesUI.hs
@@ -67,7 +67,7 @@
 bindingsStr mode cmds = do
     bdgs <- getBindings mode
     return $ (("["++).(++"]")) $ intercalate "," $
-	map (maybe "" showKey . findBinding bdgs) cmds
+        map (maybe "" showKey . findBinding bdgs) cmds
 
 
 data Gravity = GravUp | GravLeft | GravRight | GravDown | GravCentre
@@ -266,17 +266,17 @@
     let colouring = boardColouring st (colouredPieces colourFixed st) lastCol
     mono <- gets monochrome
     sequence_ [ drawAtWithGeom glyph pos geom |
-	(pos,glyph) <- Map.toList $ fmap (ownedTileGlyph mono colouring reversed) $ stateBoard st
-	]
+        (pos,glyph) <- Map.toList $ fmap (ownedTileGlyph mono colouring reversed) $ stateBoard st
+        ]
     return colouring
 
 drawMsgLine = void.runMaybeT $ do
     (attr,col,str) <- MaybeT $ gets message
     lift $ do
-	(h,w) <- liftIO Curses.scrSize
-	liftIO $ clearLine $ h-1
-	let str' = take (w-1) str
-	drawStr attr col (CVec (h-1) 0) str'
+        (h,w) <- liftIO Curses.scrSize
+        liftIO $ clearLine $ h-1
+        let str' = take (w-1) str
+        drawStr attr col (CVec (h-1) 0) str'
 setMsgLine attr col str = do
     modify $ \s -> s { message = Just (attr,col,str) }
     drawMsgLine
diff --git a/CursesUIMInstance.hs b/CursesUIMInstance.hs
--- a/CursesUIMInstance.hs
+++ b/CursesUIMInstance.hs
@@ -54,23 +54,23 @@
     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,magenta)
-	    Just (-2) -> (a0,red)
-	    Just (-3) -> (bold,red)
-	    _ -> if ourName == Just name then (bold,white) else (a0,white)
+            Just 0 -> (a0,yellow)
+            Just 1 -> (bold,cyan)
+            Just 2 -> (a0,green)
+            Just 3 -> (bold,green)
+            Just (-1) -> (bold,magenta)
+            Just (-2) -> (a0,red)
+            Just (-3) -> (bold,red)
+            _ -> if ourName == Just name then (bold,white) else (a0,white)
     lift $ drawStrCentred attr col pos
-	(name ++ if showScore then " " ++ maybe "" show relScore else "")
+        (name ++ if showScore then " " ++ maybe "" show relScore else "")
 
 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)
+        (if accessed then green else white)
+        (lockIndexChar i)
 
 drawNameWithChar :: CVec -> Codename -> ColPair -> Char -> MainStateT UIM ()
 drawNameWithChar pos name charcol char = do
@@ -89,26 +89,26 @@
 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)
-	cv = (b+t)`div`2
-	ch = (l+r)`div`2
-	gravCentre = case grav of
-	    GravDown   -> CVec b ch
-	    GravUp     -> CVec t ch
-	    GravLeft   -> CVec cv l
-	    GravRight  -> CVec cv r
-	    GravCentre -> CVec cv ch
-	locs = sortBy (compare `on` dist) $ concat
-	    [ map (CVec j) [ l+margin + (width+1)*i | i <- [0..(r-l-(2*margin))`div`(width+1)] ]
-	    | j <- [t..b]
-	    , let margin = if (j-starty)`mod`2 == 0 then half else width ]
-	dist v = sqlen $ v -^ gravCentre
-	sqlen (CVec y x) = (y*(width+1))^2+x^2
+        starty = (if grav == GravDown then b else t)
+        cv = (b+t)`div`2
+        ch = (l+r)`div`2
+        gravCentre = case grav of
+            GravDown   -> CVec b ch
+            GravUp     -> CVec t ch
+            GravLeft   -> CVec cv l
+            GravRight  -> CVec cv r
+            GravCentre -> CVec cv ch
+        locs = sortBy (compare `on` dist) $ concat
+            [ map (CVec j) [ l+margin + (width+1)*i | i <- [0..(r-l-(2*margin))`div`(width+1)] ]
+            | j <- [t..b]
+            , let margin = if (j-starty)`mod`2 == 0 then half else width ]
+        dist v = sqlen $ v -^ gravCentre
+        sqlen (CVec y x) = (y*(width+1))^2+x^2
     selDraws <- do
-	    offset <- gets listOffset
-	    let na = length locs
-		nd = length draws
-	    return $ drop (max 0 $ min (nd - na) (na*offset)) $ draws
+            offset <- gets listOffset
+            let na = length locs
+                nd = length draws
+            return $ drop (max 0 $ min (nd - na) (na*offset)) $ draws
     let zipped = zip locs selDraws
     sequence_ $ map (uncurry ($)) $ zip selDraws locs
     return $ (if grav==GravDown then (minimum.(b:)) else (maximum.(t:))) [ y | (CVec y x,_) <- zipped ]
@@ -121,29 +121,29 @@
     ourName <- (authUser <$>) <$> gets curAuth
 
     (lockTop, lockBottom) <- (fromJust<$>)$ runMaybeT $ msum
-	[ do
-	    lock <- mgetLock $ lockSpec lockinfo
-	    let size = frameSize $ fst lock
-	    guard $ bottom - top >= 5 + 2*size+1 + 1 + 5 && right-left >= 4*size+1
-	    lift.lift $ drawStateWithGeom [] False Map.empty (snd lock) (CVec hcentre vcentre,origin)
-	    return (hcentre - size - 1, hcentre + size + 1)
-	, lift $ do
-	    drawActiveLock (CVec hcentre vcentre) al
-	    return (hcentre - 1, hcentre + 1)
-	]
+        [ do
+            lock <- mgetLock $ lockSpec lockinfo
+            let size = frameSize $ fst lock
+            guard $ bottom - top >= 5 + 2*size+1 + 1 + 5 && right-left >= 4*size+1
+            lift.lift $ drawStateWithGeom [] False Map.empty (snd lock) (CVec hcentre vcentre,origin)
+            return (hcentre - size - 1, hcentre + size + 1)
+        , lift $ do
+            drawActiveLock (CVec hcentre vcentre) al
+            return (hcentre - 1, hcentre + 1)
+        ]
 
     startOn <-
-	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)) 5 GravDown $
+        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)) 5 GravDown $
         [ \pos -> drawNote pos note | note <- lockSolutions lockinfo ] ++
         [ \pos -> drawName False pos name
-		    | name <- accessedBy lockinfo \\ map noteAuthor (lockSolutions lockinfo) ]
+                    | name <- accessedBy lockinfo \\ map noteAuthor (lockSolutions lockinfo) ]
     lift $ drawStrCentred a0 white (CVec (startOn-1) vcentre) "Accessed by:"
 
     undecls <- gets undeclareds
@@ -152,21 +152,21 @@
     else if any (\(Undeclared _ ls _) -> ls == lockSpec lockinfo) undecls
     then lift $ drawStrCentred a0 yellow (CVec (lockBottom+1) vcentre) "Undeclared solution!"
     else do
-	read <- take 3 <$> getNotesReadOn lockinfo
-	unless (null read || ourName == Just name) $ do
-	    let rntext = if right-left > 30 then "Read notes by:" else "Notes:"
-		s = vcentre - (length rntext+(3+1)*3)`div`2
-	    lift $ drawStr a0 white (CVec (lockBottom+1) s) rntext
-	    void $ fillBox (CVec (lockBottom+1) (s+length rntext+1)) (CVec (lockBottom+1) right) 3 GravLeft
-		[ \pos -> drawName False pos name | name <- map noteAuthor read ]
+        read <- take 3 <$> getNotesReadOn lockinfo
+        unless (null read || ourName == Just name) $ do
+            let rntext = if right-left > 30 then "Read notes by:" else "Notes:"
+                s = vcentre - (length rntext+(3+1)*3)`div`2
+            lift $ drawStr a0 white (CVec (lockBottom+1) s) rntext
+            void $ fillBox (CVec (lockBottom+1) (s+length rntext+1)) (CVec (lockBottom+1) right) 3 GravLeft
+                [ \pos -> drawName False pos name | name <- map noteAuthor read ]
 
     lift $ drawStrCentred a0 white (CVec (lockBottom+2) vcentre) "Notes held:"
     if null $ notesSecured lockinfo
-	then lift $
-	    drawStrCentred a0 white (CVec (lockBottom+3) vcentre) "None"
-	else
-	    void $ fillBox (CVec (lockBottom+3) (left+1)) (CVec bottom (right-1)) 5 GravUp
-		[ (`drawActiveLock` al) | al <- map noteOn $ notesSecured lockinfo ]
+        then lift $
+            drawStrCentred a0 white (CVec (lockBottom+3) vcentre) "None"
+        else
+            void $ fillBox (CVec (lockBottom+3) (left+1)) (CVec bottom (right-1)) 5 GravUp
+                [ (`drawActiveLock` al) | al <- map noteOn $ notesSecured lockinfo ]
 
 
 data HelpReturn = HelpNone | HelpDone | HelpContinue Int
@@ -272,46 +272,46 @@
     runUI m = evalStateT m nullUIState
 
     drawMainState = do
-	lift erase
-	s <- get
-	lift . drawTitle =<< getTitle
-	lift drawMsgLine
-	drawMainState' s
-	lift refresh
-	where
-	drawMainState' (PlayState { psCurrentState=st, psLastAlerts=alerts,
+        lift erase
+        s <- get
+        lift . drawTitle =<< getTitle
+        lift drawMsgLine
+        drawMainState' s
+        lift refresh
+        where
+        drawMainState' (PlayState { psCurrentState=st, psLastAlerts=alerts,
                 wrenchSelected=wsel, psFrame=frame }) = lift $ do
-	    drawState [] False alerts st
+            drawState [] False alerts st
             drawBindingsTables IMPlay frame
-	    drawCursorAt $ listToMaybe [ pos |
-		(_, PlacedPiece pos p) <- enumVec $ placedPieces st
-		, or [wsel && isWrench p, not wsel && isHook p] ]
-	drawMainState' (ReplayState {}) = do
-	    lift . drawState [] False [] =<< gets rsCurrentState
-	    lift $ drawCursorAt Nothing
-	drawMainState' (EditState { esGameStateStack=(st:_), selectedPiece=selPiece,
+            drawCursorAt $ listToMaybe [ pos |
+                (_, PlacedPiece pos p) <- enumVec $ placedPieces st
+                , or [wsel && isWrench p, not wsel && isHook p] ]
+        drawMainState' (ReplayState {}) = do
+            lift . drawState [] False [] =<< gets rsCurrentState
+            lift $ drawCursorAt Nothing
+        drawMainState' (EditState { esGameStateStack=(st:_), selectedPiece=selPiece,
                 selectedPos=selPos, esFrame=frame }) = lift $ do
-	    drawState (maybeToList selPiece) True [] st
+            drawState (maybeToList selPiece) True [] st
             drawBindingsTables IMEdit frame
-	    drawCursorAt $ if isNothing selPiece then Just selPos else Nothing
-	drawMainState' (MetaState {curServer=saddr, undeclareds=undecls,
-		cacheOnly=cOnly, curAuth=auth, codenameStack=names,
-		randomCodenames=rnamestvar, retiredLocks=mretired, curLockPath=path,
-		curLock=lock}) = do
-	    let ourName = liftM authUser auth
-	    let selName = listToMaybe names
-	    let home = isJust ourName && ourName == selName
-	    (h,w) <- liftIO Curses.scrSize
-	    when (h<20 || w<40) $ liftIO CursesH.end >> error "Terminal too small!"
+            drawCursorAt $ if isNothing selPiece then Just selPos else Nothing
+        drawMainState' (MetaState {curServer=saddr, undeclareds=undecls,
+                cacheOnly=cOnly, curAuth=auth, codenameStack=names,
+                randomCodenames=rnamestvar, retiredLocks=mretired, curLockPath=path,
+                curLock=lock}) = do
+            let ourName = liftM authUser auth
+            let selName = listToMaybe names
+            let home = isJust ourName && ourName == selName
+            (h,w) <- liftIO Curses.scrSize
+            when (h<20 || w<40) $ liftIO CursesH.end >> error "Terminal too small!"
             bdgs <- lift $ getBindings IMMeta
-	    lift $ do
-		drawCursorAt Nothing
-		let serverBdgsDraw = bindingsDraw bdgs
+            lift $ do
+                drawCursorAt Nothing
+                let serverBdgsDraw = bindingsDraw bdgs
                         [CmdSetServer, CmdToggleCacheOnly]
                     lockBdgsDraw = bindingsDraw bdgs $
                         [CmdEdit] ++ if path == "" then [] else [CmdPlaceLock Nothing]
                     leftBdgsWidth = (+3) . maximum $ map drawWidth [serverBdgsDraw, lockBdgsDraw]
-		    helpDraw = bindingsDraw bdgs [CmdTutorials] <> greyDraw " tutorial  " <>
+                    helpDraw = bindingsDraw bdgs [CmdTutorials] <> greyDraw " tutorial  " <>
                         bindingsDraw bdgs [CmdHelp] <> greyDraw " help"
                     serverTextDraw = greyDraw . take (w - leftBdgsWidth - drawWidth helpDraw - 1) $
                         " Server: " ++ saddrStr saddr ++ (if cOnly then "  (offline mode) " else "")
@@ -319,46 +319,46 @@
                         [CmdSelectLock] ++ if path == "" then [] else [CmdNextLock, CmdPrevLock]
                     lockTextDraw = greyDraw . take (w - leftBdgsWidth - drawWidth lockBdgsDraw' - 1) $
                         " Lock: " ++ path ++ replicate 5 ' '
-		doDrawAt (CVec 0 0) $ alignDraw GravLeft leftBdgsWidth serverBdgsDraw <> serverTextDraw
+                doDrawAt (CVec 0 0) $ alignDraw GravLeft leftBdgsWidth serverBdgsDraw <> serverTextDraw
                 doDrawAt (CVec 0 0) $ alignDraw GravRight w helpDraw
-		doDrawAt (CVec 1 0) $ alignDraw GravLeft leftBdgsWidth lockBdgsDraw <> lockTextDraw <> lockBdgsDraw'
+                doDrawAt (CVec 1 0) $ alignDraw GravLeft leftBdgsWidth lockBdgsDraw <> lockTextDraw <> lockBdgsDraw'
 
                 doDrawAt (CVec 2 $ maximum [w`div`3+1, w`div`2 - 13]) $ bindingsDraw bdgs [CmdSelCodename Nothing]
 
-	    maybe (return ()) (drawName True (CVec 2 (w`div`2))) selName
-	    void.runMaybeT $ MaybeT (return selName) >>= lift . getUInfoFetched 300 >>=
-		\(FetchedRecord fresh err muirc) -> lift $ do
-		    lift $ do
-			unless fresh $ drawAtCVec (Glyph '*' red bold) $ CVec 2 (w`div`2+7)
-			maybe (return ()) sayError err
-			when (fresh && (isNothing ourName || home || isNothing muirc)) $
-			    doDrawAt (CVec 2 (w`div`2+1+9)) $
-				bindingsDraw bdgs $
-				    if (isNothing muirc && isNothing ourName) || home
+            maybe (return ()) (drawName True (CVec 2 (w`div`2))) selName
+            void.runMaybeT $ MaybeT (return selName) >>= lift . getUInfoFetched 300 >>=
+                \(FetchedRecord fresh err muirc) -> lift $ do
+                    lift $ do
+                        unless fresh $ drawAtCVec (Glyph '*' red bold) $ CVec 2 (w`div`2+7)
+                        maybe (return ()) sayError err
+                        when (fresh && (isNothing ourName || home || isNothing muirc)) $
+                            doDrawAt (CVec 2 (w`div`2+1+9)) $
+                                bindingsDraw bdgs $
+                                    if (isNothing muirc && isNothing ourName) || home
                                     then [CmdRegister $ isJust ourName] else [CmdAuth]
-		    for_ muirc $ \(RCUserInfo (_,uinfo)) -> case mretired of
-			Just retired -> do
-			    (h,w) <- liftIO Curses.scrSize
-			    void $ fillBox (CVec 6 2) (CVec (h-1) (w-2)) 5 GravCentre
-				[ \pos -> lift $ drawStrGrey pos $ show ls | ls <- retired ]
-			    lift $ doDrawAt (CVec 5 (w`div`3)) $ bindingsDraw bdgs $
-				[CmdShowRetired] ++ if null retired
+                    for_ muirc $ \(RCUserInfo (_,uinfo)) -> case mretired of
+                        Just retired -> do
+                            (h,w) <- liftIO Curses.scrSize
+                            void $ fillBox (CVec 6 2) (CVec (h-1) (w-2)) 5 GravCentre
+                                [ \pos -> lift $ drawStrGrey pos $ show ls | ls <- retired ]
+                            lift $ doDrawAt (CVec 5 (w`div`3)) $ bindingsDraw bdgs $
+                                [CmdShowRetired] ++ if null retired
                                 then [] else [CmdPlayLockSpec Nothing]
-			Nothing -> do
-			    sequence_ [ drawLockInfo (ActiveLock (codename uinfo) i) lockinfo |
-				(i,Just lockinfo) <- assocs $ userLocks uinfo ]
-			    unless (null $ elems $ userLocks uinfo) $ lift $
-				doDrawAt (CVec 5 (w`div`3)) $ bindingsDraw bdgs $
+                        Nothing -> do
+                            sequence_ [ drawLockInfo (ActiveLock (codename uinfo) i) lockinfo |
+                                (i,Just lockinfo) <- assocs $ userLocks uinfo ]
+                            unless (null $ elems $ userLocks uinfo) $ lift $
+                                doDrawAt (CVec 5 (w`div`3)) $ bindingsDraw bdgs $
                                 [CmdSolve Nothing] ++ if isJust ourName then [CmdViewSolution Nothing] else []
-	    when (isJust ourName && ourName == selName) $ do
-		rnames <- liftIO $ atomically $ readTVar rnamestvar
-		unless (null rnames) $
-		    void $ fillBox (CVec 2 0) (CVec 5 (w`div`3)) 3 GravCentre
-			[ \pos -> drawName False pos name | name <- rnames ]
-		unless (null undecls) $
+            when (isJust ourName && ourName == selName) $ do
+                rnames <- liftIO $ atomically $ readTVar rnamestvar
+                unless (null rnames) $
+                    void $ fillBox (CVec 2 0) (CVec 5 (w`div`3)) 3 GravCentre
+                        [ \pos -> drawName False pos name | name <- rnames ]
+                unless (null undecls) $
                     let declareBdgDraw = bindingsDraw bdgs [CmdDeclare Nothing]
                         declareText = " Undeclared solutions:"
-		        y = 4
+                        y = 4
                         leftBound = w`div`3 + 1
                         undeclsWidth = 1 + 6 * length undecls
                         declareDraw =
@@ -374,33 +374,33 @@
                             (CVec y (w-1)) 5 GravLeft
                             [ (`drawActiveLock` al) | Undeclared _ _ al <- undecls ]
 
-	    when (ourName /= selName) $ void $ runMaybeT $ do
-		sel <- liftMaybe selName
-		us <- liftMaybe ourName
-		ourUInfo <- mgetUInfo us
-		let accessed = [ ActiveLock us i
-			| i<-[0..2]
-			, Just lock <- [ userLocks ourUInfo ! i ]
-			, public lock || selName `elem` map Just (accessedBy lock) ]
-		guard $ not $ null accessed
-		let str = "has accessed:"
-		let s = (w-(4 + length str + 6*(length accessed)))`div`2
-		let y = 4
-		lift $ do
-		    drawName False (CVec y (s+1)) sel
-		    lift $ drawStrGrey (CVec y $ s+4) str
-		    void $ fillBox (CVec y (s+4+length str+1)) (CVec y (w-1)) 5 GravLeft $
-			[ (`drawActiveLock` al) | al <- accessed]
+            when (ourName /= selName) $ void $ runMaybeT $ do
+                sel <- liftMaybe selName
+                us <- liftMaybe ourName
+                ourUInfo <- mgetUInfo us
+                let accessed = [ ActiveLock us i
+                        | i<-[0..2]
+                        , Just lock <- [ userLocks ourUInfo ! i ]
+                        , public lock || selName `elem` map Just (accessedBy lock) ]
+                guard $ not $ null accessed
+                let str = "has accessed:"
+                let s = (w-(4 + length str + 6*(length accessed)))`div`2
+                let y = 4
+                lift $ do
+                    drawName False (CVec y (s+1)) sel
+                    lift $ drawStrGrey (CVec y $ s+4) str
+                    void $ fillBox (CVec y (s+4+length str+1)) (CVec y (w-1)) 5 GravLeft $
+                        [ (`drawActiveLock` al) | al <- accessed]
 
     reportAlerts _ alerts =
-	do mapM_ drawAlert alerts
-	   unless (null alerts)
-	    $ do refresh
-		 liftIO $ threadDelay $ 5*10^4
-	where
-	    drawAlert (AlertCollision pos) = drawAt cGlyph pos
-	    drawAlert _ = return ()
-	    cGlyph = Glyph '!' 0 a0
+        do mapM_ drawAlert alerts
+           unless (null alerts)
+            $ do refresh
+                 liftIO $ threadDelay $ 5*10^4
+        where
+            drawAlert (AlertCollision pos) = drawAt cGlyph pos
+            drawAlert _ = return ()
+            cGlyph = Glyph '!' 0 a0
 
     drawMessage = say
     drawPrompt full s = say s >> (liftIO $ void $ Curses.cursSet Curses.CursorVisible)
@@ -411,34 +411,34 @@
 
     getChRaw = (charify<$>) $ liftIO $ CursesH.getKey (return ()) >>= handleEsc
     setUIBinding mode cmd ch =
-	modify $ \s -> s { uiKeyBindings =
-		Map.insertWith (\[bdg] -> \bdgs -> if bdg `elem` bdgs then delete bdg bdgs else bdg:bdgs)
-		    mode [(ch,cmd)] $ uiKeyBindings s }
+        modify $ \s -> s { uiKeyBindings =
+                Map.insertWith (\[bdg] -> \bdgs -> if bdg `elem` bdgs then delete bdg bdgs else bdg:bdgs)
+                    mode [(ch,cmd)] $ uiKeyBindings s }
     getUIBinding mode cmd = do
-	bdgs <- getBindings mode
-	return $ maybe "" showKey $ findBinding bdgs cmd
+        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
+        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
-	liftIO CursesH.end
+        writeBindings
+        liftIO CursesH.end
     unblockInput = return $ Curses.ungetCh 0
     suspend = do
-	liftIO $ do
-	    CursesH.suspend
-	    Curses.resetParams
-	redraw
+        liftIO $ do
+            CursesH.suspend
+            Curses.resetParams
+        redraw
     redraw = liftIO $ do
-	Curses.endWin
-	Curses.refresh
+        Curses.endWin
+        Curses.refresh
 
     warpPointer _ = return ()
     getUIMousePos = return Nothing
@@ -449,24 +449,24 @@
     toggleColourMode = modify $ \s -> s {monochrome = not $ monochrome s}
 
     impatience ticks = do
-	when (ticks>20) $ say "Waiting for server (^C to abort)..."
-	unblock <- unblockInput
-	liftIO $ forkIO $ threadDelay 50000 >> unblock
-	cmds <- getInput IMImpatience
-	return $ CmdQuit `elem` cmds
+        when (ticks>20) $ say "Waiting for server (^C to abort)..."
+        unblock <- unblockInput
+        liftIO $ forkIO $ threadDelay 50000 >> unblock
+        cmds <- getInput IMImpatience
+        return $ CmdQuit `elem` cmds
 
     getInput mode = do
-	let userResizeCode = 1337  -- XXX: chosen not to conflict with HSCurses codes
-	key <- liftIO $ CursesH.getKey (Curses.ungetCh userResizeCode) >>=
+        let userResizeCode = 1337  -- XXX: chosen not to conflict with HSCurses codes
+        key <- liftIO $ CursesH.getKey (Curses.ungetCh userResizeCode) >>=
             handleEsc
-	if key == Curses.KeyUnknown userResizeCode
-	    then do
-		liftIO Curses.scrSize
-		return [CmdRedraw]
-	    else do
-		let mch = charify key
-		    unblockBinding = (toEnum 0, CmdRefresh) -- c.f. unblockInput above
-		flip (maybe $ return []) mch $ \ch ->
-		    if mode == IMTextInput
-		    then return $ [ CmdInputChar ch `fromMaybe` lookup ch [unblockBinding] ]
-		    else (maybeToList . lookup ch . (unblockBinding:)) <$> getBindings mode
+        if key == Curses.KeyUnknown userResizeCode
+            then do
+                liftIO Curses.scrSize
+                return [CmdRedraw]
+            else do
+                let mch = charify key
+                    unblockBinding = (toEnum 0, CmdRefresh) -- c.f. unblockInput above
+                flip (maybe $ return []) mch $ \ch ->
+                    if mode == IMTextInput
+                    then return $ [ CmdInputChar ch `fromMaybe` lookup ch [unblockBinding] ]
+                    else (maybeToList . lookup ch . (unblockBinding:)) <$> getBindings mode
diff --git a/Database.hs b/Database.hs
--- a/Database.hs
+++ b/Database.hs
@@ -12,6 +12,7 @@
 
 import Data.Maybe
 import Data.Tuple (swap)
+import Data.Char (toUpper)
 import Control.Applicative
 import Control.Monad
 import System.IO
@@ -99,8 +100,8 @@
 getRecord rec = do
     path <- recordPath rec
     liftIO $ flip catchIO (const $ return Nothing) $ do
-	h <- openFile path ReadMode
-	getRecordh rec h <* hClose h
+        h <- openFile path ReadMode
+        getRecordh rec h <* hClose h
 getRecordh (RecPassword _) h = ((RCPassword <$>) . tryRead) <$> hGetStrict h
 getRecordh (RecEmail _) h = ((RCEmail <$>) . tryRead) <$> hGetStrict h
 getRecordh (RecUserInfo _) h = ((RCUserInfo <$>) . tryRead) <$> hGetStrict h
@@ -116,19 +117,19 @@
 
 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`) <$> concatMWhileNonempty ms
+            bs <- m
+            if CS.null bs
+                then return bs
+                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
-	putRecordh rc h
-	hClose h
+        mkdirhierto path
+        h <- openFile path WriteMode
+        putRecordh rc h
+        hClose h
 putRecordh (RCPassword hpw) h = hPutStr h $ show hpw
 putRecordh (RCEmail addr) h = hPutStr h $ show addr
 putRecordh (RCUserInfo info) h = hPutStr h $ show info
@@ -145,11 +146,11 @@
 modifyRecord rec f = do
     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
-	hClose h
+        Just rc <- getRecordh rec h
+        hSeek h AbsoluteSeek 0
+        putRecordh (f rc) h
+        hTell h >>= hSetFileSize h
+        hClose h
 
 delRecord :: Record -> DBM ()
 delRecord rec = recordPath rec >>= liftIO . removeFile
@@ -171,39 +172,47 @@
 listUsers = do
     dbpath <- ask
     liftIO $ (map unpathifyName . filter ((==3).length)) <$>
-	getDirectoryContents (dbpath++[pathSeparator]++"users")
+        getDirectoryContents (dbpath++[pathSeparator]++"users")
 
 recordPath :: Record -> DBM FilePath
 recordPath rec =
     (++ ([pathSeparator] ++ recordPath' rec)) <$> ask
     where
-	recordPath' (RecPassword name) = userDir name ++ "passwd"
-	recordPath' (RecEmail name) = userDir name ++ "email"
-	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' (RecRetiredLocks name) = userDir name ++ "retired"
-	recordPath' RecLockHashes = "lockHashes"
-	recordPath' RecServerInfo = "serverInfo"
-	recordPath' RecServerEmail = "serverEmail"
-	recordPath' RecPublicKey = "publicKey"
-	recordPath' RecSecretKey = "secretKey"
+        recordPath' (RecPassword name) = userDir name ++ "passwd"
+        recordPath' (RecEmail name) = userDir name ++ "email"
+        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' (RecRetiredLocks name) = userDir name ++ "retired"
+        recordPath' RecLockHashes = "lockHashes"
+        recordPath' RecServerInfo = "serverInfo"
+        recordPath' RecServerEmail = "serverEmail"
+        recordPath' RecPublicKey = "publicKey"
+        recordPath' RecSecretKey = "secretKey"
 
-	userDir name = "users" ++ [pathSeparator] ++ pathifyName name ++ [pathSeparator]
-	alockFN (ActiveLock name idx) = pathifyName name ++":"++ show idx
-	locksDir = "locks"++[pathSeparator]
+        userDir name = "users" ++ [pathSeparator] ++ pathifyName name ++ [pathSeparator]
+        alockFN (ActiveLock name idx) = pathifyName name ++":"++ show idx
+        locksDir = "locks"++[pathSeparator]
 
--- Dummy out characters which are disallowed on unix or dos.
+pathifyName = winSux . dummyPunctuation
+
+-- | Hilariously, "CON", "PRN", "AUX", and "NUL" are reserved on DOS, and
+-- Windows apparently crashes rather than write a directory with that name!
+winSux name = if map toUpper name `elem` ["CON","PRN", "AUX","NUL"]
+    then '_':name
+    else name
+
+-- | 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 ->
+dummyPunctuation = concatMap $ \c ->
     fromMaybe [c] (('_':) . pure <$> lookup c pathifyAssocs)
 unpathifyName = concatMap $ \c -> case c of
-	'_' -> ""
-	_ -> pure $ fromMaybe c (lookup c $ map swap pathifyAssocs)
+        '_' -> ""
+        _ -> pure $ fromMaybe c (lookup c $ map swap pathifyAssocs)
 pathifyAssocs =
     [ ('/','s')
     , ('.','d')
diff --git a/EditGameState.hs b/EditGameState.hs
--- a/EditGameState.hs
+++ b/EditGameState.hs
@@ -26,103 +26,103 @@
 modTile :: Maybe Tile -> HexPos -> HexPos -> Bool -> GameState -> GameState
 modTile tile pos lastPos painting st =
     let board = stateBoard st
-	curOwnedTile = Map.lookup pos board
-	(st',mowner) = case curOwnedTile of
-	    Nothing -> (st,Nothing)
-	    Just (owner,SpringTile _ _) -> (delConnectionsIn pos st, Just owner)
-	    Just (owner,_) -> delPiecePos owner pos st -- XXX may invalidate board's indices to st
-	board' = stateBoard st'
-	addPiece p = addpp $ PlacedPiece pos p
-	lastMOwner = do
-	    (o,_) <- Map.lookup lastPos board
-	    return o
-	{-
-	same = isJust $ do
-		t <- tile
-		(_,t') <- curOwnedTile
-		guard $ ((==) `on` tileType) t t'
-		return $ Just ()
-	-}
-	lastElem os = isJust $ do
-	       lastOwner <- lastMOwner
-	       guard $ lastOwner `elem` os
-	lastWasDiff = isNothing $ do
-	       lastOwner <- lastMOwner
-	       owner <- mowner
-	       guard $ owner == lastOwner
-	lastOK = painting || lastWasDiff
-	validSpringRootTile ot = case snd ot of
-	    BlockTile _ -> True
-	    PivotTile _ -> True
-	    _ -> False
-	-- |Find next adjacent, skipping over current entity.
-	nextOfAdjacents adjs loop = listToMaybe $ fromMaybe adjs $ do
-		owner <- mowner
-		i <- elemIndex owner adjs
-		return $ (dropWhile (== owner) $ drop i adjs) ++
-		    if loop && i > 0 then adjs else []
+        curOwnedTile = Map.lookup pos board
+        (st',mowner) = case curOwnedTile of
+            Nothing -> (st,Nothing)
+            Just (owner,SpringTile _ _) -> (delConnectionsIn pos st, Just owner)
+            Just (owner,_) -> delPiecePos owner pos st -- XXX may invalidate board's indices to st
+        board' = stateBoard st'
+        addPiece p = addpp $ PlacedPiece pos p
+        lastMOwner = do
+            (o,_) <- Map.lookup lastPos board
+            return o
+        {-
+        same = isJust $ do
+                t <- tile
+                (_,t') <- curOwnedTile
+                guard $ ((==) `on` tileType) t t'
+                return $ Just ()
+        -}
+        lastElem os = isJust $ do
+               lastOwner <- lastMOwner
+               guard $ lastOwner `elem` os
+        lastWasDiff = isNothing $ do
+               lastOwner <- lastMOwner
+               owner <- mowner
+               guard $ owner == lastOwner
+        lastOK = painting || lastWasDiff
+        validSpringRootTile ot = case snd ot of
+            BlockTile _ -> True
+            PivotTile _ -> True
+            _ -> False
+        -- |Find next adjacent, skipping over current entity.
+        nextOfAdjacents adjs loop = listToMaybe $ fromMaybe adjs $ do
+                owner <- mowner
+                i <- elemIndex owner adjs
+                return $ (dropWhile (== owner) $ drop i adjs) ++
+                    if loop && i > 0 then adjs else []
     in case mowner of
-	 Just o | protectedPiece o -> st
-	 _ -> (case tile of
-	   -- _ | same && (pos /= lastPos) -> id
-	   Just (BlockTile _) ->
-	       let adjacentBlocks = nub [ idx |
-		       dir <- hexDirs
-		       , Just (idx, BlockTile _) <- [Map.lookup (dir +^ pos) board']
-		       , not $ protectedPiece idx ]
-		   addToIdx = if lastOK && lastElem adjacentBlocks
-		       then lastMOwner
-		       else nextOfAdjacents adjacentBlocks False
-	       in case addToIdx of
-		  Nothing -> addPiece $ Block [zero]
-		  Just b -> addBlockPos b pos
-	   Just (ArmTile armdir _) ->
-	       let adjacentPivots = [ idx |
-		       dir <- if armdir == zero then hexDirs else [armdir, neg armdir]
-		       , Just (idx, PivotTile _) <- [Map.lookup (dir +^ pos) board'] ]
-		   addToIdx = if lastOK && lastElem adjacentPivots
-		       then lastMOwner
-		       else nextOfAdjacents adjacentPivots True
-	       in case addToIdx of
-		      Nothing -> id
-		      Just p -> addPivotArm p pos
-	   Just (SpringTile _ _) ->
-	       let possibleSprings = [ Connection root end $ Spring sdir natLen |
-		       sdir <- hexDirs
-		       , let epos = sdir +^ pos
-		       , Just (eidx, BlockTile _) <- [Map.lookup epos board']
-		       , not $ protectedPiece eidx
-		       , (ridx, rpos) <- maybeToList $ castRay (neg sdir +^ pos) (neg sdir) board'
-		       , Just True == (validSpringRootTile `liftM` Map.lookup rpos board')
-		       , let natLen = hexLen (rpos -^ epos) - 1
-		       , natLen > 0
-		       {-
-		       , null [ conn |
-			   conn@(Connection _ _ (Spring sdir' _)) <-
-			       springsAtIdx st' eidx ++ springsEndAtIdx st' ridx
-			   , not $ sdir' `elem` [sdir,neg sdir] ]
-		       -}
-		       , not $ connGraphPathExists st' eidx ridx
-		       , let end = (eidx, epos -^ (placedPos $ getpp st' eidx))
-		       , let root = (ridx, rpos -^ (placedPos $ getpp st' ridx))
-		       ]
-		   nextSpring = listToMaybe $ fromMaybe possibleSprings $ do
-		       (_,SpringTile _ _) <- curOwnedTile -- XXX: therefore the indices of st are still valid
-		       i <- findIndex (`elem` connections st) possibleSprings
-		       return $ drop (i+1) possibleSprings
-	       in case nextSpring of
-		      Nothing -> id
-		      Just conn -> addConn conn
-	   Just (PivotTile _) -> addPiece $ Pivot []
-	   Just (WrenchTile _) -> addPiece $ Wrench zero
-	   Just HookTile -> let arm = listToMaybe [ dir |
-				    dir <- hexDirs
-				    , isNothing $ Map.lookup (dir +^ pos) board' ]
-			    in case arm of Just armdir -> addPiece $ Hook armdir NullHF
-					   _ -> id
-	   Just (BallTile) -> addPiece Ball
-	   _ -> id
-	   ) st'
+         Just o | protectedPiece o -> st
+         _ -> (case tile of
+           -- _ | same && (pos /= lastPos) -> id
+           Just (BlockTile _) ->
+               let adjacentBlocks = nub [ idx |
+                       dir <- hexDirs
+                       , Just (idx, BlockTile _) <- [Map.lookup (dir +^ pos) board']
+                       , not $ protectedPiece idx ]
+                   addToIdx = if lastOK && lastElem adjacentBlocks
+                       then lastMOwner
+                       else nextOfAdjacents adjacentBlocks False
+               in case addToIdx of
+                  Nothing -> addPiece $ Block [zero]
+                  Just b -> addBlockPos b pos
+           Just (ArmTile armdir _) ->
+               let adjacentPivots = [ idx |
+                       dir <- if armdir == zero then hexDirs else [armdir, neg armdir]
+                       , Just (idx, PivotTile _) <- [Map.lookup (dir +^ pos) board'] ]
+                   addToIdx = if lastOK && lastElem adjacentPivots
+                       then lastMOwner
+                       else nextOfAdjacents adjacentPivots True
+               in case addToIdx of
+                      Nothing -> id
+                      Just p -> addPivotArm p pos
+           Just (SpringTile _ _) ->
+               let possibleSprings = [ Connection root end $ Spring sdir natLen |
+                       sdir <- hexDirs
+                       , let epos = sdir +^ pos
+                       , Just (eidx, BlockTile _) <- [Map.lookup epos board']
+                       , not $ protectedPiece eidx
+                       , (ridx, rpos) <- maybeToList $ castRay (neg sdir +^ pos) (neg sdir) board'
+                       , Just True == (validSpringRootTile `liftM` Map.lookup rpos board')
+                       , let natLen = hexLen (rpos -^ epos) - 1
+                       , natLen > 0
+                       {-
+                       , null [ conn |
+                           conn@(Connection _ _ (Spring sdir' _)) <-
+                               springsAtIdx st' eidx ++ springsEndAtIdx st' ridx
+                           , not $ sdir' `elem` [sdir,neg sdir] ]
+                       -}
+                       , not $ connGraphPathExists st' eidx ridx
+                       , let end = (eidx, epos -^ (placedPos $ getpp st' eidx))
+                       , let root = (ridx, rpos -^ (placedPos $ getpp st' ridx))
+                       ]
+                   nextSpring = listToMaybe $ fromMaybe possibleSprings $ do
+                       (_,SpringTile _ _) <- curOwnedTile -- XXX: therefore the indices of st are still valid
+                       i <- findIndex (`elem` connections st) possibleSprings
+                       return $ drop (i+1) possibleSprings
+               in case nextSpring of
+                      Nothing -> id
+                      Just conn -> addConn conn
+           Just (PivotTile _) -> addPiece $ Pivot []
+           Just (WrenchTile _) -> addPiece $ Wrench zero
+           Just HookTile -> let arm = listToMaybe [ dir |
+                                    dir <- hexDirs
+                                    , isNothing $ Map.lookup (dir +^ pos) board' ]
+                            in case arm of Just armdir -> addPiece $ Hook armdir NullHF
+                                           _ -> id
+           Just (BallTile) -> addPiece Ball
+           _ -> id
+           ) st'
 
 -- | merge tile/piece with a neighbouring piece. If we merge a piece with
 -- connections, the connections are deleted: otherwise we'd need some fiddly
@@ -135,19 +135,19 @@
     guard $ idx /= idx'
     guard $ all (not . protectedPiece) [idx,idx']
     case tile of
-	BlockTile _ -> do
-	    BlockTile _ <- Just tile'
-	    let st' = if mergePiece
-			  then delPiece idx st
-			  else fst $ delPiecePos idx pos st
-	    (idx'',_) <- Map.lookup (dir+^pos) $ stateBoard st'
-	    return $ if mergePiece
-			 then foldr (addBlockPos idx'') st'
-				$ plPieceFootprint $ getpp st idx
-			 else addBlockPos idx'' pos st'
-	ArmTile _ _  -> do
-	    PivotTile _ <- Just tile'
-	    let st' = fst $ delPiecePos idx pos st
-	    (idx'',_) <- Map.lookup (dir+^pos) $ stateBoard st'
-	    return $ addPivotArm idx'' pos st'
-	_ -> mzero
+        BlockTile _ -> do
+            BlockTile _ <- Just tile'
+            let st' = if mergePiece
+                          then delPiece idx st
+                          else fst $ delPiecePos idx pos st
+            (idx'',_) <- Map.lookup (dir+^pos) $ stateBoard st'
+            return $ if mergePiece
+                         then foldr (addBlockPos idx'') st'
+                                $ plPieceFootprint $ getpp st idx
+                         else addBlockPos idx'' pos st'
+        ArmTile _ _  -> do
+            PivotTile _ <- Just tile'
+            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
@@ -33,23 +33,23 @@
 baseState :: Frame -> GameState
 baseState f =
     GameState
-	(Vector.fromList $ [ framePiece f, bolt ] ++ (initTools f))
-	[]
+        (Vector.fromList $ [ framePiece f, bolt ] ++ (initTools f))
+        []
     where
-	bolt = PlacedPiece (bolthole f +^ origin) $ Block $
-	    [ n*^hu | n <- [-1..boltWidth f - 1] ] -- ++ [(-2)*^hu+^neg hv]
+        bolt = PlacedPiece (bolthole f +^ origin) $ Block $
+            [ n*^hu | n <- [-1..boltWidth f - 1] ] -- ++ [(-2)*^hu+^neg hv]
 
 framePiece :: Frame -> PlacedPiece
 framePiece f@(BasicFrame size) =
     PlacedPiece origin $ Block $
-	map (bolthole f +^) (
-	    [ bw*^hu +^ n*^hv | n <- [0..bw] ]
-	    ++ [ bw*^hu +^ i*^hw +^ n*^hv | i <- [1..bw-1], n <- [0,bw+i] ])
-	++ (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] ] \\
-	    [bolthole f, entrance f])
+        map (bolthole f +^) (
+            [ bw*^hu +^ n*^hv | n <- [0..bw] ]
+            ++ [ bw*^hu +^ i*^hw +^ n*^hv | i <- [1..bw-1], n <- [0,bw+i] ])
+        ++ (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] ] \\
+            [bolthole f, entrance f])
     where bw = boltWidth f
 
 initTools :: Frame -> [PlacedPiece]
@@ -63,7 +63,7 @@
 
 boltArea,toolsArea :: Frame -> [HexPos]
 boltArea f = map PHS
-	[ bolthole f +^ bw*^hu +^ i*^hw +^ n*^hv | i <- [1..bw-1], n <- [1..bw+i-1] ]
+        [ bolthole f +^ bw*^hu +^ i*^hw +^ n*^hv | i <- [1..bw-1], n <- [1..bw+i-1] ]
     where bw = boltWidth f
 toolsArea f = [entrance f +^ v +^ origin | v <- [ neg hu, hw, zero ] ]
 
@@ -80,7 +80,7 @@
 truncateToEditable f pos@(PHS v) = if inBounds f pos
     then pos
     else head
-	$ [ pos'
-	    | n <- reverse [0..boltWidth f]
-	    , let pos' = PHS $ truncateToLength (frameSize f - 1 + n) v
-	    , inEditable f pos' ]
+        $ [ pos'
+            | n <- reverse [0..boltWidth f]
+            , let pos' = PHS $ truncateToLength (frameSize f - 1 + n) v
+            , inEditable f pos' ]
diff --git a/GameState.hs b/GameState.hs
--- a/GameState.hs
+++ b/GameState.hs
@@ -38,12 +38,12 @@
 setpp :: PieceIdx -> PlacedPiece -> GameState -> GameState
 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
-	    | eidx == idx = Connection root (eidx,epos+^displacement) link
-	    | otherwise = conn
+        updateConn conn@(Connection root@(ridx,rpos) end@(eidx,epos) link)
+            | ridx == idx = Connection (ridx,rpos+^displacement) end link
+            | eidx == idx = Connection root (eidx,epos+^displacement) link
+            | otherwise = conn
     in st {placedPieces = pps // [(idx, pp)]
-	, connections = map updateConn $ connections st }
+        , connections = map updateConn $ connections st }
 
 addpp :: PlacedPiece -> GameState -> GameState
 addpp pp st@(GameState pps _) = st {placedPieces = Vector.snoc pps pp}
@@ -56,36 +56,36 @@
 components patt
     | Set.null patt = []
     | otherwise =
-	let c = if zero `Set.member` patt then zero else head $ Set.toList patt
-	    (patt',comp) = floodfill c patt
-	in ( (c, Set.map (+^ neg c) comp) : components patt' )
+        let c = if zero `Set.member` patt then zero else head $ Set.toList patt
+            (patt',comp) = floodfill c patt
+        in ( (c, Set.map (+^ neg c) comp) : components patt' )
 
 floodfill :: HexVec -> Set HexVec -> (Set HexVec, Set HexVec)
 floodfill start patt = floodfill' start `execState` (patt, Set.empty)
     where
-	floodfill' :: HexVec -> State (Set HexVec, Set HexVec) ()
-	floodfill' start = do
-	      (patt, dels) <- get
-	      let patt' = Set.delete start patt
-	      unless (Set.size patt' == Set.size patt) $ do
-		  put (patt', Set.insert start dels)
-		  sequence_ [ floodfill' (dir+^start) | dir <- hexDirs ]
+        floodfill' :: HexVec -> State (Set HexVec, Set HexVec) ()
+        floodfill' start = do
+              (patt, dels) <- get
+              let patt' = Set.delete start patt
+              unless (Set.size patt' == Set.size patt) $ do
+                  put (patt', Set.insert start dels)
+                  sequence_ [ floodfill' (dir+^start) | dir <- hexDirs ]
 
 delPiece :: PieceIdx -> GameState -> GameState
 delPiece idx (GameState pps conns) =
     GameState (Vector.concat [Vector.take idx pps, Vector.drop (idx+1) pps])
-	[ Connection (ridx',rv) (eidx',ev) link |
-	    Connection (ridx,rv) (eidx,ev) link <- conns
-	    , ridx /= idx
-	    , eidx /= idx
-	    , let ridx' = if ridx > idx then ridx-1 else ridx
-	    , let eidx' = if eidx > idx then eidx-1 else eidx ]
+        [ Connection (ridx',rv) (eidx',ev) link |
+            Connection (ridx,rv) (eidx,ev) link <- conns
+            , ridx /= idx
+            , eidx /= idx
+            , let ridx' = if ridx > idx then ridx-1 else ridx
+            , let eidx' = if eidx > idx then eidx-1 else eidx ]
 
 delPieceIn :: HexPos -> GameState -> GameState
 delPieceIn pos st =
     case liftM fst $ Map.lookup pos $ stateBoard st of
-	Just idx -> delPiece idx st
-	_ -> st
+        Just idx -> delPiece idx st
+        _ -> st
 
 setPiece :: PieceIdx -> Piece -> GameState -> GameState
 setPiece idx p st =
@@ -94,7 +94,7 @@
 adjustPieces :: (Piece -> Piece) -> GameState -> GameState
 adjustPieces f st =
     st { placedPieces = fmap
-	(\pp -> pp { placedPiece = f $ placedPiece pp })
+        (\pp -> pp { placedPiece = f $ placedPiece pp })
        $ placedPieces st }
 
 addBlockPos :: PieceIdx -> HexPos -> GameState -> GameState
@@ -118,7 +118,7 @@
 connectionLength :: GameState -> Connection -> Int
 connectionLength st (Connection root end _) =
     let rootPos = locusPos st root
-	endPos = locusPos st end
+        endPos = locusPos st end
     in hexLen (endPos -^ rootPos) - 1
 
 springsAtIdx,springsEndAtIdx,springsRootAtIdx :: GameState -> PieceIdx -> [Connection]
@@ -138,14 +138,14 @@
 connectionsBetween st idx idx' =
     filter connIsBetween $ connections st
     where
-	connIsBetween conn =
-	    isPerm (idx,idx') (fst $ connectionRoot conn, fst $ connectionEnd conn)
-	isPerm = (==) `on` (\(x,y) -> Set.fromList [x,y])
+        connIsBetween conn =
+            isPerm (idx,idx') (fst $ connectionRoot conn, fst $ connectionEnd conn)
+        isPerm = (==) `on` (\(x,y) -> Set.fromList [x,y])
 
 connGraphPathExists :: GameState -> PieceIdx -> PieceIdx -> Bool
 connGraphPathExists st ridx eidx = (ridx == eidx) ||
-	any ((connGraphPathExists st `flip` eidx) . fst .  connectionEnd)
-	    (springsRootAtIdx st ridx)
+        any ((connGraphPathExists st `flip` eidx) . fst .  connectionEnd)
+            (springsRootAtIdx st ridx)
 
 connGraphHeight :: GameState -> PieceIdx -> Int
 connGraphHeight st idx =
@@ -155,25 +155,25 @@
 checkConnGraphAcyclic :: GameState -> Bool
 checkConnGraphAcyclic st =
     let idxs = ppidxs st
-	leaves dg = map fst $ filter (Set.null . snd) $ Map.toList dg
-	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
+        leaves dg = map fst $ filter (Set.null . snd) $ Map.toList dg
+        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
-	[ (idx, Set.fromList $ map (fst.connectionRoot) $ springsEndAtIdx st idx) | idx <- idxs ]
+        [ (idx, Set.fromList $ map (fst.connectionRoot) $ springsEndAtIdx st idx) | idx <- idxs ]
 
 repossessConns :: GameState -> GameState -> GameState
 repossessConns st st' =
     st' {connections = [ Connection root' end' link |
-	Connection root end link <- connections st
-	, root' <- maybeToList $ posLocus st' $ locusPos st root
-	, end' <- maybeToList $ posLocus st' $ locusPos st end ] }
+        Connection root end link <- connections st
+        , root' <- maybeToList $ posLocus st' $ locusPos st root
+        , end' <- maybeToList $ posLocus st' $ locusPos st end ] }
 
 delConnectionsIn :: HexPos -> GameState -> GameState
 delConnectionsIn pos st =
     st {connections = filter
-	((pos `notElem`) . connectionFootPrint st)
+        ((pos `notElem`) . connectionFootPrint st)
         $ connections st}
 
 delPiecePos :: PieceIdx -> HexPos -> GameState -> (GameState, Maybe PieceIdx)
@@ -181,27 +181,27 @@
 -- anything
 delPiecePos idx pos st =
     let PlacedPiece ppos p = getpp st idx
-	v = pos -^ ppos
+        v = pos -^ ppos
     in case p of
         Block patt ->
-	    let (st',midx) = componentify idx $ setpp idx (PlacedPiece ppos $ Block $ patt \\ [v]) st
-	    in (repossessConns st st', midx)
+            let (st',midx) = componentify idx $ setpp idx (PlacedPiece ppos $ Block $ patt \\ [v]) st
+            in (repossessConns st st', midx)
         Pivot arms -> if v == zero
-	   then (delPiece idx st, Nothing)
-	   else ((setPiece idx $ Pivot $ arms \\ [v]) st, Just idx)
+           then (delPiece idx st, Nothing)
+           else ((setPiece idx $ Pivot $ arms \\ [v]) st, Just idx)
         _ -> (delPiece idx st, Nothing)
 componentify :: PieceIdx -> GameState -> (GameState, Maybe PieceIdx)
 componentify idx st = let PlacedPiece ppos p = getpp st idx
     in case p of
         Block patt ->
-	    let comps = components $ Set.fromList patt
-		ppOfComp (v,patt) = PlacedPiece (v+^ppos) $ Block $ Set.toList patt
-	    in case comps of
-		[] -> (delPiece idx st, Nothing)
-		zeroComp:newComps ->
-		    (setpp idx (ppOfComp zeroComp)
-			$ foldr (addpp . ppOfComp) st newComps, Just idx)
-	_ -> (st,Nothing)
+            let comps = components $ Set.fromList patt
+                ppOfComp (v,patt) = PlacedPiece (v+^ppos) $ Block $ Set.toList patt
+            in case comps of
+                [] -> (delPiece idx st, Nothing)
+                zeroComp:newComps ->
+                    (setpp idx (ppOfComp zeroComp)
+                        $ foldr (addpp . ppOfComp) st newComps, Just idx)
+        _ -> (st,Nothing)
 
 springExtended,springCompressed,springFullyExtended
     ,springFullyCompressed :: GameState -> Connection -> Bool
@@ -225,21 +225,21 @@
 stateBoard :: GameState -> GameBoard
 stateBoard st@(GameState plPieces conns) =
     addConnAdjs st conns $
-	(Map.unions $ map plPieceBoard $ enumVec plPieces) `Map.union`
-	(Map.unions $ map (connectionBoard st) conns)
+        (Map.unions $ map plPieceBoard $ enumVec plPieces) `Map.union`
+        (Map.unions $ map (connectionBoard st) conns)
 
 addConnAdjs :: GameState -> [Connection] -> GameBoard -> GameBoard
 addConnAdjs st = flip $ foldr addConnAdj
     where
-	addConnAdj (Connection root end (Spring dir _)) board =
-	    addAdj (locusPos st root) dir $
-	    addAdj (locusPos st end) (neg dir) board
-	addConnAdj _ board = board
-	addAdj pos d =
-	    Map.adjust (\(o,tile) -> (o,case tile of
-		    BlockTile adjs -> BlockTile (d:adjs)
-		    _ -> tile))
-		pos
+        addConnAdj (Connection root end (Spring dir _)) board =
+            addAdj (locusPos st root) dir $
+            addAdj (locusPos st end) (neg dir) board
+        addConnAdj _ board = board
+        addAdj pos d =
+            Map.adjust (\(o,tile) -> (o,case tile of
+                    BlockTile adjs -> BlockTile (d:adjs)
+                    _ -> tile))
+                pos
 
 plPieceBoard :: (PieceIdx,PlacedPiece) -> GameBoard
 plPieceBoard (idx,pp) = fmap (\x -> (idx,x)) $ plPieceMap pp
@@ -248,13 +248,13 @@
 plPieceMap (PlacedPiece pos (Block pattern)) =
     let pattSet = Set.fromList pattern
     in Map.fromList [ (rel +^ pos, BlockTile adjs)
-	| rel <- pattern
-	, let adjs = filter (\dir -> (rel +^ dir) `Set.member` pattSet) hexDirs ]
+        | rel <- pattern
+        , let adjs = filter (\dir -> (rel +^ dir) `Set.member` pattSet) 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 ]
+        [ (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
@@ -283,19 +283,19 @@
 -- the connections which connect the two pieces
 collisions st idx idx' =
     intersect (footprintAt st idx) (footprintAt st idx') \\
-	(concat $ map (connectionFootPrint st) $ connectionsBetween st idx idx')
+        (concat $ map (connectionFootPrint st) $ connectionsBetween st idx idx')
 
 connectionBoard :: GameState -> Connection -> GameBoard
 connectionBoard st (Connection root end@(eidx,_) (Spring dir natLen)) =
     let rootPos = locusPos st root
-	endPos = locusPos st end
-	curLen = hexLen (endPos -^ rootPos) - 1
+        endPos = locusPos st end
+        curLen = hexLen (endPos -^ rootPos) - 1
     in Map.fromList $
-	[ ((d *^ dir) +^ rootPos, (eidx, SpringTile extension dir))
-	    | d <- [1..curLen],
-	    let extension | d <= natLen - curLen = Compressed
-			  | curLen-d < 2*(curLen - natLen) = Stretched
-			  | otherwise = Relaxed ]
+        [ ((d *^ dir) +^ rootPos, (eidx, SpringTile extension dir))
+            | d <- [1..curLen],
+            let extension | d <= natLen - curLen = Compressed
+                          | curLen-d < 2*(curLen - natLen) = Stretched
+                          | otherwise = Relaxed ]
 connectionBoard _ _ = Map.empty
 
 connectionFootPrint :: GameState -> Connection -> [HexPos]
@@ -305,29 +305,29 @@
 castRay start dir board =
     castRay' 30 start
     where castRay' 0 _ = Nothing
-	  castRay' n pos =
-	      case Map.lookup pos board of
-		  Nothing -> castRay' (n-1) (dir+^pos)
-		  Just (idx,_) -> Just (idx,pos)
+          castRay' n pos =
+              case Map.lookup pos board of
+                  Nothing -> castRay' (n-1) (dir+^pos)
+                  Just (idx,_) -> Just (idx,pos)
 
 validGameState :: GameState -> Bool
 validGameState st@(GameState pps conns) = and
     [ checkValidHex st
     , checkConnGraphAcyclic st
     , and [ null $ collisions st idx idx'
-	    | idx <- ppidxs st
-	    , idx' <- [0..idx-1] ]
+            | idx <- ppidxs st
+            , idx' <- [0..idx-1] ]
     , and [ isHexDir dir
-	    && castRay (dir+^rpos) dir
-		(stateBoard $ GameState pps (conns \\ [c]))
-		== Just (eidx, epos)
-	    && springExtensionValid st c
-	    && (validRoot st root)
-	    && (validEnd st end)
-	    | c@(Connection root@(ridx,_) end@(eidx,_) (Spring dir _)) <- conns
-	    , let [rpos,epos] = map (locusPos st) [root,end] ]
+            && castRay (dir+^rpos) dir
+                (stateBoard $ GameState pps (conns \\ [c]))
+                == Just (eidx, epos)
+            && springExtensionValid st c
+            && (validRoot st root)
+            && (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)
-	    | Block patt <- map placedPiece $ Vector.toList pps ]
+            | Block patt <- map placedPiece $ Vector.toList pps ]
     ]
 
 validRoot st (idx,v) = case placedPiece $ getpp st idx of
@@ -342,17 +342,17 @@
     [ all validPP $ Vector.toList pps
     , all validConn conns ]
     where
-	validVec (HexVec x y z) = x+y+z==0
-	validPos (PHS v) = validVec v
-	validDir v = validVec v && isHexDir v
-	validPP (PlacedPiece pos piece) = validPos pos && validPiece piece
-	validPiece (Block patt) = all validVec patt
-	validPiece (Pivot arms) = all validDir arms
-	validPiece (Hook dir _) = validDir dir
-	validPiece _ = True
-	validConn (Connection (_,rv) (_,ev) link) = all validVec [rv,ev] && validLink link
-	validLink (Free v) = validVec v
-	validLink (Spring dir _) = validDir dir
+        validVec (HexVec x y z) = x+y+z==0
+        validPos (PHS v) = validVec v
+        validDir v = validVec v && isHexDir v
+        validPP (PlacedPiece pos piece) = validPos pos && validPiece piece
+        validPiece (Block patt) = all validVec patt
+        validPiece (Pivot arms) = all validDir arms
+        validPiece (Hook dir _) = validDir dir
+        validPiece _ = True
+        validConn (Connection (_,rv) (_,ev) link) = all validVec [rv,ev] && validLink link
+        validLink (Free v) = validVec v
+        validLink (Spring dir _) = validDir dir
 
 protectedPiece :: PieceIdx -> Bool
 protectedPiece = isFrame
diff --git a/GameStateTypes.hs b/GameStateTypes.hs
--- a/GameStateTypes.hs
+++ b/GameStateTypes.hs
@@ -15,7 +15,7 @@
 import Hex
 
 data GameState = GameState { placedPieces :: Vector PlacedPiece,
-	connections :: [Connection] }
+        connections :: [Connection] }
     deriving (Eq, Ord, Show, Read)
 
 data PlacedPiece = PlacedPiece { placedPos :: HexPos, placedPiece :: Piece }
@@ -24,10 +24,10 @@
 type PieceIdx = Int
 
 data Piece = Block { blockPattern :: [HexVec] }
-	    | Pivot { pivotArms :: [HexDir] }
-	    | Hook { hookArm :: HexDir, hookForce :: HookForce}
-	    | Wrench { wrenchMomentum :: HexDir }
-	    | Ball
+            | Pivot { pivotArms :: [HexDir] }
+            | Hook { hookArm :: HexDir, hookForce :: HookForce}
+            | Wrench { wrenchMomentum :: HexDir }
+            | Ball
     deriving (Eq, Ord, Show, Read)
 
 data HookForce = NullHF | PushHF HexDir | TorqueHF Int
@@ -42,20 +42,20 @@
 isBall p = case p of Ball -> True; _ -> False
 
 data Connection = Connection { connectionRoot :: Locus
-		    , connectionEnd :: Locus, connectionLink :: Link }
+                    , connectionEnd :: Locus, connectionLink :: Link }
     deriving (Eq, Ord, Show, Read)
 
 type Locus = (PieceIdx, HexVec)
 
 data Link = Free { freePos :: HexVec }
-	  | Spring { springDir :: HexDir, springNatLength :: Int }
+          | Spring { springDir :: HexDir, springNatLength :: Int }
     deriving (Eq, Ord, Show, Read)
 
 data SpringExtension = Relaxed | Compressed | Stretched
     deriving (Eq, Ord, Show, Read)
 
 data Tile = BlockTile [HexDir] | PivotTile HexDir | ArmTile HexDir Bool | HookTile | WrenchTile HexDir
-	  | BallTile | SpringTile SpringExtension HexDir
+          | BallTile | SpringTile SpringExtension HexDir
     deriving (Eq, Ord, Show, Read)
 
 tileType :: Tile -> Tile
@@ -80,8 +80,8 @@
 
 -- |Alert: for passing information about physics processing to the UI
 data Alert = AlertCollision HexPos | AlertBlockingForce Force
-	   | AlertResistedForce Force | AlertBlockedForce Force
-	   | AlertAppliedForce Force | AlertDivertedWrench PieceIdx
-	   | AlertUnlocked
-	   | AlertIntermediateState GameState
+           | AlertResistedForce Force | AlertBlockedForce Force
+           | AlertAppliedForce Force | AlertDivertedWrench PieceIdx
+           | AlertUnlocked
+           | AlertIntermediateState GameState
     deriving (Eq, Ord, Show)
diff --git a/GraphColouring.hs b/GraphColouring.hs
--- a/GraphColouring.hs
+++ b/GraphColouring.hs
@@ -32,8 +32,8 @@
 -- Aims to minimise changes from given (partial) colouring lastCol.
 fiveColour g lastCol =
     if Map.keysSet lastCol == Map.keysSet g && isColouring g lastCol
-	then lastCol
-	else fiveColour' lastCol g
+        then lastCol
+        else fiveColour' lastCol g
 
 isColouring :: Ord a => PlanarGraph a -> Colouring a -> Bool
 isColouring g mapping = and
@@ -45,17 +45,17 @@
 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
+        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
+                    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
@@ -66,7 +66,7 @@
 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
+        $ Map.adjust (concatAdjsOver v $ g Map.! v'') v' g
 
 concatAdjsOver :: Ord a => a -> [a] -> [a] -> [a]
 concatAdjsOver v adjs adjs' =
diff --git a/Hex.lhs b/Hex.lhs
--- a/Hex.lhs
+++ b/Hex.lhs
@@ -73,15 +73,15 @@
 
 hexDisc :: Int -> [HexVec] 
 hexDisc r = [ HexVec x y z | x <- [-r..r], y <- [-r..r],
-	let z = -x-y, abs z <= r ]
+        let z = -x-y, abs z <= r ]
 
 hextant :: HexVec -> Int
 -- ^undefined at zero
---	` 1 '
---	2` '0
---	--*--
---	3' `5
---	' 4 `
+--        ` 1 '
+--        2` '0
+--        --*--
+--        3' `5
+--        ' 4 `
 hextant (HexVec x y z)
     | x > 0 && y >= 0 = 0
     | -z > 0 && -x >= 0 = 1
@@ -99,8 +99,8 @@
 rotate 1 v = neg $ rotate (-2) v
 rotate (-1) v = neg $ rotate 2 v
 rotate n v | n < 0 = rotate (n+6) v
-	| n > 6 = rotate (n-6) v
-	| otherwise = rotate (n-2) (rotate 2 v)
+        | n > 6 = rotate (n-6) v
+        | otherwise = rotate (n-2) (rotate 2 v)
 
 cmpAngles :: HexVec -> HexVec -> Ordering
 -- ^ordered by angle, taking cut along u
@@ -108,18 +108,18 @@
     | v == zero && v' == zero = EQ
     | v == zero = LT
     | compare (hextant v) (hextant v') /= EQ = 
-	compare (hextant v) (hextant v')
+        compare (hextant v) (hextant v')
     | hextant v /= 0 =
-	cmpAngles (rotate (-(hextant v)) v) (rotate (-(hextant v)) v')
+        cmpAngles (rotate (-(hextant v)) v) (rotate (-(hextant v)) v')
     | otherwise = compare (y%x) (y'%x')
 
 instance Ix HexVec where
     range (h,h') = 
-	[ tupxy2hv (x,y) | (x,y) <- range (hv2tupxy h, hv2tupxy h') ]
+        [ tupxy2hv (x,y) | (x,y) <- range (hv2tupxy h, hv2tupxy h') ]
     inRange (h,h') h'' =
-	inRange (hv2tupxy h, hv2tupxy h') (hv2tupxy h'')
+        inRange (hv2tupxy h, hv2tupxy h') (hv2tupxy h'')
     index (h,h') h'' =
-	index (hv2tupxy h , hv2tupxy h') (hv2tupxy h'')
+        index (hv2tupxy h , hv2tupxy h') (hv2tupxy h'')
 
 -- HexDirs are intended to be HexVecs of length <= 1
 type HexDir = HexVec
@@ -144,20 +144,20 @@
 
 canonDir :: HexDir -> HexDir
 canonDir dir | dir `elem` [ hu, hv, hw ] = dir
-	     | isHexDir dir = canonDir $ neg dir
-	     | dir == zero = zero
-	     | otherwise = undefined
+             | isHexDir dir = canonDir $ neg dir
+             | dir == zero = zero
+             | otherwise = undefined
 
 scaleToLength :: Int -> HexVec -> HexVec
 scaleToLength n v@(HexVec x y z) =
     let
-	l = hexLen v
-	lv' = map ((`div`l).(n*)) [x,y,z]
-	minI = fst $ minimumBy (compare `on` snd) $
-	    zip [0..] $ map abs lv'
-	[x'',y'',z''] = zipWith (-) lv' [ d
-		| i <- [0..2]
-		, let d = if i == minI then sum lv' else 0 ]
+        l = hexLen v
+        lv' = map ((`div`l).(n*)) [x,y,z]
+        minI = fst $ minimumBy (compare `on` snd) $
+            zip [0..] $ map abs lv'
+        [x'',y'',z''] = zipWith (-) lv' [ d
+                | i <- [0..2]
+                , let d = if i == minI then sum lv' else 0 ]
     in HexVec x'' y'' z''
 truncateToLength :: Int -> HexVec -> HexVec
 truncateToLength n v = if hexLen v <= n then v else scaleToLength n v
@@ -203,9 +203,9 @@
     0 *^ _              = zero
     1 *^ x              = x
     n *^ x
-	| n < 0     = (-n) *^ (neg x)
-	| even n    = (n `div` 2) *^ (x +^ x)
-	| otherwise = x +^ ((n `div` 2) *^ (x +^ x))
+        | n < 0     = (-n) *^ (neg x)
+        | even n    = (n `div` 2) *^ (x +^ x)
+        | otherwise = x +^ ((n `div` 2) *^ (x +^ x))
 
 \end{code}
 
diff --git a/Init.hs b/Init.hs
--- a/Init.hs
+++ b/Init.hs
@@ -45,8 +45,8 @@
 parseArgs :: [String] -> IO ([Opt],[String])
 parseArgs argv =
     case getOpt Permute options argv of
-	(o,n,[]) -> return (o,n)
-	(_,_,errs) -> ioError (userError (concat errs ++ usage))
+        (o,n,[]) -> return (o,n)
+        (_,_,errs) -> ioError (userError (concat errs ++ usage))
 
 setup :: IO (Maybe Lock,[Opt],Maybe String)
 setup = do
@@ -57,32 +57,32 @@
     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) ]
+        [ 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) =>
-	Maybe (s MainState -> IO (Maybe MainState)) ->
-	Maybe (c MainState -> IO (Maybe MainState)) -> IO ()
+        Maybe (s MainState -> IO (Maybe MainState)) ->
+        Maybe (c MainState -> IO (Maybe MainState)) -> IO ()
 main' msdlUI mcursesUI = do
     (mlock,opts,mpath) <- setup
     initMState <- case mlock of
-	    Nothing -> initMetaState
-	    Just lock -> return $ newEditState lock Nothing mpath
+            Nothing -> initMetaState
+            Just lock -> return $ newEditState lock Nothing mpath
     void $ runMaybeT $ msum [ do
-	    finalState <- msum
-		[ do
-		    guard $ ForceCurses `notElem` opts
-		    sdlUI <- liftMaybe $ msdlUI
-		    MaybeT $ sdlUI $ interactUI `execStateT` initMState
-		, do
-		    cursesUI <- liftMaybe $ mcursesUI
-		    MaybeT $ cursesUI $ interactUI `execStateT` initMState
-		]
-	    when (isNothing mlock) $ lift $ writeMetaState finalState
-	    lift $ exitSuccess
-	, lift exitFailure ]
+            finalState <- msum
+                [ do
+                    guard $ ForceCurses `notElem` opts
+                    sdlUI <- liftMaybe $ msdlUI
+                    MaybeT $ sdlUI $ interactUI `execStateT` initMState
+                , do
+                    cursesUI <- liftMaybe $ mcursesUI
+                    MaybeT $ cursesUI $ interactUI `execStateT` initMState
+                ]
+            when (isNothing mlock) $ lift $ writeMetaState finalState
+            lift $ exitSuccess
+        , lift exitFailure ]
diff --git a/Interact.hs b/Interact.hs
--- a/Interact.hs
+++ b/Interact.hs
@@ -67,47 +67,47 @@
     lift $ onNewMode im
     when (im == IMEdit) setSelectedPosFromMouse
     when (im == IMMeta) $ do
-	spawnUnblockerThread
+        spawnUnblockerThread
 
-	-- draw before testing auth, lest a timeout mean a blank screen
-	drawMainState
+        -- draw before testing auth, lest a timeout mean a blank screen
+        drawMainState
 
-	testAuth
-	refreshUInfoUI
-	tbdg <- lift $ getUIBinding IMMeta CmdTutorials
-	isNothing <$> gets curAuth >>?
-	    lift $ drawMessage $ "Welcome. To play the tutorial levels, press '"++tbdg++"'."
+        testAuth
+        refreshUInfoUI
+        tbdg <- lift $ getUIBinding IMMeta CmdTutorials
+        isNothing <$> gets curAuth >>?
+            lift $ drawMessage $ "Welcome. To play the tutorial levels, press '"++tbdg++"'."
     setMark False startMark
     interactLoop
 
     where
-	interactLoop = do
-	    mainSt <- get
-	    let im = ms2im mainSt
-	    when (im == IMPlay) checkWon
-	    when (im == IMMeta) $ (checkAsync >>) $ void.runMaybeT $
-		mourNameSelected >>? lift purgeInvalidUndecls
-	    drawMainState
-	    cmds <- lift $ getSomeInput im
-	    runExceptT (mapM_ (processCommand im) cmds) >>=
-		either
-		    ((lift (drawMessage "") >>) . return)
-		    (const interactLoop)
+        interactLoop = do
+            mainSt <- get
+            let im = ms2im mainSt
+            when (im == IMPlay) checkWon
+            when (im == IMMeta) $ (checkAsync >>) $ void.runMaybeT $
+                mourNameSelected >>? lift purgeInvalidUndecls
+            drawMainState
+            cmds <- lift $ getSomeInput im
+            runExceptT (mapM_ (processCommand im) cmds) >>=
+                either
+                    ((lift (drawMessage "") >>) . return)
+                    (const interactLoop)
 
-	-- | 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
+        -- | 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
 
 runSubMainState :: UIMonad uiM => MainState -> MainStateT uiM (InteractSuccess,MainState)
 runSubMainState mSt = lift (runStateT interactUI mSt) <* cleanOnPop
     where cleanOnPop = do
-	    im <- gets ms2im
-	    lift $ onNewMode im
-	    when (im == IMEdit) setSelectedPosFromMouse
+            im <- gets ms2im
+            lift $ onNewMode im
+            when (im == IMEdit) setSelectedPosFromMouse
 
 execSubMainState :: UIMonad uiM => MainState -> MainStateT uiM MainState
 execSubMainState = (snd <$>) . runSubMainState
@@ -119,23 +119,23 @@
 processCommand :: UIMonad uiM => InputMode -> Command -> ExceptT InteractSuccess (MainStateT uiM) ()
 processCommand im CmdQuit = do
     case im of
-	IMReplay -> throwE $ InteractSuccess False
-	IMPlay -> lift (or <$> sequence [gets psIsSub, gets psSaved, null <$> gets psGameStateMoveStack])
-	    >>? throwE $ InteractSuccess False
-	IMEdit -> lift editStateUnsaved >>! throwE $ InteractSuccess True
-	_ -> return ()
+        IMReplay -> throwE $ InteractSuccess False
+        IMPlay -> lift (or <$> sequence [gets psIsSub, gets psSaved, null <$> gets psGameStateMoveStack])
+            >>? throwE $ InteractSuccess False
+        IMEdit -> lift editStateUnsaved >>! throwE $ InteractSuccess True
+        _ -> return ()
     title <- lift $ getTitle
     (lift . lift . confirm) ("Really quit"
-	    ++ (if im == IMEdit then " without saving" else "")
-	    ++ maybe "" (" from "++) title ++ "?")
-	>>? throwE $ InteractSuccess False
+            ++ (if im == IMEdit then " without saving" else "")
+            ++ maybe "" (" from "++) title ++ "?")
+        >>? throwE $ InteractSuccess False
 processCommand im CmdForceQuit = throwE $ InteractSuccess False
 processCommand IMPlay CmdOpen = do
     st <- gets psCurrentState
     frame <- gets psFrame
     if checkSolved (frame,st)
-	then throwE $ InteractSuccess True
-	else lift.lift $ drawError "Locked!"
+        then throwE $ InteractSuccess True
+        else lift.lift $ drawError "Locked!"
 processCommand im cmd = lift $ processCommand' im cmd
 
 processCommand' :: UIMonad uiM => InputMode -> Command -> MainStateT uiM ()
@@ -147,15 +147,15 @@
             return $ [HelpPageInput] ++ if first then [HelpPageFirstEdit] else []
         _ -> return [HelpPageInput]
     let showPage p = withNoBG $ showHelp im p >>? do
-	    void $ textInput "[press a key or RMB]" 1 False True Nothing Nothing
+            void $ textInput "[press a key or RMB]" 1 False True Nothing Nothing
     sequence_ $ map showPage helpPages
 processCommand' im (CmdBind mcmd)= lift $ (>> endPrompt) $ runMaybeT $ do
     cmd <- liftMaybe mcmd `mplus` do
-	lift $ drawPrompt False "Command to bind: "
-	msum $ repeat $ do
-	    cmd <- MaybeT $ listToMaybe <$> getInput im
-	    guard $ not.null $ describeCommand cmd
-	    return cmd
+        lift $ drawPrompt False "Command to bind: "
+        msum $ repeat $ do
+            cmd <- MaybeT $ listToMaybe <$> getInput im
+            guard $ not.null $ describeCommand cmd
+            return cmd
     lift $ drawPrompt False ("key to bind to \"" ++ describeCommand cmd ++ "\" (repeat existing user binding to delete): ")
     ch <- MaybeT getChRaw
     guard $ ch /= '\ESC'
@@ -177,7 +177,7 @@
     guard $ im `elem` [IMEdit, IMPlay, IMReplay]
     marks <- lift marksSet
     str <- MaybeT $ lift $ textInput
-	("Jump to mark [" ++ intersperse ',' marks ++ "]: ")
+        ("Jump to mark [" ++ intersperse ',' marks ++ "]: ")
             1 False True (Just $ map (:[]) marks) Nothing
     ch <- liftMaybe $ listToMaybe str
     lift $ jumpMark ch
@@ -185,47 +185,47 @@
 processCommand' IMMeta (CmdSelCodename mname) = void.runMaybeT $ do
     mauth <- gets curAuth
     name <- msum [ liftMaybe $ mname
-	, do
-	    newCodename <- (map toUpper <$>) $ MaybeT $ lift $
-		textInput "Select codename:"
-		    3 False False Nothing Nothing
-	    guard $ length newCodename == 3
-	    return newCodename
-	]
+        , do
+            newCodename <- (map toUpper <$>) $ MaybeT $ lift $
+                textInput "Select codename:"
+                    3 False False Nothing Nothing
+            guard $ length newCodename == 3
+            return newCodename
+        ]
     guard $ validCodeName name
     lift $ do
-	modify $ \ms -> ms { codenameStack = (name:codenameStack ms) }
-	invalidateUInfo name
-	refreshUInfoUI
+        modify $ \ms -> ms { codenameStack = (name:codenameStack ms) }
+        invalidateUInfo name
+        refreshUInfoUI
 processCommand' IMMeta CmdHome = void.runMaybeT $ do
     ourName <- mgetOurName
     lift $ do
-	modify $ \ms -> ms { codenameStack = (ourName:codenameStack ms) }
-	refreshUInfoUI
+        modify $ \ms -> ms { codenameStack = (ourName:codenameStack ms) }
+        refreshUInfoUI
 processCommand' IMMeta CmdBackCodename = do
     stack <- gets codenameStack
     when (length stack > 1) $ do
-	modify $ \ms -> ms { codenameStack = tail stack }
-	refreshUInfoUI
+        modify $ \ms -> ms { codenameStack = tail stack }
+        refreshUInfoUI
 processCommand' IMMeta CmdSetServer = void.runMaybeT $ do
     saddr <- gets curServer
     saddrs <- liftIO $ knownServers
     newSaddr' <- MaybeT $ ((>>= strToSaddr) <$>) $
-	lift $ textInput "Set server:" 256 False False
-	    (Just $ map saddrStr saddrs) (Just $ saddrStr saddr)
+        lift $ textInput "Set server:" 256 False False
+            (Just $ map saddrStr saddrs) (Just $ saddrStr saddr)
     let newSaddr = if nullSaddr newSaddr' then defaultServerAddr else newSaddr'
     modify $ \ms -> ms { curServer = newSaddr }
     msum [ void.MaybeT $ getFreshRecBlocking RecServerInfo
-	, modify (\ms -> ms { curServer = saddr }) >> mzero ]
+        , modify (\ms -> ms { curServer = saddr }) >> mzero ]
     lift $ do
-	modify $ \ms -> ms {curAuth = Nothing}
-	get >>= liftIO . writeServerSolns saddr
-	(undecls,partials,_) <- liftIO (readServerSolns newSaddr)
-	modify $ \ms -> ms { undeclareds=undecls, partialSolutions=partials }
-	rnamestvar <- gets randomCodenames
-	liftIO $ atomically $ writeTVar rnamestvar []
-	invalidateAllUInfo
-	refreshUInfoUI
+        modify $ \ms -> ms {curAuth = Nothing}
+        get >>= liftIO . writeServerSolns saddr
+        (undecls,partials,_) <- liftIO (readServerSolns newSaddr)
+        modify $ \ms -> ms { undeclareds=undecls, partialSolutions=partials }
+        rnamestvar <- gets randomCodenames
+        liftIO $ atomically $ writeTVar rnamestvar []
+        invalidateAllUInfo
+        refreshUInfoUI
 processCommand' IMMeta CmdToggleCacheOnly = do
     newCOnly <- gets $ not . cacheOnly
     modify $ \ms -> ms {cacheOnly = newCOnly}
@@ -237,11 +237,11 @@
     mauth <- gets curAuth
     let isUs = maybe False ((==regName).authUser) mauth
     if isUs
-	then msum [ do
-		confirmOrBail "Log out?"
-		modify $ \ms -> ms {curAuth = Nothing}
-	    , do
-		confirmOrBail "Reset password?"
+        then msum [ do
+                confirmOrBail "Log out?"
+                modify $ \ms -> ms {curAuth = Nothing}
+            , do
+                confirmOrBail "Reset password?"
                 void.lift.runMaybeT $ do
                     passwd <- inputPassword regName True "Enter new password:"
                     lift $ do
@@ -252,11 +252,11 @@
                                 modify $ \ms -> ms {curAuth = Just $ Auth regName passwd}
                             ServerError err -> lift $ drawError err
                             _ -> lift $ drawMessage $ "Bad server response: " ++ show resp
-	    , do
-		confirmOrBail "Configure email notifications?"
-		setNotifications
-	    ]
-	else msum [ do
+            , do
+                confirmOrBail "Configure email notifications?"
+                setNotifications
+            ]
+        else msum [ do
                 mgetUInfo regName
                 lift.lift $ drawError "Sorry, this codename is already taken."
             , do
@@ -278,69 +278,69 @@
             ]
 
     where setNotifications = do
-	    address <- MaybeT $ lift $ textInput "Enter address, or leave blank to disable notifications:" 128 False False Nothing Nothing
-	    lift $ do
-		resp <- curServerAction $ SetEmail address
-		case resp of
-		    ServerAck -> lift $ drawMessage $ if null address then "Notifications disabled." else "Address set."
-		    ServerError err -> lift $ drawError err
-		    _ -> lift $ drawMessage $ "Bad server response: " ++ show resp
+            address <- MaybeT $ lift $ textInput "Enter address, or leave blank to disable notifications:" 128 False False Nothing Nothing
+            lift $ do
+                resp <- curServerAction $ SetEmail address
+                case resp of
+                    ServerAck -> lift $ drawMessage $ if null address then "Notifications disabled." else "Address set."
+                    ServerError err -> lift $ drawError err
+                    _ -> lift $ drawMessage $ "Bad server response: " ++ show resp
 
-	
+        
 processCommand' IMMeta CmdAuth = void.runMaybeT $ do
     auth <- lift $ gets curAuth
     if isJust auth then do
-	confirmOrBail "Log out?"
-	modify $ \ms -> ms {curAuth = Nothing}
+        confirmOrBail "Log out?"
+        modify $ \ms -> ms {curAuth = Nothing}
     else do
-	name <- mgetCurName
-	passwd <- inputPassword name False $ "Enter password for "++name++":"
-	lift $ do
-	    modify $ \ms -> ms {curAuth = Just $ Auth name passwd}
-	    resp <- curServerAction $ Authenticate
-	    case resp of
-		ServerAck -> lift $ drawMessage "Authenticated."
-		ServerMessage msg -> lift $ drawMessage $ "Server: " ++ msg
-		ServerError err -> do
-		    lift $ drawError err
-		    modify $ \ms -> ms {curAuth = auth}
-		_ -> lift $ drawMessage $ "Bad server response: " ++ show resp
-	    refreshUInfoUI
+        name <- mgetCurName
+        passwd <- inputPassword name False $ "Enter password for "++name++":"
+        lift $ do
+            modify $ \ms -> ms {curAuth = Just $ Auth name passwd}
+            resp <- curServerAction $ Authenticate
+            case resp of
+                ServerAck -> lift $ drawMessage "Authenticated."
+                ServerMessage msg -> lift $ drawMessage $ "Server: " ++ msg
+                ServerError err -> do
+                    lift $ drawError err
+                    modify $ \ms -> ms {curAuth = auth}
+                _ -> lift $ drawMessage $ "Bad server response: " ++ show resp
+            refreshUInfoUI
 processCommand' IMMeta (CmdSolve midx) = void.runMaybeT $ do
     name <- mgetCurName
     uinfo <- mgetUInfo name
     idx <- msum [ liftMaybe midx
-	, askLockIndex "Solve which lock?" "No lock to solve!" (\i -> isJust $ userLocks uinfo ! i) ]
+        , askLockIndex "Solve which lock?" "No lock to solve!" (\i -> isJust $ userLocks uinfo ! i) ]
     ls <- liftMaybe $ lockSpec <$> userLocks uinfo ! idx
     undecls <- lift (gets undeclareds)
     msum [ do
-	    undecl <- liftMaybe $ find (\(Undeclared _ ls' _) -> ls == ls') undecls
-	    MaybeT $ gets curAuth
-	    confirmOrBail "Declare existing solution?"
-	    void.lift.runMaybeT $ -- ignores MaybeT failures
-		declare undecl
-	, do
-	    RCLock lock <- MaybeT $ getFreshRecBlocking $ RecLock ls
-	    mpartial <- Map.lookup ls <$> gets partialSolutions
-	    soln <- solveLockSaving ls mpartial False lock $ Just $
-		"solving " ++ name ++ ":" ++ [lockIndexChar idx] ++ "  (#" ++ show ls ++")"
-	    mourName <- lift $ (authUser <$>) <$> gets curAuth
-	    guard $ mourName /= Just name
-	    let undecl = Undeclared soln ls (ActiveLock name idx)
-	    msum [ do
-		    MaybeT $ gets curAuth
-		    confirmOrBail "Declare solution?"
-		    declare undecl
-		, unless (any (\(Undeclared _ ls' _) -> ls == ls') undecls) $
-		    modify $ \ms -> ms { undeclareds = (undecl : undeclareds ms) }
-		]
-	]
+            undecl <- liftMaybe $ find (\(Undeclared _ ls' _) -> ls == ls') undecls
+            MaybeT $ gets curAuth
+            confirmOrBail "Declare existing solution?"
+            void.lift.runMaybeT $ -- ignores MaybeT failures
+                declare undecl
+        , do
+            RCLock lock <- MaybeT $ getFreshRecBlocking $ RecLock ls
+            mpartial <- Map.lookup ls <$> gets partialSolutions
+            soln <- solveLockSaving ls mpartial False lock $ Just $
+                "solving " ++ name ++ ":" ++ [lockIndexChar idx] ++ "  (#" ++ show ls ++")"
+            mourName <- lift $ (authUser <$>) <$> gets curAuth
+            guard $ mourName /= Just name
+            let undecl = Undeclared soln ls (ActiveLock name idx)
+            msum [ do
+                    MaybeT $ gets curAuth
+                    confirmOrBail "Declare solution?"
+                    declare undecl
+                , unless (any (\(Undeclared _ ls' _) -> ls == ls') undecls) $
+                    modify $ \ms -> ms { undeclareds = (undecl : undeclareds ms) }
+                ]
+        ]
 processCommand' IMMeta (CmdPlayLockSpec mls) = void.runMaybeT $ do
     ls <- msum [ liftMaybe mls
-	, do
-	    tls <- MaybeT . lift $ textInput "Lock number:" 16 False False Nothing Nothing
-	    liftMaybe $ readMay tls
-	]
+        , do
+            tls <- MaybeT . lift $ textInput "Lock number:" 16 False False Nothing Nothing
+            liftMaybe $ readMay tls
+        ]
     RCLock lock <- MaybeT $ getFreshRecBlocking $ RecLock ls
     solveLock lock $ Just $ "solving " ++ show ls
 
@@ -350,76 +350,76 @@
     undecls <- lift $ gets undeclareds
     guard $ not $ null undecls
     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
-	    liftMaybe $ msum
-		[ do
-		    i <- readMay which
-		    guard $ 0 < i && i <= length undecls
-		    return $ undecls !! (i-1)
-		, listToMaybe $
-		    [ undecl
-		    | undecl@(Undeclared _ _ (ActiveLock name' i)) <- undecls
-		    , or
-			[ take (length which) (name' ++ ":" ++ [lockIndexChar i]) ==
-			    map toUpper which
-			, name'==name && [lockIndexChar i] == which
-			]
-		    ]
-		]
-	]
+        , if length undecls == 1
+        then return $ head undecls
+        else do
+            which <- MaybeT $ lift $ textInput
+                ("Declare which solution?")
+                5 False True Nothing Nothing
+            liftMaybe $ msum
+                [ do
+                    i <- readMay which
+                    guard $ 0 < i && i <= length undecls
+                    return $ undecls !! (i-1)
+                , listToMaybe $
+                    [ undecl
+                    | undecl@(Undeclared _ _ (ActiveLock name' i)) <- undecls
+                    , or
+                        [ take (length which) (name' ++ ":" ++ [lockIndexChar i]) ==
+                            map toUpper which
+                        , name'==name && [lockIndexChar i] == which
+                        ]
+                    ]
+                ]
+        ]
 processCommand' IMMeta (CmdViewSolution mnote) = void.runMaybeT $ do
     note <- liftMaybe mnote `mplus` do
-	ourName <- mgetOurName
-	name <- mgetCurName
-	uinfo <- mgetUInfo name
-	noteses <- lift $ sequence
-	    [ case mlockinfo of
-		Nothing -> return []
-		Just lockinfo -> (++lockSolutions lockinfo) <$> do
-			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
-	    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
-	liftMaybe $ find ((==author).noteAuthor) notes
+        ourName <- mgetOurName
+        name <- mgetCurName
+        uinfo <- mgetUInfo name
+        noteses <- lift $ sequence
+            [ case mlockinfo of
+                Nothing -> return []
+                Just lockinfo -> (++lockSolutions lockinfo) <$> do
+                        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
+            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
+        liftMaybe $ find ((==author).noteAuthor) notes
     let ActiveLock name idx = noteOn note
     uinfo <- mgetUInfo name
     ls <- lockSpec <$> MaybeT (return $ userLocks uinfo ! idx)
     RCLock lock <- MaybeT $ getFreshRecBlocking $ RecLock ls
     RCSolution soln <- MaybeT $ getFreshRecBlocking $ RecNote note
     lift $ execSubMainState $ newReplayState (snd.reframe$lock) soln $ Just $
-	"viewing solution by " ++ noteAuthor note ++ " to " ++ name ++ [':',lockIndexChar idx]
+        "viewing solution by " ++ noteAuthor note ++ " to " ++ name ++ [':',lockIndexChar idx]
 
 processCommand' IMMeta (CmdPlaceLock midx) = void.runMaybeT $ do
     guard =<< mourNameSelected
     ourName <- mgetOurName
     (lock,msoln) <- MaybeT (gets curLock) `mplus` do
-	ebdg <- lift.lift $ getUIBinding IMMeta CmdEdit
-	lift.lift $ drawError $ "No lock selected; '"++ebdg++"' to edit one."
-	mzero
+        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 <- (liftMaybe midx `mplus`) $
-	askLockIndex ("Place " ++ show lockpath ++ " in which slot?") "bug" $ const True
+        askLockIndex ("Place " ++ show lockpath ++ " in which slot?") "bug" $ const True
     when (isJust $ userLocks ourUInfo ! idx) $
-	confirmOrBail "Really retire existing lock?"
+        confirmOrBail "Really retire existing lock?"
     soln <- (liftMaybe msoln `mplus`) $ solveLock lock $ Just $ "testing lock"
     lift $ curServerActionAsyncThenInvalidate
-	(SetLock lock idx soln)
-	(Just (SomeCodenames [ourName]))
+        (SetLock lock idx soln)
+        (Just (SomeCodenames [ourName]))
 
 processCommand' IMMeta CmdSelectLock = void.runMaybeT $ do
     lockdir <- liftIO $ confFilePath "locks"
@@ -436,19 +436,19 @@
     modify $ \ms -> ms { listOffset = max 0 $ listOffset ms - 1 }
 processCommand' IMMeta CmdEdit = void.runMaybeT $ do
     (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)
+        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)
     not <$> liftIO hasLocks >>? do
         lift.lift $ withNoBG $ showHelp IMEdit HelpPageFirstEdit >>? do
             void $ textInput
@@ -456,59 +456,59 @@
                 1 False True Nothing Nothing
     path <- lift $ gets curLockPath
     newPath <- MaybeT $ (esPath <$>) $ execSubMainState $
-	newEditState (reframe lock) msoln (if null path then Nothing else Just path)
+        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"
     tuts <- liftIO $ (sort . map (takeWhile (/='.')) . filter (isSuffixOf ".lock")) <$>
-	getDirectoryContents tutdir `catchIO` (const $ return [])
+        getDirectoryContents tutdir `catchIO` (const $ return [])
     when (null tuts) $ do
-	lift.lift $ drawError "No tutorial levels found"
-	mzero
+        lift.lift $ drawError "No tutorial levels found"
+        mzero
     -- s <- MaybeT $ lift $ textInput ("Play which tutorial level? [1-"++show (length tuts)++"]")
-	    -- (length (show (length tuts))) False True Nothing Nothing
+            -- (length (show (length tuts))) False True Nothing Nothing
     -- i <- liftMaybe $ readMay s
     -- guard $ 1 <= i && i <= length tuts
     let dotut i msps = do
-	let name = tuts !! (i-1)
-	let pref = tutdir ++ [pathSeparator] ++ name
-	(lock,_) <- MaybeT $ liftIO $ readLock (pref ++ ".lock")
-	text <- liftIO $ (fromMaybe "" . listToMaybe) <$> (readStrings (pref ++ ".text") `catchIO` const (return []))
-	solveLockSaving i msps True 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) Nothing
-	    else lift $ do
-		modify $ \ms -> ms {tutProgress = (1,Nothing)}
-		mauth <- gets curAuth
-		cbdg <- lift $ getUIBinding IMMeta $ CmdSelCodename Nothing
-		rbdg <- lift $ getUIBinding IMMeta (CmdRegister False)
-		if isNothing mauth
-		    then do
-			let showPage p prompt = lift $ withNoBG $ showHelp IMMeta p >>? do
-				void $ textInput prompt 1 False True Nothing Nothing
-                        showPage (HelpPageInitiated 1) "[Tutorial complete! Press a key or RMB to continue]"
-                        showPage (HelpPageInitiated 2) "[Press a key or RMB to continue]"
-                        showPage (HelpPageInitiated 3) "[Press a key or RMB to continue]"
-			--showPage HelpPageGame "[Press a key or RMB to continue; you can review this information later with '?']"
-			lift $ drawMessage $ 
-			    "To join the game: pick a codename ('"++cbdg++
-			    "') and register it ('"++rbdg++"')."
-		    else lift $ drawMessage $ "Tutorial completed!"
-    
+            let name = tuts !! (i-1)
+            let pref = tutdir ++ [pathSeparator] ++ name
+            (lock,_) <- MaybeT $ liftIO $ readLock (pref ++ ".lock")
+            text <- liftIO $ (fromMaybe "" . listToMaybe) <$> (readStrings (pref ++ ".text") `catchIO` const (return []))
+            solveLockSaving i msps True 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) Nothing
+                else lift $ do
+                    modify $ \ms -> ms {tutProgress = (1,Nothing)}
+                    mauth <- gets curAuth
+                    cbdg <- lift $ getUIBinding IMMeta $ CmdSelCodename Nothing
+                    rbdg <- lift $ getUIBinding IMMeta (CmdRegister False)
+                    if isNothing mauth
+                        then do
+                            let showPage p prompt = lift $ withNoBG $ showHelp IMMeta p >>? do
+                                    void $ textInput prompt 1 False True Nothing Nothing
+                            showPage (HelpPageInitiated 1) "[Tutorial complete! Press a key or RMB to continue]"
+                            showPage (HelpPageInitiated 2) "[Press a key or RMB to continue]"
+                            showPage (HelpPageInitiated 3) "[Press a key or RMB to continue]"
+                            --showPage HelpPageGame "[Press a key or RMB to continue; you can review this information later with '?']"
+                            lift $ drawMessage $ 
+                                "To join the game: pick a codename ('"++cbdg++
+                                "') and register it ('"++rbdg++"')."
+                        else lift $ drawMessage $ "Tutorial completed!"
+        
     (onLevel,msps) <- lift $ gets tutProgress
     dotut onLevel msps
 processCommand' IMMeta CmdShowRetired = void.runMaybeT $ do
     name <- mgetCurName
     newRL <- lift (gets retiredLocks) >>= \rl -> case rl of
-	Nothing -> do
-	    RCLockSpecs lss <- MaybeT $ getFreshRecBlocking $ RecRetiredLocks name
-	    if null lss
-		then do
-		    lift.lift $ drawError "Player has no retired locks."
-		    return Nothing
-		else return $ Just lss
-	Just _ -> return Nothing
+        Nothing -> do
+            RCLockSpecs lss <- MaybeT $ getFreshRecBlocking $ RecRetiredLocks name
+            if null lss
+                then do
+                    lift.lift $ drawError "Player has no retired locks."
+                    return Nothing
+                else return $ Just lss
+        Just _ -> return Nothing
     lift $ modify $ \ms -> ms {retiredLocks = newRL}
 
 processCommand' IMPlay CmdUndo = do
@@ -516,35 +516,35 @@
     stack <- gets psGameStateMoveStack
     ustms <- gets psUndoneStack
     unless (null stack) $ do
-	let (st',pm) = head stack
-	modify $ \ps -> ps {psCurrentState=st', psGameStateMoveStack = tail stack,
-	    psLastAlerts = [], psUndoneStack = (st,pm):ustms}
+        let (st',pm) = head stack
+        modify $ \ps -> ps {psCurrentState=st', psGameStateMoveStack = tail stack,
+            psLastAlerts = [], psUndoneStack = (st,pm):ustms}
 processCommand' IMPlay CmdRedo = do
     ustms <- gets psUndoneStack
     case ustms of
-	[] -> return ()
-	ustm@(_,pm):ustms' -> do
-	    st <- gets psCurrentState
-	    (st',alerts) <- lift $ doPhysicsTick pm st
-	    pushPState (st',pm)
-	    modify $ \ps -> ps {psLastAlerts = alerts, psUndoneStack = ustms'}
+        [] -> return ()
+        ustm@(_,pm):ustms' -> do
+            st <- gets psCurrentState
+            (st',alerts) <- lift $ doPhysicsTick pm st
+            pushPState (st',pm)
+            modify $ \ps -> ps {psLastAlerts = alerts, psUndoneStack = ustms'}
 processCommand' IMPlay (CmdManipulateToolAt pos) = do
     board <- stateBoard <$> gets psCurrentState
     wsel <- gets wrenchSelected
     void.runMaybeT $ msum $ [ do
-	    tile <- liftMaybe $ snd <$> Map.lookup pos board
-	    guard $ case tile of {WrenchTile _ -> True; HookTile -> True; _ -> False}
-	    lift $ processCommand' IMPlay $ CmdTile tile
-	] ++ [ do
-	    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 ]
+            tile <- liftMaybe $ snd <$> Map.lookup pos board
+            guard $ case tile of {WrenchTile _ -> True; HookTile -> True; _ -> False}
+            lift $ processCommand' IMPlay $ CmdTile tile
+        ] ++ [ do
+            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 ]
 processCommand' IMPlay (CmdDrag pos dir) = do
     board <- stateBoard <$> gets psCurrentState
     wsel <- gets wrenchSelected
     void.runMaybeT $ do
-	tp <- liftMaybe $ tileType . snd <$> Map.lookup pos board
+        tp <- liftMaybe $ tileType . snd <$> Map.lookup pos board
         msum [ guard $ tp == HookTile
             , do
                 guard $ tp == WrenchTile zero
@@ -556,62 +556,62 @@
                     , let pos' = d *^ dir +^ pos ]
                     ++ [ (lift.lift $ warpPointer pos) >> mzero ]
             ]
-	lift $ processCommand' IMPlay $ CmdDir WHSSelected $ dir
-	board' <- stateBoard <$> gets psCurrentState
-	msum [ do
-		tp' <- liftMaybe $ tileType . snd <$> Map.lookup pos' board'
-		guard $ tp' == if wsel then WrenchTile zero else HookTile
-		lift.lift $ warpPointer pos'
-	    | pos' <- map (+^pos) $ hexDisc 2 ]
+        lift $ processCommand' IMPlay $ CmdDir WHSSelected $ dir
+        board' <- stateBoard <$> gets psCurrentState
+        msum [ do
+                tp' <- liftMaybe $ tileType . snd <$> Map.lookup pos' board'
+                guard $ tp' == if wsel then WrenchTile zero else HookTile
+                lift.lift $ warpPointer pos'
+            | pos' <- map (+^pos) $ hexDisc 2 ]
 
 processCommand' IMPlay cmd = do
     wsel <- gets wrenchSelected
     st <- gets psCurrentState
     let push whs dir
-	    | whs == WHSWrench || (whs == WHSSelected && wsel) =
-		Just $ WrenchPush dir
-	    | otherwise = Just $ HookPush dir
-	torque whs dir
-	    {- | whs == WHSHook || (whs == WHSSelected && not wsel)=
-		Just $ HookTorque dir
-	    | otherwise = Nothing -}
-	    = Just $ HookTorque dir
-	(wsel', pm) =
-	    case cmd of
-		CmdTile (WrenchTile _) -> (True, Nothing)
-		CmdTile HookTile -> (False, Nothing)
-		CmdTile (ArmTile _ _) -> (False, Nothing)
-		CmdToggle -> (not wsel, Nothing)
-		CmdDir whs dir -> (wsel, push whs dir)
-		CmdRotate whs dir -> (wsel, torque whs dir)
-		CmdWait -> (wsel, Just NullPM)
-		CmdSelect -> (wsel, Just NullPM)
-		_ -> (wsel, Nothing)
+            | whs == WHSWrench || (whs == WHSSelected && wsel) =
+                Just $ WrenchPush dir
+            | otherwise = Just $ HookPush dir
+        torque whs dir
+            {- | whs == WHSHook || (whs == WHSSelected && not wsel)=
+                Just $ HookTorque dir
+            | otherwise = Nothing -}
+            = Just $ HookTorque dir
+        (wsel', pm) =
+            case cmd of
+                CmdTile (WrenchTile _) -> (True, Nothing)
+                CmdTile HookTile -> (False, Nothing)
+                CmdTile (ArmTile _ _) -> (False, Nothing)
+                CmdToggle -> (not wsel, Nothing)
+                CmdDir whs dir -> (wsel, push whs dir)
+                CmdRotate whs dir -> (wsel, torque whs dir)
+                CmdWait -> (wsel, Just NullPM)
+                CmdSelect -> (wsel, Just NullPM)
+                _ -> (wsel, Nothing)
     modify $ \ps -> ps {wrenchSelected = wsel'}
     case pm of
-	 Nothing -> return ()
-	 Just pm' -> do
-	    (st',alerts) <- lift $ doPhysicsTick pm' st
-	    modify $ \ps -> ps {psLastAlerts = alerts}
-	    pushPState (st',pm')
+         Nothing -> return ()
+         Just pm' -> do
+            (st',alerts) <- lift $ doPhysicsTick pm' st
+            modify $ \ps -> ps {psLastAlerts = alerts}
+            pushPState (st',pm')
 
 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}
+        , rsLastAlerts = []
+        , rsGameStateMoveStack = tail $ rsGameStateMoveStack rs
+        , rsMoveStack = pm:rsMoveStack rs}
 processCommand' IMReplay (CmdReplayBack n) = replicateM_ n $
     processCommand' IMReplay (CmdReplayBack 1)
 processCommand' IMReplay (CmdReplayForward 1) = void.runMaybeT $ do
     pm <- MaybeT $ listToMaybe <$> gets rsMoveStack
     lift $ do
-	st <- gets rsCurrentState
-	(st',alerts) <- lift $ doPhysicsTick pm st
-	modify $ \rs -> rs {rsCurrentState = st'
-	    , rsLastAlerts = alerts
-	    , rsGameStateMoveStack = (st,pm):rsGameStateMoveStack rs
-	    , rsMoveStack = tail $ rsMoveStack rs}
+        st <- gets rsCurrentState
+        (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 $
     processCommand' IMReplay (CmdReplayForward 1)
 processCommand' IMReplay CmdUndo = processCommand' IMReplay (CmdReplayBack 1)
@@ -629,8 +629,8 @@
     mpath <- gets esPath
     st <- gets $ head.esGameStateStack
     void.runMaybeT $ do
-	soln <- solveLock (frame,st) $ Just $ "testing " ++ fromMaybe "[unnamed lock]" mpath
-	lift $ modify $ \es -> es { esTested = Just (st, soln) }
+        soln <- solveLock (frame,st) $ Just $ "testing " ++ fromMaybe "[unnamed lock]" mpath
+        lift $ modify $ \es -> es { esTested = Just (st, soln) }
 processCommand' IMEdit CmdUndo = do
     st:sts <- gets esGameStateStack
     usts <- gets esUndoneStack
@@ -638,10 +638,10 @@
 processCommand' IMEdit CmdRedo = do
     usts <- gets esUndoneStack
     case usts of
-	[] -> return ()
-	ust:usts' -> do
-	    pushEState ust
-	    modify $ \es -> es {esUndoneStack = usts'}
+        [] -> return ()
+        ust:usts' -> do
+            pushEState ust
+            modify $ \es -> es {esUndoneStack = usts'}
 processCommand' IMEdit CmdUnselect =
     modify $ \es -> es {selectedPiece = Nothing}
 processCommand' IMEdit CmdSelect = do
@@ -649,37 +649,37 @@
     selPos <- gets selectedPos
     st:_ <- gets esGameStateStack
     let selPiece' =
-	    if isJust selPiece
-		then Nothing
-		else liftM fst $ Map.lookup selPos $ stateBoard st
+            if isJust selPiece
+                then Nothing
+                else liftM fst $ Map.lookup selPos $ stateBoard st
     modify $ \es -> es {selectedPiece = selPiece'}
 processCommand' IMEdit (CmdDir _ dir) = do
     selPos <- gets selectedPos
     selPiece <- gets selectedPiece
     frame <- gets esFrame
     case selPiece of
-	Nothing -> modify $ \es -> es {selectedPos = checkEditable frame selPos $ dir +^ selPos}
-	Just p -> doForce $ Push p dir
+        Nothing -> modify $ \es -> es {selectedPos = checkEditable frame selPos $ dir +^ selPos}
+        Just p -> doForce $ Push p dir
 processCommand' IMEdit (CmdMoveTo newPos) =
     setSelectedPos newPos
 processCommand' IMEdit (CmdDrag pos dir) = do
     board <- stateBoard.head <$> gets esGameStateStack
     void.runMaybeT $ do
-	selIdx <- MaybeT $ gets selectedPiece
-	idx <- liftMaybe $ fst <$> Map.lookup pos board
-	guard $ idx == selIdx
-	lift $ processCommand' IMEdit $ CmdDir WHSSelected $ dir
-	board' <- stateBoard.head <$> gets esGameStateStack
-	msum [ do
-		idx' <- liftMaybe $ fst <$> Map.lookup pos' board'
-		guard $ idx' == selIdx
-		lift.lift $ warpPointer $ pos'
-	    | pos' <- [dir+^pos, pos] ]
+        selIdx <- MaybeT $ gets selectedPiece
+        idx <- liftMaybe $ fst <$> Map.lookup pos board
+        guard $ idx == selIdx
+        lift $ processCommand' IMEdit $ CmdDir WHSSelected $ dir
+        board' <- stateBoard.head <$> gets esGameStateStack
+        msum [ do
+                idx' <- liftMaybe $ fst <$> Map.lookup pos' board'
+                guard $ idx' == selIdx
+                lift.lift $ warpPointer $ pos'
+            | pos' <- [dir+^pos, pos] ]
 processCommand' IMEdit (CmdRotate _ dir) = do
     selPiece <- gets selectedPiece
     case selPiece of
-	Nothing -> return ()
-	Just p -> doForce $ Torque p dir
+        Nothing -> return ()
+        Just p -> doForce $ Torque p dir
 processCommand' IMEdit (CmdTile tile) = do
     selPos <- gets selectedPos
     drawTile selPos (Just tile) False
@@ -694,16 +694,16 @@
     st:_ <- gets esGameStateStack
     lift $ drawMessage "Merge in which direction?"
     let getDir = do
-	cmd <- lift $ head <$> getSomeInput IMEdit
-	case cmd of
-	    CmdDir _ mergeDir -> return $ Just mergeDir
-	    CmdDrag _ mergeDir -> return $ Just mergeDir
-	    CmdMoveTo _ -> getDir
-	    _ -> return $ Nothing
+            cmd <- lift $ head <$> getSomeInput IMEdit
+            case cmd of
+                CmdDir _ mergeDir -> return $ Just mergeDir
+                CmdDrag _ mergeDir -> return $ Just mergeDir
+                CmdMoveTo _ -> getDir
+                _ -> return $ Nothing
     mergeDir <- getDir
     case mergeDir of
-	Just mergeDir -> modifyEState $ mergeTiles selPos mergeDir True
-	_ -> return ()
+        Just mergeDir -> modifyEState $ mergeTiles selPos mergeDir True
+        _ -> return ()
     -- XXX: merging might invalidate selectedPiece
     modify $ \es -> es {selectedPiece = Nothing}
     lift $ drawMessage ""
@@ -717,26 +717,26 @@
     selPiece <- gets selectedPiece
     st:_ <- gets esGameStateStack
     case selPiece of
-	Nothing -> drawTile selPos Nothing False
-	Just p -> do modify $ \es -> es {selectedPiece = Nothing}
-		     modifyEState $ delPiece p
+        Nothing -> drawTile selPos Nothing False
+        Just p -> do modify $ \es -> es {selectedPiece = Nothing}
+                     modifyEState $ delPiece p
 processCommand' IMEdit CmdWriteState = void.runMaybeT $ do
     path <- lift $ gets esPath
     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)) >>?
-	confirmOrBail $ "Really overwrite '"++fullPath++"'?"
+        confirmOrBail $ "Really overwrite '"++fullPath++"'?"
     lift $ do
-	st <- gets $ head.esGameStateStack
-	frame <- gets esFrame
-	msoln <- getCurTestSoln
-	merr <- liftIO $ ((writeAsciiLockFile fullPath msoln $ canonify (frame, st)) >> return Nothing)
-	    `catchIO` (return . Just . show)
-	modify $ \es -> es {lastSavedState = Just (st,isJust msoln)}
-	case merr of
-	    Nothing -> modify $ \es -> es {esPath = Just newPath}
-	    Just err -> lift $ drawError $ "Write failed: "++err
+        st <- gets $ head.esGameStateStack
+        frame <- gets esFrame
+        msoln <- getCurTestSoln
+        merr <- liftIO $ ((writeAsciiLockFile fullPath msoln $ canonify (frame, st)) >> return Nothing)
+            `catchIO` (return . Just . show)
+        modify $ \es -> es {lastSavedState = Just (st,isJust msoln)}
+        case merr of
+            Nothing -> modify $ \es -> es {esPath = Just newPath}
+            Just err -> lift $ drawError $ "Write failed: "++err
 processCommand' _ _ = return ()
 
 inputPassword :: UIMonad uiM => Codename -> Bool -> String -> MaybeT (MainStateT uiM) String
@@ -794,12 +794,12 @@
 solveLockSaving :: UIMonad uiM => LockSpec -> Maybe SavedPlayState -> Bool -> Lock -> Maybe String -> MaybeT (MainStateT uiM) Solution
 solveLockSaving ls msps isTut lock title = do
     (InteractSuccess solved, ps) <- lift $ runSubMainState $
-	((maybe newPlayState restorePlayState) msps) (reframe lock) title isTut False True
+        ((maybe newPlayState restorePlayState) msps) (reframe lock) title isTut False True
     if solved
-	then do
-	    unless isTut $ lift $ modify $ \ms -> ms { partialSolutions = Map.delete ls $ partialSolutions ms }
-	    return $ reverse $ (map snd) $ psGameStateMoveStack ps
-	else do
-	    lift $ modify $ \ms -> if isTut then ms { tutProgress = (ls,Just $ savePlayState ps) }
-		else ms { partialSolutions = Map.insert ls (savePlayState ps) $ partialSolutions ms }
-	    mzero
+        then do
+            unless isTut $ lift $ modify $ \ms -> ms { partialSolutions = Map.delete ls $ partialSolutions ms }
+            return $ reverse $ (map snd) $ psGameStateMoveStack ps
+        else do
+            lift $ modify $ \ms -> if isTut then ms { tutProgress = (ls,Just $ savePlayState ps) }
+                else ms { partialSolutions = Map.insert ls (savePlayState ps) $ partialSolutions ms }
+            mzero
diff --git a/InteractUtil.hs b/InteractUtil.hs
--- a/InteractUtil.hs
+++ b/InteractUtil.hs
@@ -44,12 +44,12 @@
     wasSolved <- gets psSolved
     let solved = checkSolved (frame,st)
     when (solved /= wasSolved) $ do
-	modify $ \ps -> ps {psSolved = solved}
-	obdg <- lift $ getUIBinding IMPlay CmdOpen
-	lift $ if solved then do
-		drawMessage $ "Unlocked! '"++obdg++"' to open."
-		reportAlerts st [AlertUnlocked]
-	    else drawMessage ""
+        modify $ \ps -> ps {psSolved = solved}
+        obdg <- lift $ getUIBinding IMPlay CmdOpen
+        lift $ if solved then do
+                drawMessage $ "Unlocked! '"++obdg++"' to open."
+                reportAlerts st [AlertUnlocked]
+            else drawMessage ""
 
 doForce force = do
     st:_ <- gets esGameStateStack
@@ -64,7 +64,7 @@
     then modify $ \es -> es {lastModPos = to}
     else do
         let from' = (hexVec2HexDirOrZero $ to-^from) +^ from
-	when (inEditable frame from') $ drawTile from' tile True
+        when (inEditable frame from') $ drawTile from' tile True
         paintTilePath frame tile from' to
 
 pushEState :: UIMonad uiM => GameState -> MainStateT uiM ()
@@ -76,7 +76,7 @@
     st' <- gets psCurrentState
     stms <- gets psGameStateMoveStack
     when (st' /= st) $ modify $ \ps -> ps {psCurrentState = st,
-	    psGameStateMoveStack = (st',pm):stms, psUndoneStack = []}
+            psGameStateMoveStack = (st',pm):stms, psUndoneStack = []}
 modifyEState :: UIMonad uiM => (GameState -> GameState) -> MainStateT uiM ()
 modifyEState f = do
     st:_ <- gets esGameStateStack
@@ -91,13 +91,13 @@
 nextLock newer path = do
     lockdir <- confFilePath "locks"
     time <- (Just <$> (fullLockPath path >>= getModificationTime))
-	`catchIO` const (return Nothing)
+        `catchIO` const (return Nothing)
     paths <- getDirContentsRec lockdir
     maybe path (drop (length lockdir + 1) . fst) . listToMaybe .
-	(if newer then id else reverse) . sortBy (compare `on` snd) .
-	filter (maybe (const True)
-	    (\x y -> (if newer then (<) else (>)) x (snd y)) time) <$>
-	(\p -> (,) p <$> getModificationTime p) `mapM` paths
+        (if newer then id else reverse) . sortBy (compare `on` snd) .
+        filter (maybe (const True)
+            (\x y -> (if newer then (<) else (>)) x (snd y)) time) <$>
+        (\p -> (,) p <$> getModificationTime p) `mapM` paths
 
 hasLocks :: IO Bool
 hasLocks = do
@@ -116,17 +116,17 @@
         [ CmdPlaceLock Nothing, CmdEdit, CmdHome ]
     haveLock <- isJust <$> gets curLock
     idx <- askLockIndex "Secure behind which lock?"
-	(if haveLock
+        (if haveLock
             then "First you must place ('"++pbdg++"') a lock to secure your solution behind, while at home ('"++hbdg++"')."
             else "First design a lock in the editor ('"++ebdg++"'), behind which to secure your solution.")
-	(\i -> isJust $ userLocks ourUInfo ! i)
+        (\i -> isJust $ userLocks ourUInfo ! i)
     guard $ isJust $ userLocks ourUInfo ! 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.
-	(Just AllCodenames)
+        (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.
+        (Just AllCodenames)
 
 startMark = '^'
 
@@ -143,22 +143,22 @@
 jumpMark ch = do
     mst <- get
     void.runMaybeT $ case ms2im mst of
-	IMEdit -> do
-	    st <- liftMaybe $ ch `Map.lookup` esMarks mst
-	    lift $ setMark True '\'' >> pushEState st
-	IMPlay -> do
-	    mst' <- liftMaybe $ ch `Map.lookup` psMarks mst
-	    put mst' { psMarks = Map.insert '\'' mst $ psMarks mst }
-	IMReplay -> do
-	    mst' <- liftMaybe $ ch `Map.lookup` rsMarks mst
-	    put mst' { rsMarks = Map.insert '\'' mst $ rsMarks mst }
-	_ -> return ()
+        IMEdit -> do
+            st <- liftMaybe $ ch `Map.lookup` esMarks mst
+            lift $ setMark True '\'' >> pushEState st
+        IMPlay -> do
+            mst' <- liftMaybe $ ch `Map.lookup` psMarks mst
+            put mst' { psMarks = Map.insert '\'' mst $ psMarks mst }
+        IMReplay -> do
+            mst' <- liftMaybe $ ch `Map.lookup` rsMarks mst
+            put mst' { rsMarks = Map.insert '\'' mst $ rsMarks mst }
+        _ -> return ()
 
 setMark :: (Monad m) => Bool -> Char -> MainStateT m ()
 setMark overwrite ch = get >>= \mst -> case mst of
     -- ugh... remind me why I'm not using lens?
     EditState { esMarks = marks, esGameStateStack = (st:_) } ->
-	put $ mst { esMarks = insertMark ch st marks }
+        put $ mst { esMarks = insertMark ch st marks }
     PlayState {} -> put $ mst { psMarks = insertMark ch mst $ psMarks mst }
     ReplayState {} -> put $ mst { rsMarks = insertMark ch mst $ rsMarks mst }
     _ -> return ()
@@ -168,15 +168,15 @@
 askLockIndex prompt failMessage pred = do
     let ok = filter pred [0,1,2]
     case length ok of
-	0 -> (lift.lift) (drawError failMessage) >> mzero
-	1 -> return $ head ok
-	_ -> ask ok
+        0 -> (lift.lift) (drawError failMessage) >> mzero
+        1 -> return $ head ok
+        _ -> ask ok
     where
-	ask ok = do
-	    let prompt' = prompt ++ " [" ++ intersperse ',' (map lockIndexChar ok) ++ "]"
-	    idx <- MaybeT $ lift $ join . (((charLockIndex<$>).listToMaybe)<$>) <$>
-		textInput prompt' 1 False True Nothing Nothing
-	    if idx `elem` ok then return idx else ask ok
+        ask ok = do
+            let prompt' = prompt ++ " [" ++ intersperse ',' (map lockIndexChar ok) ++ "]"
+            idx <- MaybeT $ lift $ join . (((charLockIndex<$>).listToMaybe)<$>) <$>
+                textInput prompt' 1 False True Nothing Nothing
+            if idx `elem` ok then return idx else ask ok
 confirmOrBail :: UIMonad uiM => String -> MaybeT (MainStateT uiM) ()
 confirmOrBail prompt = (guard =<<) $ lift.lift $ confirm prompt
 confirm :: UIMonad uiM => String -> uiM Bool
@@ -185,72 +185,72 @@
     setYNButtons
     waitConfirm <* endPrompt
     where
-	waitConfirm = do
-	    cmds <- getInput IMTextInput
-	    case msum $ map ansOfCmd cmds of
-		Just answer -> return answer
-		Nothing -> waitConfirm
-	ansOfCmd (CmdInputChar 'y') = Just True
-	ansOfCmd (CmdInputChar 'Y') = Just True
-	ansOfCmd (CmdInputChar c) = if isPrint c then Just False else Nothing
-	ansOfCmd CmdRedraw = Just False
-	ansOfCmd CmdRefresh = Nothing
-	ansOfCmd CmdUnselect = Nothing
-	ansOfCmd _ = Just False
+        waitConfirm = do
+            cmds <- getInput IMTextInput
+            case msum $ map ansOfCmd cmds of
+                Just answer -> return answer
+                Nothing -> waitConfirm
+        ansOfCmd (CmdInputChar 'y') = Just True
+        ansOfCmd (CmdInputChar 'Y') = Just True
+        ansOfCmd (CmdInputChar c) = if isPrint c then Just False else Nothing
+        ansOfCmd CmdRedraw = Just False
+        ansOfCmd CmdRefresh = Nothing
+        ansOfCmd CmdUnselect = Nothing
+        ansOfCmd _ = Just False
 
 -- | TODO: draw cursor
 textInput :: UIMonad uiM => String -> Int -> Bool -> Bool -> Maybe [String] -> Maybe String -> uiM (Maybe String)
 textInput prompt maxlen hidden endOnMax mposss init = getText (fromMaybe "" init, Nothing) <* endPrompt
     where
-	getText :: UIMonad uiM => (String, Maybe String) -> uiM (Maybe String)
-	getText (s,mstem) = do
-	    drawPrompt (length s == maxlen) $ prompt ++ " " ++ if hidden then replicate (length s) '*' else s
-	    if endOnMax && isNothing mstem && maxlen <= length s
-	    then return $ Just $ take maxlen s
-	    else do
-		cmds <- getInput IMTextInput
-		case foldM applyCmd (s,mstem) cmds of
-		    Left False -> return Nothing
-		    Left True -> return $ Just s
-		    Right (s',mstem') -> getText (s',mstem')
-	    where
-		applyCmd (s,mstem) (CmdInputChar c) = case c of
-		    '\ESC' -> Left False
-		    '\a' -> Left False -- ^G
-		    '\ETX' -> Left False -- ^C
-		    '\n' -> Left True
-		    '\r' -> Left True
-		    '\NAK' -> Right ("",Nothing)  -- ^U
-		    '\b' -> Right $ (take (length s - 1) s, Nothing)
-		    '\DEL' -> Right $ (take (length s - 1) s, Nothing)
-		    '\t' -> case mposss of
-			Nothing -> Right (s,mstem)
-			Just possibilities -> case mstem of
-			    Nothing -> let
-				completions = filter (completes s) possibilities
-				pref = if null completions then s else
-				    let c = head completions
-				    in head [ c' | n <- reverse [0..length c],
-					let c'=take n c, all (completes c') completions ]
-				in Right (pref,Just pref)
-			    Just stem -> let
-				completions = filter (completes stem) possibilities
-				later = filter (>s) completions
-				s' | null completions = s
-				   | null later = head completions
-				   | otherwise = minimum later
-				in Right (s',mstem)
-		    _ -> Right $ if isPrint c
-			    then ((if length s >= maxlen then id else (++[c])) s, Nothing)
-			    else (s,mstem)
-		applyCmd x (CmdInputSelLock idx) =
+        getText :: UIMonad uiM => (String, Maybe String) -> uiM (Maybe String)
+        getText (s,mstem) = do
+            drawPrompt (length s == maxlen) $ prompt ++ " " ++ if hidden then replicate (length s) '*' else s
+            if endOnMax && isNothing mstem && maxlen <= length s
+            then return $ Just $ take maxlen s
+            else do
+                cmds <- getInput IMTextInput
+                case foldM applyCmd (s,mstem) cmds of
+                    Left False -> return Nothing
+                    Left True -> return $ Just s
+                    Right (s',mstem') -> getText (s',mstem')
+            where
+                applyCmd (s,mstem) (CmdInputChar c) = case c of
+                    '\ESC' -> Left False
+                    '\a' -> Left False -- ^G
+                    '\ETX' -> Left False -- ^C
+                    '\n' -> Left True
+                    '\r' -> Left True
+                    '\NAK' -> Right ("",Nothing)  -- ^U
+                    '\b' -> Right $ (take (length s - 1) s, Nothing)
+                    '\DEL' -> Right $ (take (length s - 1) s, Nothing)
+                    '\t' -> case mposss of
+                        Nothing -> Right (s,mstem)
+                        Just possibilities -> case mstem of
+                            Nothing -> let
+                                completions = filter (completes s) possibilities
+                                pref = if null completions then s else
+                                    let c = head completions
+                                    in head [ c' | n <- reverse [0..length c],
+                                        let c'=take n c, all (completes c') completions ]
+                                in Right (pref,Just pref)
+                            Just stem -> let
+                                completions = filter (completes stem) possibilities
+                                later = filter (>s) completions
+                                s' | null completions = s
+                                   | null later = head completions
+                                   | otherwise = minimum later
+                                in Right (s',mstem)
+                    _ -> Right $ if isPrint c
+                            then ((if length s >= maxlen then id else (++[c])) s, Nothing)
+                            else (s,mstem)
+                applyCmd x (CmdInputSelLock idx) =
                     setTextOrSubmit x $ [lockIndexChar idx]
-		applyCmd x (CmdInputSelUndecl (Undeclared _ _ (ActiveLock name idx))) =
+                applyCmd x (CmdInputSelUndecl (Undeclared _ _ (ActiveLock name idx))) =
                     setTextOrSubmit x $ name++[':',lockIndexChar idx]
-		applyCmd x (CmdInputCodename name) =
+                applyCmd x (CmdInputCodename name) =
                     setTextOrSubmit x $ name
-		applyCmd x CmdRefresh = Right x
-		applyCmd x CmdUnselect = Right x
-		applyCmd _ _ = Left False
-	completes s s' = take (length s) s' == s
+                applyCmd x CmdRefresh = Right x
+                applyCmd x CmdUnselect = Right x
+                applyCmd _ _ = Left False
+        completes s s' = take (length s) s' == s
         setTextOrSubmit (s,_) t = if s == t then Left True else Right (t,Nothing)
diff --git a/Lock.hs b/Lock.hs
--- a/Lock.hs
+++ b/Lock.hs
@@ -50,8 +50,8 @@
 checkSolution :: Lock -> Solution -> Bool
 checkSolution lock pms =
     let (frame,st) = reframe lock
-	tick :: GameState -> PlayerMove -> GameState
-	tick st pm = fst . runWriter $ physicsTick pm st
+        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
@@ -63,12 +63,12 @@
 canonify = addTools . stabilise . delTools . delOOB
 delTools :: Lock -> Lock
 delTools = liftLock delTools' where
-	delTools' :: GameState -> GameState
-	delTools' st =
-	    fromMaybe st $ listToMaybe 
-		[ delTools' $ delPiece idx st
-		| (idx,pp) <- enumVec $ placedPieces st
-		, isTool $ placedPiece pp ]
+        delTools' :: GameState -> GameState
+        delTools' 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
@@ -79,16 +79,16 @@
 -- to being of natural length, and none get further from it.
 stabilise :: Lock -> Lock
 stabilise = liftLock stabilise' where
-	stabilise' :: GameState -> GameState
-	stabilise' st =
-	    let st' = stepPhysics st
-	    in if st == st' then st else stabilise' st'
+        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) =
     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]
+        [ delOOB $ liftLock (delPiece idx) l
+        | (idx,_) <- enumVec $ placedPieces st
+        , not $ isFrame idx
+        , all (not.inBounds f) $ fullFootprint st idx
+        , null $ springsEndAtIdx st idx]
diff --git a/MainState.hs b/MainState.hs
--- a/MainState.hs
+++ b/MainState.hs
@@ -72,65 +72,65 @@
 
     doUI :: m a -> IO (Maybe a)
     doUI m = runUI $ do
-	ok <- initUI
-	if ok then m >>= (endUI >>).return.Just else return Nothing
+        ok <- initUI
+        if ok then m >>= (endUI >>).return.Just else return Nothing
 
 -- | this could be neatened using GADTs
 data MainState
     = PlayState
-	{ psCurrentState::GameState
-	, psFrame::Frame
-	, psLastAlerts::[Alert]
-	, wrenchSelected::Bool
-	, psSolved::Bool
-	, psGameStateMoveStack::[(GameState, PlayerMove)]
-	, psUndoneStack::[(GameState, PlayerMove)]
-	, psTitle::Maybe String
-	, psIsTut::Bool
-	, psIsSub::Bool
-	, psSaved::Bool
-	, psMarks::Map Char MainState
-	}
+        { psCurrentState::GameState
+        , psFrame::Frame
+        , psLastAlerts::[Alert]
+        , wrenchSelected::Bool
+        , psSolved::Bool
+        , psGameStateMoveStack::[(GameState, PlayerMove)]
+        , psUndoneStack::[(GameState, PlayerMove)]
+        , psTitle::Maybe String
+        , psIsTut::Bool
+        , psIsSub::Bool
+        , psSaved::Bool
+        , psMarks::Map Char MainState
+        }
     | ReplayState
-	{ rsCurrentState::GameState
-	, rsLastAlerts::[Alert]
-	, rsMoveStack::[PlayerMove]
-	, rsGameStateMoveStack::[(GameState, PlayerMove)]
-	, rsTitle::Maybe String
-	, rsMarks::Map Char MainState
-	}
+        { rsCurrentState::GameState
+        , rsLastAlerts::[Alert]
+        , rsMoveStack::[PlayerMove]
+        , rsGameStateMoveStack::[(GameState, PlayerMove)]
+        , rsTitle::Maybe String
+        , rsMarks::Map Char MainState
+        }
     | EditState
-	{ esGameStateStack::[GameState]
-	, esUndoneStack::[GameState]
-	, esFrame::Frame
-	, esPath::Maybe FilePath
-	, esTested::Maybe (GameState,Solution)
-	, lastSavedState::Maybe (GameState, Bool)
-	, selectedPiece::Maybe PieceIdx
-	, selectedPos::HexPos
-	, lastModPos::HexPos
-	, esMarks::Map Char GameState
-	}
+        { esGameStateStack::[GameState]
+        , esUndoneStack::[GameState]
+        , esFrame::Frame
+        , esPath::Maybe FilePath
+        , esTested::Maybe (GameState,Solution)
+        , lastSavedState::Maybe (GameState, Bool)
+        , selectedPiece::Maybe PieceIdx
+        , selectedPos::HexPos
+        , lastModPos::HexPos
+        , esMarks::Map Char GameState
+        }
     | MetaState
-	{ curServer :: ServerAddr
-	, undeclareds :: [Undeclared]
-	, partialSolutions :: PartialSolutions
-	, tutProgress :: TutProgress
-	, cacheOnly :: Bool
-	, curAuth :: Maybe Auth
-	, codenameStack :: [Codename]
-	, newAsync :: TVar Bool
-	, asyncCount :: TVar Int
-	, asyncError :: TVar (Maybe String)
-	, asyncInvalidate :: TVar (Maybe Codenames)
-	, randomCodenames :: TVar [Codename]
-	, userInfoTVs :: Map Codename (TVar FetchedRecord, UTCTime)
-	, indexedLocks :: Map LockSpec (TVar FetchedRecord)
-	, retiredLocks :: Maybe [LockSpec]
-	, curLockPath :: FilePath
-	, curLock :: Maybe (Lock,Maybe Solution)
-	, listOffset :: Int
-	}
+        { curServer :: ServerAddr
+        , undeclareds :: [Undeclared]
+        , partialSolutions :: PartialSolutions
+        , tutProgress :: TutProgress
+        , cacheOnly :: Bool
+        , curAuth :: Maybe Auth
+        , codenameStack :: [Codename]
+        , newAsync :: TVar Bool
+        , asyncCount :: TVar Int
+        , asyncError :: TVar (Maybe String)
+        , asyncInvalidate :: TVar (Maybe Codenames)
+        , randomCodenames :: TVar [Codename]
+        , userInfoTVs :: Map Codename (TVar FetchedRecord, UTCTime)
+        , indexedLocks :: Map LockSpec (TVar FetchedRecord)
+        , retiredLocks :: Maybe [LockSpec]
+        , curLockPath :: FilePath
+        , curLock :: Maybe (Lock,Maybe Solution)
+        , listOffset :: Int
+        }
 
 type MainStateT = StateT MainState
 
@@ -155,7 +155,7 @@
     rnamestvar <- atomically $ newTVar []
     counttvar <- atomically $ newTVar 0
     (saddr', auth, path) <- confFilePath "metagame.conf" >>=
-	liftM (fromMaybe (defaultServerAddr, Nothing, "")) . readReadFile
+        liftM (fromMaybe (defaultServerAddr, Nothing, "")) . readReadFile
     let saddr = updateDefaultSAddr saddr'
     let names = maybeToList $ authUser <$> auth
     (undecls,partials,tut) <- readServerSolns saddr
@@ -175,20 +175,20 @@
 restorePlayState (SavedPlayState pms markPMs) (frame,st) title isTut sub saved =
     (stateAfterMoves pms) { psMarks = Map.map stateAfterMoves markPMs }
     where
-	stateAfterMoves pms = let (stack,st') = applyMoves st pms
-	    in (newPlayState (frame, st') title isTut sub saved) { psGameStateMoveStack = stack }
-	applyMoves st pms = foldl tick ([],st) pms
-	tick :: ([(GameState,PlayerMove)],GameState) -> PlayerMove -> ([(GameState,PlayerMove)],GameState)
-	tick (stack,st) pm = ((st,pm):stack,fst . runWriter $ physicsTick pm st)
+        stateAfterMoves pms = let (stack,st') = applyMoves st pms
+            in (newPlayState (frame, st') title isTut sub saved) { psGameStateMoveStack = stack }
+        applyMoves st pms = foldl tick ([],st) pms
+        tick :: ([(GameState,PlayerMove)],GameState) -> PlayerMove -> ([(GameState,PlayerMove)],GameState)
+        tick (stack,st) pm = ((st,pm):stack,fst . runWriter $ physicsTick pm st)
 
 readServerSolns :: ServerAddr -> IO ([Undeclared],PartialSolutions,TutProgress)
 readServerSolns saddr = if nullSaddr saddr then return ([],Map.empty,(1,Nothing)) else do
     undecls <- confFilePath ("undeclared" ++ [pathSeparator] ++ saddrPath saddr) >>=
-	liftM (fromMaybe []) . readReadFile
+        liftM (fromMaybe []) . readReadFile
     partials <- confFilePath ("partialSolutions" ++ [pathSeparator] ++ saddrPath saddr) >>=
-	liftM (fromMaybe Map.empty) . readReadFile
+        liftM (fromMaybe Map.empty) . readReadFile
     tut <- confFilePath "tutProgress" >>=
-	liftM (fromMaybe (1,Nothing)) . readReadFile
+        liftM (fromMaybe (1,Nothing)) . readReadFile
     return (undecls,partials,tut)
 
 writeServerSolns saddr ms@(MetaState { undeclareds=undecls,
@@ -199,11 +199,11 @@
 
 readLock :: FilePath -> IO (Maybe (Lock, Maybe Solution))
 readLock path = runMaybeT $ msum
-	[ (\l->(l,Nothing)) <$> (MaybeT $ readReadFile path)
-	, do
-	    (mlock,msoln) <- lift $ readAsciiLockFile path
-	    lock <- liftMaybe mlock
-	    return $ (lock,msoln) ]
+        [ (\l->(l,Nothing)) <$> (MaybeT $ readReadFile path)
+        , do
+            (mlock,msoln) <- lift $ readAsciiLockFile path
+            lock <- liftMaybe mlock
+            return $ (lock,msoln) ]
 -- writeLock :: FilePath -> Lock -> IO ()
 -- writeLock path lock = fullLockPath path >>= flip writeReadFile lock
 
@@ -214,12 +214,12 @@
 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 ++
-	    (if isTested then " (Tested)" else "") ++
-	    (if unsaved then " [+]" else "    ")
+        mpath <- gets esPath
+        unsaved <- editStateUnsaved
+        isTested <- isJust <$> getCurTestSoln
+        return $ Just $ "editing " ++ fromMaybe "[unnamed lock]" mpath ++
+            (if isTested then " (Tested)" else "") ++
+            (if unsaved then " [+]" else "    ")
     IMPlay -> gets psTitle
     IMReplay -> gets rsTitle
     _ -> return Nothing
@@ -248,16 +248,16 @@
 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
+        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
+        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 (MainStateT uiM) UserInfo
 mgetUInfo name = do
@@ -284,10 +284,10 @@
 mgetLock :: UIMonad uiM => LockSpec -> MaybeT (MainStateT uiM) Lock
 mgetLock ls = do
     tvar <- msum [ MaybeT $ (Map.lookup ls) <$> gets indexedLocks
-	, lift $ do
-	    tvar <- getRecordCachedFromCur True $ RecLock ls
-	    modify $ \ms -> ms { indexedLocks = Map.insert ls tvar $ indexedLocks ms }
-	    return tvar ]
+        , lift $ do
+            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
 
@@ -302,19 +302,19 @@
     lift $ modify $ \ms -> ms {retiredLocks = Nothing}
     --lift.lift $ drawMessage ""
     where
-	getRandomNames = do
-	    rnamestvar <- gets randomCodenames
-	    liftIO $ atomically $ writeTVar rnamestvar []
-	    flag <- gets newAsync
-	    saddr <- gets curServer
-	    void $ liftIO $ forkIO $ do
-		resp <- makeRequest saddr $
-		    ClientRequest protocolVersion Nothing $ GetRandomNames 19
-		case resp of
-		    ServedRandomNames names -> atomically $ do
-			    writeTVar rnamestvar names
-			    writeTVar flag True
-		    _ -> return ()
+        getRandomNames = do
+            rnamestvar <- gets randomCodenames
+            liftIO $ atomically $ writeTVar rnamestvar []
+            flag <- gets newAsync
+            saddr <- gets curServer
+            void $ liftIO $ forkIO $ do
+                resp <- makeRequest saddr $
+                    ClientRequest protocolVersion Nothing $ GetRandomNames 19
+                case resp of
+                    ServedRandomNames names -> atomically $ do
+                            writeTVar rnamestvar names
+                            writeTVar flag True
+                    _ -> return ()
 
 mourNameSelected :: (UIMonad uiM) => MaybeT (MainStateT uiM) Bool
 mourNameSelected = liftM2 (==) mgetCurName mgetOurName
@@ -324,15 +324,15 @@
     undecls' <- gets undeclareds >>= filterM ((not<$>).invalid)
     modify $ \ms -> ms { undeclareds = undecls' }
     where
-	invalid (Undeclared _ ls (ActiveLock name idx)) =
-	    (fromMaybe False <$>) $ runMaybeT $ do
-		uinfo <- mgetUInfo name
-		ourName <- mgetOurName
-		(`mplus` return True) $ do
-		    linfo <- liftMaybe $ userLocks uinfo ! idx
-		    return $ public linfo
-			|| ourName `elem` accessedBy linfo
-			|| lockSpec linfo /= ls
+        invalid (Undeclared _ ls (ActiveLock name idx)) =
+            (fromMaybe False <$>) $ runMaybeT $ do
+                uinfo <- mgetUInfo name
+                ourName <- mgetOurName
+                (`mplus` return True) $ do
+                    linfo <- liftMaybe $ userLocks uinfo ! idx
+                    return $ public linfo
+                        || ourName `elem` accessedBy linfo
+                        || lockSpec linfo /= ls
 
 
 curServerAction :: UIMonad uiM => Protocol.Action -> MainStateT uiM ServerResponse
@@ -341,8 +341,8 @@
     auth <- gets curAuth
     cOnly <- gets cacheOnly
     if cOnly then return $ ServerError "Can't contact server in cache-only mode"
-	else (fromMaybe (ServerError "Request aborted") <$>) $
-	    lift $ withImpatience $ makeRequest saddr $ ClientRequest protocolVersion auth act
+        else (fromMaybe (ServerError "Request aborted") <$>) $
+            lift $ withImpatience $ makeRequest saddr $ ClientRequest protocolVersion auth act
 
 curServerActionAsyncThenInvalidate :: UIMonad uiM => Protocol.Action -> Maybe Codenames -> MainStateT uiM ()
 curServerActionAsyncThenInvalidate act names = do
@@ -354,27 +354,27 @@
     invaltvar <- gets asyncInvalidate
     cOnly <- gets cacheOnly
     void $ liftIO $ forkIO $ do
-	atomically $ modifyTVar count (+1)
-	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
-	    _ -> atomically $ writeTVar invaltvar names
-	atomically $ writeTVar flag True
-	atomically $ modifyTVar count (+(-1))
+        atomically $ modifyTVar count (+1)
+        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
+            _ -> atomically $ writeTVar invaltvar names
+        atomically $ writeTVar flag True
+        atomically $ modifyTVar count (+(-1))
 
 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
+        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
+        invaltvar <- lift $ gets asyncInvalidate
+        names <- MaybeT $ liftIO $ atomically $
+                readTVar invaltvar <* writeTVar invaltvar Nothing
+        lift $ invalidateUInfos names >> refreshUInfoUI
 
 getRecordCachedFromCur :: UIMonad uiM => Bool -> Record -> MainStateT uiM (TVar FetchedRecord)
 getRecordCachedFromCur flagIt rec = do
@@ -383,22 +383,22 @@
     cOnly <- gets cacheOnly
     flag <- gets newAsync
     liftIO $ getRecordCached saddr auth
-	(if flagIt then Just flag else Nothing) cOnly rec
+        (if flagIt then Just flag else Nothing) cOnly rec
 
 getFreshRecBlocking :: UIMonad uiM => Record -> MainStateT uiM (Maybe RecordContents)
 getFreshRecBlocking rec = do
     tvar <- getRecordCachedFromCur False rec
     cOnly <- gets cacheOnly
     mfetched <- lift $ withImpatience $ atomically $ do
-	fetched@(FetchedRecord fresh _ _) <- readTVar tvar
-	check $ fresh || cOnly
-	return fetched
+        fetched@(FetchedRecord fresh _ _) <- readTVar tvar
+        check $ fresh || cOnly
+        return fetched
     case mfetched of
-	Nothing -> lift (drawError "Request aborted") >> return Nothing
-	Just fetched ->
-	    case fetchError fetched of
-		Nothing -> return $ fetchedRC fetched
-		Just err -> lift (drawError err) >> return Nothing
+        Nothing -> lift (drawError "Request aborted") >> return Nothing
+        Just fetched ->
+            case fetchError fetched of
+                Nothing -> return $ fetchedRC fetched
+                Just err -> lift (drawError err) >> return Nothing
 
 -- |indicate waiting for server, and allow cancellation
 withImpatience :: UIMonad uiM => IO a -> uiM (Maybe a)
@@ -406,14 +406,14 @@
     finishedTV <- liftIO $ atomically $ newTVar Nothing
     id <- liftIO $ forkIO $ m >>= atomically . writeTVar finishedTV . Just
     let waitImpatiently ticks = do
-	finished <- liftIO $ atomically $ readTVar finishedTV
-	if isJust finished
-	    then return finished
-	    else do
-		abort <- impatience ticks
-		if abort
-		    then liftIO $ killThread id >> return Nothing
-		    else waitImpatiently $ ticks+1
+            finished <- liftIO $ atomically $ readTVar finishedTV
+            if isJust finished
+                then return finished
+                else do
+                    abort <- impatience ticks
+                    if abort
+                        then liftIO $ killThread id >> return Nothing
+                        else waitImpatiently $ ticks+1
     waitImpatiently 0
 
 
@@ -427,7 +427,7 @@
     let (neg,pos) = (countPoints ourUInfo uinfo, countPoints uinfo ourUInfo)
     return $ (pos-neg,(pos,neg))
     where
-	countPoints mugu masta = length $ filter (maybe False winsPoint) $ getAccessInfo mugu masta
+        countPoints mugu masta = length $ filter (maybe False winsPoint) $ getAccessInfo mugu masta
 
 accessedAL :: (UIMonad uiM) => ActiveLock -> MainStateT uiM Bool
 accessedAL (ActiveLock name idx) = (isJust <$>) $ runMaybeT $ do
@@ -442,17 +442,17 @@
     ourName <- mgetOurName
     ourUInfo <- mgetUInfo ourName
     return $ filter (\n -> isNothing (noteBehind n)
-	    || n `elem` notesRead ourUInfo) $ lockSolutions lockinfo
+            || n `elem` notesRead ourUInfo) $ lockSolutions lockinfo
 
 testAuth :: UIMonad uiM => MainStateT uiM ()
 testAuth = isJust <$> gets curAuth >>? do
     resp <- curServerAction $ Authenticate
     case resp of
-	ServerMessage msg -> (lift $ drawMessage $ "Server: " ++ msg)
-	ServerError err -> do
-	    lift $ drawMessage err
-	    modify $ \ms -> ms {curAuth = Nothing}
-	_ -> return ()
+        ServerMessage msg -> (lift $ drawMessage $ "Server: " ++ msg)
+        ServerError err -> do
+            lift $ drawMessage err
+            modify $ \ms -> ms {curAuth = Nothing}
+        _ -> return ()
 
 metagameHelpText :: [String]
 metagameHelpText =
diff --git a/Metagame.hs b/Metagame.hs
--- a/Metagame.hs
+++ b/Metagame.hs
@@ -54,27 +54,27 @@
 getAccessInfo :: UserInfo -> UserInfo -> [Maybe AccessedReason]
 getAccessInfo accessedUInfo accessorUInfo =
     let accessor = codename accessorUInfo
-	mlinfos = elems $ userLocks accessedUInfo
-	accessedSlot = maybe accessedAllExisting accessedLock
-	accessedAllExisting = all (maybe True accessedLock) mlinfos
-	accessedLock linfo = public linfo || accessor `elem` accessedBy linfo
+        mlinfos = elems $ userLocks accessedUInfo
+        accessedSlot = maybe accessedAllExisting accessedLock
+        accessedAllExisting = all (maybe True accessedLock) mlinfos
+        accessedLock linfo = public linfo || accessor `elem` accessedBy linfo
     in map (maybe
-	    (if accessedAllExisting then Just AccessedEmpty else Nothing)
-	    (\linfo -> if public linfo then Just AccessedPub else
-		if not $ accessedLock linfo then Nothing else Just $
-		    if countRead accessorUInfo linfo >= notesNeeded then AccessedPrivyRead
-			else AccessedPrivySolved $ not.null $
-			    [ n
-			    | n <- lockSolutions linfo 
-			    , noteAuthor n == accessor
-			    , noteBehind n == Nothing || n `elem` notesRead accessedUInfo ]))
-	mlinfos
+            (if accessedAllExisting then Just AccessedEmpty else Nothing)
+            (\linfo -> if public linfo then Just AccessedPub else
+                if not $ accessedLock linfo then Nothing else Just $
+                    if countRead accessorUInfo linfo >= notesNeeded then AccessedPrivyRead
+                        else AccessedPrivySolved $ not.null $
+                            [ n
+                            | n <- lockSolutions linfo 
+                            , noteAuthor n == accessor
+                            , noteBehind n == Nothing || n `elem` notesRead accessedUInfo ]))
+        mlinfos
 
 countRead :: UserInfo -> LockInfo -> Int
 countRead reader tlock = fromIntegral $ length
-	$ filter (\n -> (isNothing (noteBehind n) || n `elem` notesRead reader)
-	    && noteAuthor n /= codename reader)
-	$ lockSolutions tlock
+        $ filter (\n -> (isNothing (noteBehind n) || n `elem` notesRead reader)
+            && noteAuthor n /= codename reader)
+        $ lockSolutions tlock
 
 data UserInfoDelta
     = AddRead NoteInfo
@@ -138,12 +138,12 @@
     put (PutLock ls li) = put (2::Word8) >> put ls >> put li
     put (LockDelta li ld) = put (3::Word8) >> put li >> put ld
     get = do
-	tag <- get :: Get Word8
-	case tag of
-	    0 -> AddRead <$> get
-	    1 -> DelRead <$> get
-	    2 -> PutLock <$> get <*> get
-	    3 -> LockDelta <$> get <*> get
+        tag <- get :: Get Word8
+        case tag of
+            0 -> AddRead <$> get
+            1 -> DelRead <$> get
+            2 -> PutLock <$> get <*> get
+            3 -> LockDelta <$> get <*> get
 
 instance Binary LockDelta where
     put (SetPubNote note) = put (0::Word8) >> put note
@@ -153,14 +153,14 @@
     put (AddAccessed name) = put (4::Word8) >> put name
     put SetPublic = put (5::Word8)
     get = do
-	tag <- get :: Get Word8
-	case tag of
-	    0 -> SetPubNote <$> get
-	    1 -> AddSecured <$> get
-	    2 -> DelSecured <$> get
-	    3 -> AddSolution <$> get
-	    4 -> AddAccessed <$> get
-	    5 -> return SetPublic
+        tag <- get :: Get Word8
+        case tag of
+            0 -> SetPubNote <$> get
+            1 -> AddSecured <$> get
+            2 -> DelSecured <$> get
+            3 -> AddSolution <$> get
+            4 -> AddAccessed <$> get
+            5 -> return SetPublic
 
 instance Binary LockInfo where
     put (LockInfo spec pk notes solved accessed) = put spec >> put pk >> put notes >> put solved >> put accessed
diff --git a/Mundanities.hs b/Mundanities.hs
--- a/Mundanities.hs
+++ b/Mundanities.hs
@@ -33,7 +33,7 @@
 readReadFile :: (Read a) => FilePath -> IO (Maybe a)
 readReadFile file =
     (tryRead . BSC.unpack <$> BS.readFile file)
-	`catchIO` (const $ return Nothing)
+        `catchIO` (const $ return Nothing)
 tryRead :: (Read a) => String -> Maybe a
 tryRead = (fst <$>) . listToMaybe . reads
 
diff --git a/NEWS b/NEWS
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,8 @@
 This is an abbreviated summary; see the git log for gory details.
 
+0.7.1.1:
+    Make server compatible with feed-1.0.0
+    Avoid DOS-reserved codenames
 0.7.1:
     Rework tutorial and intro.
     Animate movement.
diff --git a/Physics.hs b/Physics.hs
--- a/Physics.hs
+++ b/Physics.hs
@@ -31,7 +31,7 @@
 
 forceIdx :: Force -> PieceIdx
 forceIdx force = case force of (Push idx _) -> idx
-			       (Torque idx _) -> idx
+                               (Torque idx _) -> idx
 
 isPush,isTorque,forceIsNull :: Force -> Bool
 isPush (Push _ _) = True
@@ -55,12 +55,12 @@
     , let wmove = case pm of {WrenchPush v -> [Push widx v]; _ -> []}
     , not $ null (wmom++wmove)
     ] ++ case pm of
-	HookTorque ht -> [ ForceChoice [Torque hidx ht] | hidx <- hidxs ]
-	HookPush hp -> [ ForceChoice [Push hidx hp] | hidx <- hidxs ]
-	_ -> []
+        HookTorque ht -> [ ForceChoice [Torque hidx ht] | hidx <- hidxs ]
+        HookPush hp -> [ ForceChoice [Push hidx hp] | hidx <- hidxs ]
+        _ -> []
     where
-	epps = enumVec $ placedPieces st
-	hidxs = [ hidx | (hidx, PlacedPiece _ (Hook _ _)) <- epps ]
+        epps = enumVec $ placedPieces st
+        hidxs = [ hidx | (hidx, PlacedPiece _ (Hook _ _)) <- epps ]
 
 -- |Dominance: a propagand of a source force F can not block any progagand of
 -- a source force which dominates F.
@@ -73,36 +73,36 @@
 envForces :: GameState -> (ForceChoices, Dominance)
 envForces st@(GameState _ conns) =
     let rootedForces :: Vector (Maybe PieceIdx, Force)
-	rootedForces = Vector.fromList [ (Just rootIdx, Push endIdx dir)
-	    | c@(Connection (rootIdx,_) (endIdx,_) (Spring outDir natLen)) <- conns
-	    , let curLen = connectionLength st c
-	    , natLen /= curLen
-	    , let dir = if natLen > curLen then outDir else neg outDir ]
+        rootedForces = Vector.fromList [ (Just rootIdx, Push endIdx dir)
+            | c@(Connection (rootIdx,_) (endIdx,_) (Spring outDir natLen)) <- conns
+            , let curLen = connectionLength st c
+            , natLen /= curLen
+            , let dir = if natLen > curLen then outDir else neg outDir ]
 
     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 )
+        \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
-	    HookTorque dir -> TorqueHF dir
-	    HookPush v -> PushHF v
-	    _ -> NullHF
+            HookTorque dir -> TorqueHF dir
+            HookPush v -> PushHF v
+            _ -> NullHF
     in adjustPieces (\p -> case p of
-		Hook arm _ -> Hook arm hf
-		_ -> p) st
+                Hook arm _ -> Hook arm hf
+                _ -> p) st
 
 physicsTick :: PlayerMove -> GameState -> Writer [Alert] GameState
 physicsTick pm st =
     let tfs = toolForces st pm
-	(efs, dominates) = envForces st
+        (efs, dominates) = envForces st
     in do
-	st' <- resolveForces tfs Vector.empty (\_ _->False) $ setTools pm st
-	tell $ [AlertIntermediateState st']
-	resolveForces Vector.empty efs dominates $ setTools NullPM st'
+        st' <- resolveForces tfs Vector.empty (\_ _->False) $ setTools pm st
+        tell $ [AlertIntermediateState st']
+        resolveForces Vector.empty efs dominates $ setTools NullPM st'
 
 stepPhysics :: GameState -> GameState
 stepPhysics = fst.runWriter.physicsTick NullPM
@@ -113,61 +113,61 @@
 resolveForces :: ForceChoices -> ForceChoices -> Dominance -> GameState -> Writer [Alert] GameState
 resolveForces plForces eForces eDominates st =
     let pln = Vector.length plForces
-	dominates i j = case map (< pln) [i,j] of
-		[True,False] -> True
-		[False,False] -> eDominates (i-pln) (j-pln)
-		_ -> False
-	initGrps = fmap (propagate st True) plForces Vector.++
-		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 =
-	    let st' = foldr applyForce st $ nub $ concat fss
-		(inconsistencies,cols) = runWriter $ sequence
-		    [ tell cols >> return [f,f']
-		    | [f,f'] <- sequence fss
-		    , (True,cols) <- [
-			    if forceIdx f == forceIdx f'
-			    then (f /= f',[])
-			    else let cols = collisions st' (forceIdx f) (forceIdx f')
-				in (not $ null cols, cols) ]]
-	    in do
-		tell $ map AlertBlockingForce $ concat inconsistencies
-		tell $ map AlertCollision cols
-		return $ if null inconsistencies then []
-		    else if i==j then [i]
-		    else if dominates i j then [j]
-		    else if dominates j i then [i]
-		    else [i,j]
+        dominates i j = case map (< pln) [i,j] of
+                [True,False] -> True
+                [False,False] -> eDominates (i-pln) (j-pln)
+                _ -> False
+        initGrps = fmap (propagate st True) plForces Vector.++
+                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 =
+            let st' = foldr applyForce st $ nub $ concat fss
+                (inconsistencies,cols) = runWriter $ sequence
+                    [ tell cols >> return [f,f']
+                    | [f,f'] <- sequence fss
+                    , (True,cols) <- [
+                            if forceIdx f == forceIdx f'
+                            then (f /= f',[])
+                            else let cols = collisions st' (forceIdx f) (forceIdx f')
+                                in (not $ null cols, cols) ]]
+            in do
+                tell $ map AlertBlockingForce $ concat inconsistencies
+                tell $ map AlertCollision cols
+                return $ if null inconsistencies then []
+                    else if i==j then [i]
+                    else if dominates i j then [j]
+                    else if dominates j i then [i]
+                    else [i,j]
 
-	stopWrench idx = setPiece idx (Wrench zero)
-	stopBlockedWrenches blocked unblocked st' = foldr stopWrench st' $
+        stopWrench idx = setPiece idx (Wrench zero)
+        stopBlockedWrenches blocked unblocked st' = foldr stopWrench st' $
             forcedWrenches blocked \\ forcedWrenches unblocked
             where forcedWrenches fs = [ forceIdx f
                     | f <- fs, isWrench.placedPiece $ getForcedpp st' f ]
-	divertedWrenches fs = [ idx
-	    | Push idx dir <- fs
-	    , Wrench mom <- [placedPiece $ getpp st idx]
-	    , mom `notElem` [zero,dir] ]
+        divertedWrenches fs = [ idx
+            | Push idx dir <- fs
+            , Wrench mom <- [placedPiece $ getpp st idx]
+            , mom `notElem` [zero,dir] ]
     in do
-	let unresisted = [ s | (s, (_, Any False)) <- enumVec $ fmap runWriter initGrps ]
+        let unresisted = [ s | (s, (_, Any False)) <- enumVec $ fmap runWriter initGrps ]
 
-	-- check for inconsistencies within, and between pairs of, forcegroups
-	grps <- sequence [ blockInconsistent i j
-			| [i,j] <- sequence [unresisted,unresisted]
-			, i <= j ]
-		    `execStateT` initGrps
+        -- check for inconsistencies within, and between pairs of, forcegroups
+        grps <- sequence [ blockInconsistent i j
+                        | [i,j] <- sequence [unresisted,unresisted]
+                        , i <= j ]
+                    `execStateT` initGrps
 
-	let [blocked, unblocked] = map (nub.concat.(map (fst.runWriter)).Vector.toList) $
-		(\(x,y) -> [x,y]) $ Vector.partition (getAny.snd.runWriter) grps
-	tell $ map AlertBlockedForce blocked
-	tell $ map AlertAppliedForce unblocked
-	tell $ map AlertDivertedWrench $ divertedWrenches unblocked
-	return $ stopBlockedWrenches blocked unblocked $ foldr applyForce st unblocked
+        let [blocked, unblocked] = map (nub.concat.(map (fst.runWriter)).Vector.toList) $
+                (\(x,y) -> [x,y]) $ Vector.partition (getAny.snd.runWriter) grps
+        tell $ map AlertBlockedForce blocked
+        tell $ map AlertAppliedForce unblocked
+        tell $ map AlertDivertedWrench $ divertedWrenches unblocked
+        return $ stopBlockedWrenches blocked unblocked $ foldr applyForce st unblocked
 
 resolveSinglePlForce :: Force -> GameState -> Writer [Alert] GameState
 resolveSinglePlForce force st = resolveForces
@@ -177,12 +177,12 @@
 applyForce :: Force -> GameState -> GameState
 applyForce f s =
     let idx = forceIdx f
-	pp' = applyForceTo (getpp s idx) f
-	pp'' = case (placedPiece pp',f) of
-		   ( Wrench _ , Push _ dir ) -> pp' {placedPiece = Wrench dir}
-		   _ -> pp'
-	in
-	s { placedPieces = (placedPieces s) // [(idx, pp'')] }
+        pp' = applyForceTo (getpp s idx) f
+        pp'' = case (placedPiece pp',f) of
+                   ( Wrench _ , Push _ dir ) -> pp' {placedPiece = Wrench dir}
+                   _ -> pp'
+        in
+        s { placedPieces = (placedPieces s) // [(idx, pp'')] }
 
 collisionsWithForce :: GameState -> Force -> PieceIdx -> [HexPos]
 collisionsWithForce st (Push idx dir) idx' =
@@ -203,35 +203,35 @@
 pieceResists :: GameState -> Force -> Bool
 pieceResists st force =
     let idx = forceIdx force
-	PlacedPiece _ piece = getpp st idx
+        PlacedPiece _ piece = getpp st idx
         springs = springsEndAtIdx st idx
-	fixed = case piece of
-		     (Pivot _) -> isPush force
-		     (Block _) -> null springs
-		     (Wrench mom) -> case force of
-			    Push _ v -> v /= mom
-			    _ -> True
-		     (Hook _ hf) -> case force of
-			    Push _ v -> hf /= PushHF v
-			    Torque _ dir -> hf /= TorqueHF dir
-		     _ -> False
+        fixed = case piece of
+                     (Pivot _) -> isPush force
+                     (Block _) -> null springs
+                     (Wrench mom) -> case force of
+                            Push _ v -> v /= mom
+                            _ -> True
+                     (Hook _ hf) -> case force of
+                            Push _ v -> hf /= PushHF v
+                            Torque _ dir -> hf /= TorqueHF dir
+                     _ -> False
     in fixed
 
 -- |transmittedForce: convert pushes into torques as appropriate
 transmittedForce :: GameState -> Source -> HexPos -> HexDir -> Force
 transmittedForce st idx cpos dir =
     let pp@(PlacedPiece _ piece) = getpp st idx
-	rpos = cpos -^ placedPos pp
-	armPush = case
-		(dir `hexDot` ((rotate 1 rpos) -^ rpos)) `compare`
-		(dir `hexDot` ((rotate (-1) rpos) -^ rpos)) of
-	    GT -> Torque idx 1
-	    LT -> Torque idx $ -1
-	    EQ -> Push idx dir
+        rpos = cpos -^ placedPos pp
+        armPush = case
+                (dir `hexDot` ((rotate 1 rpos) -^ rpos)) `compare`
+                (dir `hexDot` ((rotate (-1) rpos) -^ rpos)) of
+            GT -> Torque idx 1
+            LT -> Torque idx $ -1
+            EQ -> Push idx dir
     in case piece of
-	    Pivot _ -> armPush
-	    Hook _ (TorqueHF _) -> armPush
-	    _ -> (Push idx dir)
+            Pivot _ -> armPush
+            Hook _ (TorqueHF _) -> armPush
+            _ -> (Push idx dir)
 
 -- |propagateForce: return forces a force causes via bumps and fully
 -- compressed/extended springs
@@ -239,31 +239,31 @@
 propagateForce st@(GameState _ conns) isPlSource force =
     bumps ++ springTransmissions
     where
-	idx = forceIdx force
-	bumps = [ ForceChoice $ map (transmittedForce st idx' cpos) dirs |
-	    idx' <- ppidxs st
-	    , idx' /= idx
-	    , cpos <- collisionsWithForce st force idx'
-	    , let dirs = case force of
-		    Push _ dir -> [dir]
-		    Torque _ dir -> [push,claw]
-			where push = arm -^ rotate (-dir) arm
-			      claw = rotate dir arm -^ arm
-			      arm = cpos -^ placedPos (getpp st idx) ]
-	springTransmissions =
-	    case force of
-		 Push _ dir -> [ ForceChoice [Push idx' dir] |
-			c@(Connection (ridx,_) (eidx,_) (Spring sdir _)) <- conns
-			, let root = idx == ridx
-			, let end = idx == eidx
-			, root || end
-			, let idx' = if root then eidx else ridx
-			, let pull = (root && dir == neg sdir) || (end && dir == sdir)
-			, let push = (root && dir == sdir) || (end && dir == neg sdir)
-			, (push && if isPlSource then springFullyCompressed st c else not $ springExtended st c) ||
-			    (pull && if isPlSource then springFullyExtended st c else not $ springCompressed st c) ||
-			    (not push && not pull) ]
-		 _ -> []
+        idx = forceIdx force
+        bumps = [ ForceChoice $ map (transmittedForce st idx' cpos) dirs |
+            idx' <- ppidxs st
+            , idx' /= idx
+            , cpos <- collisionsWithForce st force idx'
+            , let dirs = case force of
+                    Push _ dir -> [dir]
+                    Torque _ dir -> [push,claw]
+                        where push = arm -^ rotate (-dir) arm
+                              claw = rotate dir arm -^ arm
+                              arm = cpos -^ placedPos (getpp st idx) ]
+        springTransmissions =
+            case force of
+                 Push _ dir -> [ ForceChoice [Push idx' dir] |
+                        c@(Connection (ridx,_) (eidx,_) (Spring sdir _)) <- conns
+                        , let root = idx == ridx
+                        , let end = idx == eidx
+                        , root || end
+                        , let idx' = if root then eidx else ridx
+                        , let pull = (root && dir == neg sdir) || (end && dir == sdir)
+                        , let push = (root && dir == sdir) || (end && dir == neg sdir)
+                        , (push && if isPlSource then springFullyCompressed st c else not $ springExtended st c) ||
+                            (pull && if isPlSource then springFullyExtended st c else not $ springCompressed st c) ||
+                            (not push && not pull) ]
+                 _ -> []
 
 -- |propagate: find forcegroup generated by a forcechoice, and note if the
 -- group is blocked due to resistance. If there are multiple forces in a
@@ -272,17 +272,17 @@
 propagate :: GameState -> Bool -> ForceChoice -> Writer Any [Force]
 propagate st isPlSource fch = Set.toList `liftM` propagate' isPlSource Set.empty fch where
     propagate' isPlForce ps (ForceChoice (f:backups)) =
-	if f `Set.member` ps then return ps
-	else
-	    let (ps', failed) = if pieceResists st f && (not isPlForce)
-		    then (ps, Any True)
-		    else runWriter $ foldrM
-			    (flip $ propagate' False)
-			    (f `Set.insert` ps)
-			    $ propagateForce st isPlSource f
-	    in if getAny failed
-		then if null backups
-		    then tell (Any True) >> return ps'
-		    else propagate' isPlForce ps $ ForceChoice backups
-		else return ps'
+        if f `Set.member` ps then return ps
+        else
+            let (ps', failed) = if pieceResists st f && (not isPlForce)
+                    then (ps, Any True)
+                    else runWriter $ foldrM
+                            (flip $ propagate' False)
+                            (f `Set.insert` ps)
+                            $ propagateForce st isPlSource f
+            in if getAny failed
+                then if null backups
+                    then tell (Any True) >> return ps'
+                    else propagate' isPlForce ps $ ForceChoice backups
+                else return ps'
     propagate' _ _ (ForceChoice []) = error "null ForceChoice"
diff --git a/Protocol.hs b/Protocol.hs
--- a/Protocol.hs
+++ b/Protocol.hs
@@ -100,22 +100,22 @@
     put (SetEmail address) = put (12::Word8) >> put address
     put GetPublicKey = put (13::Word8)
     get = do
-	tag <- get :: Get Word8
-	case tag of
-	    0 -> return Authenticate
-	    1 -> return Register
-	    2 -> return GetServerInfo
-	    3 -> liftM GetLock get
-	    4 -> liftM2 GetUserInfo get get
-	    5 -> liftM GetHint get
-	    6 -> liftM GetSolution get
-	    7 -> liftM4 DeclareSolution get get get get
-	    8 -> liftM3 SetLock get get get
-	    9 -> liftM GetRandomNames get
-	    10 -> liftM ResetPassword get
-	    11 -> liftM GetRetired get
-	    12 -> liftM SetEmail get
-	    13 -> return GetPublicKey
+        tag <- get :: Get Word8
+        case tag of
+            0 -> return Authenticate
+            1 -> return Register
+            2 -> return GetServerInfo
+            3 -> liftM GetLock get
+            4 -> liftM2 GetUserInfo get get
+            5 -> liftM GetHint get
+            6 -> liftM GetSolution get
+            7 -> liftM4 DeclareSolution get get get get
+            8 -> liftM3 SetLock get get get
+            9 -> liftM GetRandomNames get
+            10 -> liftM ResetPassword get
+            11 -> liftM GetRetired get
+            12 -> liftM SetEmail get
+            13 -> return GetPublicKey
             _ -> return UndefinedAction
 
 instance Binary Auth where
@@ -138,22 +138,22 @@
     put (ServedRetired lss) = put (12::Word8) >> put lss
     put (ServedPublicKey publicKey) = put (13::Word8) >> put (show publicKey)
     get = do
-	tag <- get :: Get Word8
-	case tag of
-	    0 -> return ServerAck
-	    1 -> liftM ServerMessage get
-	    2 -> liftM ServerError get
-	    3 -> liftM ServedServerInfo get
-	    4 -> liftM ServedLock get
-	    5 -> liftM ServedUserInfo get
-	    6 -> liftM ServedUserInfoDeltas get
-	    7 -> liftM ServedSolution get
-	    8 -> liftM ServedHint get
-	    9 -> liftM ServedRandomNames get
-	    10 -> return ServerCodenameFree
-	    11 -> return ServerFresh
-	    12 -> liftM ServedRetired get
-	    13 -> liftM (ServedPublicKey . read) get
+        tag <- get :: Get Word8
+        case tag of
+            0 -> return ServerAck
+            1 -> liftM ServerMessage get
+            2 -> liftM ServerError get
+            3 -> liftM ServedServerInfo get
+            4 -> liftM ServedLock get
+            5 -> liftM ServedUserInfo get
+            6 -> liftM ServedUserInfoDeltas get
+            7 -> liftM ServedSolution get
+            8 -> liftM ServedHint get
+            9 -> liftM ServedRandomNames get
+            10 -> return ServerCodenameFree
+            11 -> return ServerFresh
+            12 -> liftM ServedRetired get
+            13 -> liftM (ServedPublicKey . read) get
             _ -> return ServerUndefinedResponse
 instance Binary ServerInfo where
     put (ServerInfo sz str) = put sz >> put str
diff --git a/SDLGlyph.hs b/SDLGlyph.hs
--- a/SDLGlyph.hs
+++ b/SDLGlyph.hs
@@ -72,8 +72,8 @@
 
 drawAt :: Glyph -> HexPos -> RenderM ()
 drawAt gl pos = do
-	centre <- asks renderHCentre
-	drawAtRel gl (pos -^ centre)
+        centre <- asks renderHCentre
+        drawAtRel gl (pos -^ centre)
 
 drawAtRel :: Glyph -> HexVec -> RenderM ()
 drawAtRel gl v = do
@@ -89,80 +89,80 @@
     CachedGlyphs cmap clist <- lift get
     size <- asks renderSize
     let sgl = (gl,size)
-	w = size*2 + 1
-	h = ysize size*4 + 1
-	newGlyphSurf = do
-	    -- csurf <- liftIO $ createRGBSurface [] w h 32 0xff000000 0x00ff0000 0x0000ff00 0x000000ff
-	    csurf <- liftIO $ createRGBSurface [] w h 16 0 0 0 0
-	    liftIO $ setColorKey csurf [SrcColorKey,RLEAccel] $ Pixel 0
-	    return csurf
-	renderOnCache csurf =
+        w = size*2 + 1
+        h = ysize size*4 + 1
+        newGlyphSurf = do
+            -- csurf <- liftIO $ createRGBSurface [] w h 32 0xff000000 0x00ff0000 0x0000ff00 0x000000ff
+            csurf <- liftIO $ createRGBSurface [] w h 16 0 0 0 0
+            liftIO $ setColorKey csurf [SrcColorKey,RLEAccel] $ Pixel 0
+            return csurf
+        renderOnCache csurf =
             let ccxt rc = rc { renderSurf = csurf, renderSCentre = SVec (w`div`2) (h`div`2) }
-	    in local ccxt $ renderGlyph gl
-	addToCache cacheFull csurf = do
-	    CachedGlyphs cmap clist <- lift get
-	    let cmap' = Map.insert sgl csurf cmap
-	    lift $ put $ if cacheFull
-		then CachedGlyphs (Map.delete (last clist) cmap') (sgl:List.init clist)
-		else CachedGlyphs cmap' (sgl:clist)
-	promote = do
-	    CachedGlyphs cmap clist <- lift get
-	    lift $ put $ CachedGlyphs cmap (sgl:List.delete sgl clist)
-	blitGlyph csurf = do
+            in local ccxt $ renderGlyph gl
+        addToCache cacheFull csurf = do
+            CachedGlyphs cmap clist <- lift get
+            let cmap' = Map.insert sgl csurf cmap
+            lift $ put $ if cacheFull
+                then CachedGlyphs (Map.delete (last clist) cmap') (sgl:List.init clist)
+                else CachedGlyphs cmap' (sgl:clist)
+        promote = do
+            CachedGlyphs cmap clist <- lift get
+            lift $ put $ CachedGlyphs cmap (sgl:List.delete sgl clist)
+        blitGlyph csurf = do
             surf <- asks renderSurf
-	    (x,y) <- renderPos zero
-	    void $ liftIO $ blitSurface csurf Nothing surf $ Just $
-		Rect (x-w`div`2) (y-h`div`2) (w+1) (h+1)
+            (x,y) <- renderPos zero
+            void $ liftIO $ blitSurface csurf Nothing surf $ Just $
+                Rect (x-w`div`2) (y-h`div`2) (w+1) (h+1)
     let cacheFull = Map.size cmap >= maxCachedGlyphs
     let mcsurf = Map.lookup sgl cmap
     -- with probability 1 in (maxCachedGlyphs`div`2), we put this glyph at the
     -- head of the cached list, throwing away the tail to make room if needed.
     cacheIt <- (((cacheable &&) . (not cacheFull ||)) <$>) $
-	liftIO $ (==0) <$> randomRIO (0::Int,maxCachedGlyphs`div`2)
+        liftIO $ (==0) <$> randomRIO (0::Int,maxCachedGlyphs`div`2)
     case mcsurf of
-	Nothing -> if cacheIt
-	    then do
-		csurf <- newGlyphSurf
-		renderOnCache csurf
-		addToCache cacheFull csurf
-		blitGlyph csurf
-	    else
-		renderGlyph gl
-	Just csurf -> do
-	    when cacheIt promote
-	    blitGlyph csurf
+        Nothing -> if cacheIt
+            then do
+                csurf <- newGlyphSurf
+                renderOnCache csurf
+                addToCache cacheFull csurf
+                blitGlyph csurf
+            else
+                renderGlyph gl
+        Just csurf -> do
+            when cacheIt promote
+            blitGlyph csurf
     where
-	cacheable = case gl of
-	    -- some glyphs need to be drawn with blending - those involving
-	    -- anti-aliasing which bleed over the edge of the hex or which
-	    -- may be drawn on top of an existing glyph.
-	    -- TODO: we should find a way to deal with at least some of these;
-	    -- springs in particular are common and expensive to draw.
-	    -- Maybe we could truncate the spring glyphs to a hex?
-	    TileGlyph (BlockTile adjs) _ -> null adjs
-	    TileGlyph (SpringTile extn dir) _ -> False
+        cacheable = case gl of
+            -- some glyphs need to be drawn with blending - those involving
+            -- anti-aliasing which bleed over the edge of the hex or which
+            -- may be drawn on top of an existing glyph.
+            -- TODO: we should find a way to deal with at least some of these;
+            -- springs in particular are common and expensive to draw.
+            -- Maybe we could truncate the spring glyphs to a hex?
+            TileGlyph (BlockTile adjs) _ -> null adjs
+            TileGlyph (SpringTile extn dir) _ -> False
             SpringGlyph _ _ _ _ _ -> False
-	    FilledHexGlyph _ -> False
-	    HollowGlyph _ -> False
-	    BlockedBlock _ _ _ -> False
-	    BlockedPush _ _ -> False
-	    CollisionMarker -> False
+            FilledHexGlyph _ -> False
+            HollowGlyph _ -> False
+            BlockedBlock _ _ _ -> False
+            BlockedPush _ _ -> False
+            CollisionMarker -> False
             DisplacedGlyph _ _ -> False
-	    _ -> True
+            _ -> True
 
 renderGlyph :: Glyph -> RenderM ()
 renderGlyph (TileGlyph (BlockTile adjs) col) =
     rimmedPolygonR corners col $ bright col
-	where
-	    corners = concat [
-		if or $ map adjAt [0,1]
-		then [corner $ hextant dir]
-		else if adjAt $ -1
-		    then []
-		    else [innerCorner dir]
-		| dir <- hexDirs
-		, let adjAt r = rotate r dir `elem` adjs
-		]
+        where
+            corners = concat [
+                if or $ map adjAt [0,1]
+                then [corner $ hextant dir]
+                else if adjAt $ -1
+                    then []
+                    else [innerCorner dir]
+                | dir <- hexDirs
+                , let adjAt r = rotate r dir `elem` adjs
+                ]
 
 renderGlyph (TileGlyph (SpringTile extn dir) col) =
     renderGlyph $ SpringGlyph zero zero extn dir col
@@ -179,85 +179,85 @@
 renderGlyph (TileGlyph (WrenchTile mom) col) = do
     rimmedCircleR zero (1/3) col $ bright col
     when (mom /= zero) $
-	let
-	    from = innerCorner $ neg mom
-	    to = edge $ neg mom
-	    shifts = [ (1/2) **^ (b -^ a)
-		| rot <- [-1,0,1]
-		, let a = innerCorner $ neg mom
-		, let b = innerCorner $ rotate rot $ neg mom
-		]
-	in sequence_
-	    [ aaLineR (from+^shift) (to+^shift) $ col
-	    | shift <- shifts ]
+        let
+            from = innerCorner $ neg mom
+            to = edge $ neg mom
+            shifts = [ (1/2) **^ (b -^ a)
+                | rot <- [-1,0,1]
+                , let a = innerCorner $ neg mom
+                , let b = innerCorner $ rotate rot $ neg mom
+                ]
+        in sequence_
+            [ aaLineR (from+^shift) (to+^shift) $ col
+            | shift <- shifts ]
 
 renderGlyph (TileGlyph BallTile col) =
     rimmedCircleR zero (7/8) (faint col) (obscure col)
 
 renderGlyph (SpringGlyph rootDisp endDisp extn dir col) =
     thickLinesR points 1 $ brightness col
-	where
+        where
             n :: Int
-	    n = 3*case extn of
-		Stretched -> 1
-		Relaxed -> 2
-		Compressed -> 4
-	    brightness = if extn == Relaxed then dim else bright
-	    dir' = if dir == zero then hu else dir
-	    s = corner (hextant dir' - 1) +^ innerCorner endDisp
-	    off = corner (hextant dir') +^ innerCorner endDisp
-	    e = corner (hextant dir' - 3) +^ innerCorner rootDisp
-	    points = [ b +^ (fi i / fi n) **^ (e -^ s)
-		| i <- [0..n]
-		, i`mod`3 /= 1
-		, let b = if i`mod`3==0 then s else off ]
+            n = 3*case extn of
+                Stretched -> 1
+                Relaxed -> 2
+                Compressed -> 4
+            brightness = if extn == Relaxed then dim else bright
+            dir' = if dir == zero then hu else dir
+            s = corner (hextant dir' - 1) +^ innerCorner endDisp
+            off = corner (hextant dir') +^ innerCorner endDisp
+            e = corner (hextant dir' - 3) +^ innerCorner rootDisp
+            points = [ b +^ (fi i / fi n) **^ (e -^ s)
+                | i <- [0..n]
+                , i`mod`3 /= 1
+                , let b = if i`mod`3==0 then s else off ]
 
 renderGlyph (PivotGlyph rot dir col) = do
     rimmedCircleR zero (7/8) col $ bright col
     when (dir /= zero)
-	$ aaLineR from to $ bright col
+        $ aaLineR from to $ bright col
     return ()
-	where
-	    from = rotFVec th c $ (7/8) **^ edge (neg dir)
-	    to = rotFVec th c $ (7/8) **^ edge dir
+        where
+            from = rotFVec th c $ (7/8) **^ edge (neg dir)
+            to = rotFVec th c $ (7/8) **^ edge dir
             c = FVec 0 0
             th = - fi rot * pi / 12
 
 renderGlyph (ArmGlyph rot dir col) =
     thickLineR from to 1 col
-	where
-	    dir' = if dir == zero then hu else dir
-	    from = rotFVec th c $ edge $ neg dir'
-	    to = rotFVec th c $ innerCorner dir'
+        where
+            dir' = if dir == zero then hu else dir
+            from = rotFVec th c $ edge $ neg dir'
+            to = rotFVec th c $ innerCorner dir'
             c = (2 **^ edge (neg dir'))
             th = - fi rot * pi / 12
 
 renderGlyph (BlockedArm armdir tdir col) =
     aaLineR from to col
-	where
-	    from = innerCorner $ rotate (2*tdir) armdir
-	    to = edge $ rotate tdir armdir
+        where
+            from = innerCorner $ rotate (2*tdir) armdir
+            to = edge $ rotate tdir armdir
 
 renderGlyph (TurnedArm armdir tdir col) =
     sequence_ [ arcR c r a1 a2 col | r <- [8/4,9/4] ]
     where
-	c = hexVec2FVec $ neg armdir
-	a0 = fi $ -60*hextant armdir
-	a1' = a0 + fi tdir * 10
-	a2' = a0 + fi tdir * 30
-	a1 = min a1' a2'
-	a2 = max a1' a2'
+        c = hexVec2FVec $ neg armdir
+        a0 = fi $ -60*hextant armdir
+        a1' = a0 + fi tdir * 10
+        a2' = a0 + fi tdir * 30
+        a1 = min a1' a2'
+        a2 = max a1' a2'
 
 renderGlyph (BlockedBlock tile dir col) =
     displaceRender shift $ renderGlyph (TileGlyph tile col)
-	where shift = innerCorner dir -^ edge dir
+        where shift = innerCorner dir -^ edge dir
 
 renderGlyph (BlockedPush dir col) = do
     thickLineR zero tip 1 col
     thickLineR tip (arms!!0) 1 col
     thickLineR tip (arms!!1) 1 col
     where
-	tip@(FVec tx ty) = edge dir
+        tip@(FVec tx ty) = edge dir
         arms = [ FVec ((tx/2) + d*ty/4) (ty/2 - d*tx/4) | d <- [-1,1] ]
 
 renderGlyph CollisionMarker = do
@@ -265,9 +265,9 @@
     aaLineR start end $ col
     aaCircleR zero rad col
     where
-	[start,end] = map (((1/2)**^) . corner) [0,3]
-	rad = ylen
-	col = dim purple
+        [start,end] = map (((1/2)**^) . corner) [0,3]
+        rad = ylen
+        col = dim purple
 
 renderGlyph (HollowGlyph col) =
     aaPolygonR corners $ opaquify col
@@ -293,15 +293,15 @@
 renderGlyph (ShowBlocksButton showing) = do
     renderGlyph (TileGlyph (BlockTile []) (dim red))
     when (showing == ShowBlocksAll) $
-	renderGlyph (BlockedPush hu (bright orange))
+        renderGlyph (BlockedPush hu (bright orange))
     when (showing /= ShowBlocksNone) $
-	renderGlyph (BlockedPush hw (bright purple))
+        renderGlyph (BlockedPush hw (bright purple))
 
 renderGlyph (ShowButtonTextButton showing) = do
     rescaleRender (1/2) $ displaceRender (edge (neg hu)) $
         renderGlyph (ButtonGlyph (dim yellow))
     when showing $
-	sequence_ [ pixelR (FVec (1/3 + i/4) (-1/4)) (bright white) | i <- [-1..1] ]
+        sequence_ [ pixelR (FVec (1/3 + i/4) (-1/4)) (bright white) | i <- [-1..1] ]
 
 renderGlyph (UseSoundsButton use) = do
     sequence [ arcR (FVec (-2/3) 0) r (-20) 20
@@ -317,22 +317,22 @@
         | dir <- hexDirs ]
 renderGlyph (WhsButtonsButton (Just whs)) = rescaleRender (1/2) $ do
     when (whs /= WHSHook) $
-	displaceRender (corner 0) $ renderGlyph (TileGlyph (WrenchTile zero) col)
+        displaceRender (corner 0) $ renderGlyph (TileGlyph (WrenchTile zero) col)
     when (whs /= WHSWrench) $ do
-	displaceRender (corner 4) $ renderGlyph (TileGlyph HookTile col)
-	displaceRender (corner 2) $ renderGlyph (TileGlyph (ArmTile hv False) col)
+        displaceRender (corner 4) $ renderGlyph (TileGlyph HookTile col)
+        displaceRender (corner 2) $ renderGlyph (TileGlyph (ArmTile hv False) col)
     where
-	col = dim white
+        col = dim white
 
 renderGlyph (FullscreenButton fs) = do
     thickPolygonR corners 1 $ activeCol (not fs)
     thickPolygonR corners' 1 $ activeCol fs
     where
-	activeCol True = opaquify $ dim green
-	activeCol False = opaquify $ dim red
-	corners = [ (2/3) **^ (if dir `elem` [hu,neg hu] then edge else innerCorner) dir
-	    | dir <- hexDirs ]
-	corners' = map (((2/3)**^) . corner) [0..5]
+        activeCol True = opaquify $ dim green
+        activeCol False = opaquify $ dim red
+        corners = [ (2/3) **^ (if dir `elem` [hu,neg hu] then edge else innerCorner) dir
+            | dir <- hexDirs ]
+        corners' = map (((2/3)**^) . corner) [0..5]
 
 renderGlyph (DisplacedGlyph dir glyph) =
     displaceRender (innerCorner dir) $ renderGlyph glyph
@@ -341,7 +341,7 @@
     let col = bright red
     renderGlyph (HollowInnerGlyph col)
     sequence_ [pixelR (FVec (i/4) 0) col
-	| i <- [-1..1] ]
+        | i <- [-1..1] ]
 
 playerGlyph col = FilledHexGlyph col
 
@@ -358,36 +358,36 @@
 drawBasicBG :: Int -> RenderM ()
 drawBasicBG maxR = sequence_ [ drawAtRel (HollowGlyph $ colAt v) v | v <- hexDisc maxR ]
     where
-	colAt v@(HexVec hx hy hz) = let
-		[r,g,b] = map (\h -> fi $ ((0xff*)$ 5 + abs h)`div`maxR) [hx,hy,hz]
-		a = fi $ (0x70 * (maxR - abs (hexLen v)))`div`maxR
-	    in rgbaToPixel (r,g,b,a)
+        colAt v@(HexVec hx hy hz) = let
+                [r,g,b] = map (\h -> fi $ ((0xff*)$ 5 + abs h)`div`maxR) [hx,hy,hz]
+                a = fi $ (0x70 * (maxR - abs (hexLen v)))`div`maxR
+            in rgbaToPixel (r,g,b,a)
 
 drawBlocked :: GameState -> PieceColouring -> Bool -> Force -> RenderM ()
 drawBlocked st colouring blocking (Torque idx dir) = do
     let (pos,arms) = case getpp st idx of
-	    PlacedPiece pos (Pivot arms) -> (pos,arms)
-	    PlacedPiece pos (Hook arm _) -> (pos,[arm])
-	    _ -> (pos,[])
-	col = if blocking then bright $ purple else dim $ colourOf colouring idx
+            PlacedPiece pos (Pivot arms) -> (pos,arms)
+            PlacedPiece pos (Hook arm _) -> (pos,[arm])
+            _ -> (pos,[])
+        col = if blocking then bright $ purple else dim $ colourOf colouring idx
     sequence_ [ drawAt (BlockedArm arm dir col) (arm +^ pos) |
-	arm <- arms ]
+        arm <- arms ]
 drawBlocked st colouring blocking (Push idx dir) = do
     let footprint = plPieceFootprint $ getpp st idx
-	fullfootprint = fullFootprint st idx
-	col = bright $ if blocking then purple else orange
+        fullfootprint = fullFootprint st idx
+        col = bright $ if blocking then purple else orange
     sequence_ [ drawAt (BlockedPush dir col) pos
-	| pos <- footprint
-	, (dir+^pos) `notElem` fullfootprint ]
+        | pos <- footprint
+        , (dir+^pos) `notElem` fullfootprint ]
     -- drawAt (blockedPush dir $ bright orange) $ placedPos $ getpp st idx
 
 drawApplied :: GameState -> PieceColouring -> Force -> RenderM ()
 drawApplied st colouring (Torque idx dir) = do
     let (pos,arms) = case getpp st idx of
-	    PlacedPiece pos (Pivot arms) -> (pos,arms)
-	    PlacedPiece pos (Hook arm _) -> (pos,[arm])
-	    _ -> (pos,[])
-	col = dim $ colourOf colouring idx
+            PlacedPiece pos (Pivot arms) -> (pos,arms)
+            PlacedPiece pos (Hook arm _) -> (pos,[arm])
+            _ -> (pos,[])
+        col = dim $ colourOf colouring idx
     sequence_ [ drawAt (TurnedArm arm dir col) (arm +^ pos) |
-	    arm <- arms ]
+            arm <- arms ]
 drawApplied _ _ _ = return ()
diff --git a/SDLRender.hs b/SDLRender.hs
--- a/SDLRender.hs
+++ b/SDLRender.hs
@@ -68,22 +68,22 @@
 sVec2dHV :: Int -> SVec -> (Double,Double,Double)
 sVec2dHV size (SVec sx sy) =
     let sx',sy',size' :: Double
-	[sx',sy',size',ysize'] = map fi [sx,sy,size,ysize size]
-	y' = -sy' / ysize' / 3
-	x' = ((sx' / size') - y') / 2
-	z' = -((sx' / size') + y') / 2
+        [sx',sy',size',ysize'] = map fi [sx,sy,size,ysize size]
+        y' = -sy' / ysize' / 3
+        x' = ((sx' / size') - y') / 2
+        z' = -((sx' / size') + y') / 2
     in (x',y',z')
 
 sVec2HexVec :: Int -> SVec -> HexVec
 sVec2HexVec size sv =
     let (x',y',z') = sVec2dHV size sv
-	unrounded = Map.fromList [(1,x'),(2,y'),(3,z')]
-	rounded = Map.map round unrounded
-	maxdiff = fst $ maximumBy (compare `on` snd) $
-	    [ (i, abs $ c'-c) | i <- [1..3],
-		let c' = unrounded Map.! i, let c = fi $ rounded Map.! i]
-	[x,y,z] = map snd $ Map.toList $
-	    Map.adjust (\x -> x - (sum $ Map.elems rounded)) maxdiff rounded
+        unrounded = Map.fromList [(1,x'),(2,y'),(3,z')]
+        rounded = Map.map round unrounded
+        maxdiff = fst $ maximumBy (compare `on` snd) $
+            [ (i, abs $ c'-c) | i <- [1..3],
+                let c' = unrounded Map.! i, let c = fi $ rounded Map.! i]
+        [x,y,z] = map snd $ Map.toList $
+            Map.adjust (\x -> x - (sum $ Map.elems rounded)) maxdiff rounded
     in HexVec x y z
 
 
@@ -177,7 +177,7 @@
 
 aaLinesR verts col =
     sequence_ [ aaLineR v v' col |
-	(v,v') <- zip (take (length verts - 1) verts) (drop 1 verts) ]
+        (v,v') <- zip (take (length verts - 1) verts) (drop 1 verts) ]
 
 rimmedPolygonR verts fillCol rimCol = do
     filledPolygonR verts fillCol
@@ -192,16 +192,16 @@
 thickLineR from to thickness col =
     let FVec dx dy = to -^ from
         baseThickness = (1/16)
-	s = baseThickness * thickness / (sqrt $ dx^2 + dy^2)
-	perp = (s/2) **^ FVec dy (-dx)
+        s = baseThickness * thickness / (sqrt $ dx^2 + dy^2)
+        perp = (s/2) **^ FVec dy (-dx)
     in rimmedPolygonR
         [ from +^ perp, to +^ perp
         , to +^ neg perp, from +^ neg perp]
-	(dim col) (bright col)
+        (dim col) (bright col)
 
 thickLinesR verts thickness col =
     sequence_ [ thickLineR v v' thickness col |
-	(v,v') <- zip (take (length verts - 1) verts) (drop 1 verts) ]
+        (v,v') <- zip (take (length verts - 1) verts) (drop 1 verts) ]
 
 thickPolygonR verts thickness col =
     thickLinesR (verts ++ take 1 verts) thickness col
@@ -214,36 +214,36 @@
 corner :: Int -> FVec
 corner hextant = FVec x y
     where
-	[x,y] = f hextant
-	f 0 = [1, -ylen]
-	f 1 = [0, -2*ylen]
-	f 2 = [-1, -ylen]
-	f n | n < 6 = let [x,y] = f (5-n) in [x,-y]
-	    | n < 0 = f (6-n)
-	    | otherwise = f (n`mod`6)
+        [x,y] = f hextant
+        f 0 = [1, -ylen]
+        f 1 = [0, -2*ylen]
+        f 2 = [-1, -ylen]
+        f n | n < 6 = let [x,y] = f (5-n) in [x,-y]
+            | n < 0 = f (6-n)
+            | otherwise = f (n`mod`6)
 
 innerCorner :: HexDir -> FVec
 innerCorner dir = FVec x y
     where
-	[x,y] = f dir
-	f dir
-	    | dir == hu = [2/3, 0]
-	    | dir == hv = [-1/3, -ylen]
-	    | dir == hw = [-1/3, ylen]
+        [x,y] = f dir
+        f dir
+            | dir == hu = [2/3, 0]
+            | dir == hv = [-1/3, -ylen]
+            | dir == hw = [-1/3, ylen]
             | dir == zero = [0,0]
-	    | not (isHexDir dir) = error "innerCorner: not a hexdir"
-	    | otherwise = map (\z -> -z) $ f $ neg dir
+            | not (isHexDir dir) = error "innerCorner: not a hexdir"
+            | otherwise = map (\z -> -z) $ f $ neg dir
 
 edge :: HexDir -> FVec
 edge dir = FVec x y
     where
-	[x,y] = f dir
-	f dir
-	    | dir == hu = [1, 0]
-	    | dir == hv = [-1/2, -3*ylen/2]
-	    | dir == hw = [-1/2, 3*ylen/2]
-	    | not (isHexDir dir) = error "edge: not a hexdir"
-	    | otherwise = map (\z -> -z) $ f $ neg dir
+        [x,y] = f dir
+        f dir
+            | dir == hu = [1, 0]
+            | dir == hv = [-1/2, -3*ylen/2]
+            | dir == hw = [-1/2, 3*ylen/2]
+            | not (isHexDir dir) = error "edge: not a hexdir"
+            | otherwise = map (\z -> -z) $ f $ neg dir
 
 rotFVec :: Float -> FVec -> FVec -> FVec
 rotFVec th (FVec cx cy) v@(FVec x y)
@@ -262,10 +262,10 @@
 colourWheel :: Int -> Pixel
 colourWheel n = Pixel $ (((((r * 0x100) + g) * 0x100) + b) * 0x100) + a
     where [r,g,b] = map (\on -> if on then 0xff else 0) $ colourWheel' n
-	  a = 0x00
-	  colourWheel' 0 = [True, False, False]
-	  colourWheel' 1 = [True, True, False]
-	  colourWheel' n = let [a,b,c] = colourWheel' $ n-2 in [c,a,b]
+          a = 0x00
+          colourWheel' 0 = [True, False, False]
+          colourWheel' 1 = [True, True, False]
+          colourWheel' n = let [a,b,c] = colourWheel' $ n-2 in [c,a,b]
 
 red = colourWheel 0
 yellow = colourWheel 1
@@ -277,8 +277,8 @@
 colourOf :: Ord i => Map i Int -> i -> Pixel
 colourOf colouring idx =
     case Map.lookup idx colouring of
-	    Nothing -> white
-	    Just n -> colourWheel n
+            Nothing -> white
+            Just n -> colourWheel n
 
 setPixelAlpha alpha (Pixel v) = Pixel $ v `div` 0x100 * 0x100 + alpha
 bright = setPixelAlpha 0xff
@@ -290,13 +290,13 @@
 
 pixelToRGBA (Pixel v) =
     let (r,v') = divMod v 0x1000000
-	(g,v'') = divMod v' 0x10000
-	(b,a) = divMod v'' 0x100
+        (g,v'') = divMod v' 0x10000
+        (b,a) = divMod v'' 0x100
     in (r,g,b,a)
 rgbaToPixel (r,g,b,a) = Pixel $ a+0x100*(b+0x100*(g+0x100*r))
 opaquify p =
     let (r,g,b,a) = pixelToRGBA p
-	[r',g',b'] = map (\v -> (v*a)`div`0xff) [r,g,b]
+        [r',g',b'] = map (\v -> (v*a)`div`0xff) [r,g,b]
     in rgbaToPixel (r',g',b',0xff)
 
 messageCol = white
@@ -318,10 +318,10 @@
     fsurf <- MaybeT $ liftIO $ TTF.tryRenderTextBlended font str $ pixelToColor c
     (surf, scrCentre, size) <- lift $ asks $ liftM3 (,,) renderSurf renderSCentre renderSize
     let SVec x y = scrCentre +^ (hexVec2SVec size v)
-	    +^ neg (SVec 0 ((surfaceGetHeight fsurf-1)`div`2) +^
-		if centred
-		    then SVec ((surfaceGetWidth fsurf)`div`2) 0
-		    else SVec 0 0)
+            +^ neg (SVec 0 ((surfaceGetHeight fsurf-1)`div`2) +^
+                if centred
+                    then SVec ((surfaceGetWidth fsurf)`div`2) 0
+                    else SVec 0 0)
     void $ liftIO $ blitSurface fsurf Nothing surf (Just $ Rect x y 0 0)
 
 renderStrColAbove,renderStrColBelow :: (Functor m, MonadIO m) => Pixel -> String -> HexVec -> RenderT m ()
@@ -339,22 +339,22 @@
     surf <- asks renderSurf
     mbgsurf <- asks renderBGSurf
     void $ liftIO $ maybe
-	(fillRect surf mrect black)
-	(\bgsurf -> blitSurface bgsurf mrect surf mrect)
-	mbgsurf
+        (fillRect surf mrect black)
+        (\bgsurf -> blitSurface bgsurf mrect surf mrect)
+        mbgsurf
 
 blankRow v = do
     (surf, scrCentre, size) <- asks $ liftM3 (,,) renderSurf renderSCentre renderSize
     let SVec _ y = scrCentre +^ (hexVec2SVec size v)
-	w = surfaceGetWidth surf
-	h = ceiling $ fi (size * 3 `div` 2) * 2 / sqrt 3
+        w = surfaceGetWidth surf
+        h = ceiling $ fi (size * 3 `div` 2) * 2 / sqrt 3
     fillRectBG $ Just $ Rect 0 (y-h`div`2) w h
 
 blitAt :: (Functor m, MonadIO m) => Surface -> HexVec -> RenderT m ()
 blitAt surface v = do
     (surf, scrCentre, size) <- asks $ liftM3 (,,) renderSurf renderSCentre renderSize
     let SVec x y = scrCentre +^ (hexVec2SVec size v)
-	w = surfaceGetWidth surface
-	h = surfaceGetHeight surface
+        w = surfaceGetWidth surface
+        h = surfaceGetHeight surface
     void $ liftIO $ blitSurface surface Nothing surf $ Just $
-	Rect (x-w`div`2) (y-h`div`2) (w+1) (h+1)
+        Rect (x-w`div`2) (y-h`div`2) (w+1) (h+1)
diff --git a/SDLUI.hs b/SDLUI.hs
--- a/SDLUI.hs
+++ b/SDLUI.hs
@@ -136,7 +136,7 @@
     now <- liftIO getTicks
     -- liftIO $ print now
     when (now < next) $
-	liftIO $ delay (next - now)
+        liftIO $ delay (next - now)
     modify $ \ds -> ds { lastFrameTicks = now }
 
 
@@ -151,59 +151,59 @@
     mwhs <- gets $ whsButtons.uiOptions
     cntxtButtons <- gets contextButtons
     return $ cntxtButtons ++ global ++ case mode of
-	IMEdit -> [
-	    singleButton (tl+^hv+^neg hw) CmdTest 1 [("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)] ]
-	    ++ whsBGs mwhs mode
-	    ++ [ ([Button (paintButtonStart +^ hu +^ i*^hv) (paintTileCmds!!i) []
-		| i <- take (length paintTiles) [0..] ],(5,0)) ]
-	IMPlay ->
-	    [ markGroup ]
-	    ++ whsBGs mwhs mode
-	IMReplay -> [ markGroup ]
-	IMMeta ->
-	    [ singleButton serverPos CmdSetServer 0 [("server",7*^neg hu)]
-	    , singleButton (serverPos+^hw) CmdToggleCacheOnly 0 [("offline",hv+^7*^neg hu),("mode",hw+^5*^neg hu)]
-	    , singleButton (codenamePos +^ 2*^neg hu) (CmdSelCodename Nothing) 2 [("code",hv+^5*^neg hu),("name",hw+^5*^neg hu)]
-	    , singleButton (serverPos +^ 2*^neg hv +^ 2*^hw) CmdTutorials 3 [("play",hu+^neg hw),("tut",hu+^neg hv)]
-	    ]
+        IMEdit -> [
+            singleButton (tl+^hv+^neg hw) CmdTest 1 [("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)] ]
+            ++ whsBGs mwhs mode
+            ++ [ ([Button (paintButtonStart +^ hu +^ i*^hv) (paintTileCmds!!i) []
+                | i <- take (length paintTiles) [0..] ],(5,0)) ]
+        IMPlay ->
+            [ markGroup ]
+            ++ whsBGs mwhs mode
+        IMReplay -> [ markGroup ]
+        IMMeta ->
+            [ singleButton serverPos CmdSetServer 0 [("server",7*^neg hu)]
+            , singleButton (serverPos+^hw) CmdToggleCacheOnly 0 [("offline",hv+^7*^neg hu),("mode",hw+^5*^neg hu)]
+            , singleButton (codenamePos +^ 2*^neg hu) (CmdSelCodename Nothing) 2 [("code",hv+^5*^neg hu),("name",hw+^5*^neg hu)]
+            , singleButton (serverPos +^ 2*^neg hv +^ 2*^hw) CmdTutorials 3 [("play",hu+^neg hw),("tut",hu+^neg hv)]
+            ]
 
-	_ -> []
-	where
-	    markGroup = ([Button (tl+^hw) CmdMark [("set",hu+^neg hw),("mark",hu+^neg hv)]
-		, Button (tl+^hw+^hv) CmdJumpMark [("jump",hu+^neg hw),("mark",hu+^neg hv)]
-		, Button (tl+^hw+^2*^hv) CmdReset [("jump",hu+^neg hw),("start",hu+^neg hv)]],(0,1))
-	    global = if mode `elem` [IMTextInput,IMImpatience] 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 ], (5,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)]
-			], (5,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
+        _ -> []
+        where
+            markGroup = ([Button (tl+^hw) CmdMark [("set",hu+^neg hw),("mark",hu+^neg hv)]
+                , Button (tl+^hw+^hv) CmdJumpMark [("jump",hu+^neg hw),("mark",hu+^neg hv)]
+                , Button (tl+^hw+^2*^hv) CmdReset [("jump",hu+^neg hw),("start",hu+^neg hv)]],(0,1))
+            global = if mode `elem` [IMTextInput,IMImpatience] 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 ], (5,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)]
+                        ], (5,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 AccessedInfo = AccessedSolved | AccessedPublic | AccessedReadNotes | AccessedUndeclared
     deriving (Eq, Ord, Show)
@@ -234,7 +234,7 @@
 registerSelectable :: HexVec -> Int -> Selectable -> UIM ()
 registerSelectable v r s =
     modify $ \ds -> ds {registeredSelectables = foldr
-	(`Map.insert` s) (registeredSelectables ds) $ map (v+^) $ hexDisc r}
+        (`Map.insert` s) (registeredSelectables ds) $ map (v+^) $ hexDisc r}
 registerButtonGroup :: ButtonGroup -> UIM ()
 registerButtonGroup g = modify $ \ds -> ds {contextButtons = g:contextButtons ds}
 registerButton :: HexVec -> Command -> Int -> [ButtonHelp] -> UIM ()
@@ -328,7 +328,7 @@
     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] ++ "."
+        " 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 ++ " did not pick this lock, but learnt how to unlock it by reading three notes on it."
@@ -339,7 +339,7 @@
     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."
+        "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 $
@@ -355,13 +355,13 @@
     buttons <- (concat . map fst) <$> getButtons im
     sels <- gets registeredSelectables
     return $ listToMaybe $
-	[ buttonCmd button
-	    | button <- buttons, mPos == buttonPos button, central]
-	++ maybe [] (\isRight ->
-		[ cmd
-		| Just sel <- [Map.lookup mPos sels]
-		, Just cmd <- [ commandOfSelectable im sel isRight ] ])
-	    selMode
+        [ buttonCmd button
+            | button <- buttons, mPos == buttonPos button, central]
+        ++ maybe [] (\isRight ->
+                [ cmd
+                | Just sel <- [Map.lookup mPos sels]
+                , Just cmd <- [ commandOfSelectable im sel isRight ] ])
+            selMode
 
 helpAtMousePos :: (HexVec, Bool) -> InputMode -> UIM (Maybe [Char])
 helpAtMousePos (mPos,_) _ =
@@ -374,41 +374,41 @@
 
 -- non-uniform type, so can't use a list...
 uiOB1 = UIOptButton useFiveColouring (\v o -> o {useFiveColouring=v}) [True,False]
-	(periphery 0 +^ 2 *^ hu) UseFiveColourButton
-	(\v -> if v then "Adjacent pieces get different colours" else
-	"Pieces are coloured according to type")
-	[IMPlay, IMReplay, IMEdit] Nothing
+        (periphery 0 +^ 2 *^ hu) UseFiveColourButton
+        (\v -> if v then "Adjacent pieces get different colours" else
+        "Pieces are coloured according to type")
+        [IMPlay, IMReplay, IMEdit] Nothing
 uiOB2 = UIOptButton showBlocks (\v o -> o {showBlocks=v}) [ShowBlocksBlocking,ShowBlocksAll,ShowBlocksNone]
-	(periphery 0 +^ 2 *^ hu +^ 2 *^ neg hv) ShowBlocksButton
-	(\v -> case v of
-	    ShowBlocksBlocking -> "Blocking forces are annotated"
-	    ShowBlocksAll -> "Blocked and blocking forces are annotated"
-	    ShowBlocksNone -> "Blockage annotations disabled")
-	[IMPlay, IMReplay] Nothing
+        (periphery 0 +^ 2 *^ hu +^ 2 *^ neg hv) ShowBlocksButton
+        (\v -> case v of
+            ShowBlocksBlocking -> "Blocking forces are annotated"
+            ShowBlocksAll -> "Blocked and blocking forces are annotated"
+            ShowBlocksNone -> "Blockage annotations disabled")
+        [IMPlay, IMReplay] Nothing
 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 (and rebind) keyboard control buttons."
-	    Just whs -> "Showing buttons for controlling " ++ case whs of
-		WHSSelected -> "selected piece; right-click to rebind"
-		WHSWrench -> "wrench; right-click to rebind"
-		WHSHook -> "hook; right-click to rebind")
-	[IMPlay, IMEdit] Nothing
+        (periphery 3 +^ 3 *^ hv) WhsButtonsButton
+        (\v -> case v of
+            Nothing -> "Click to show (and rebind) keyboard control buttons."
+            Just whs -> "Showing buttons for controlling " ++ case whs of
+                WHSSelected -> "selected piece; right-click to rebind"
+                WHSWrench -> "wrench; right-click to rebind"
+                WHSHook -> "hook; right-click to rebind")
+        [IMPlay, IMEdit] Nothing
 uiOB4 = UIOptButton showButtonText (\v o -> o {showButtonText=v}) [True,False]
-	(periphery 0 +^ 2 *^ hu +^ 2 *^ hv) ShowButtonTextButton
-	(\v -> if v then "Help text enabled" else
-	"Help text disabled")
-	[IMPlay, IMEdit, IMReplay, IMMeta] Nothing
+        (periphery 0 +^ 2 *^ hu +^ 2 *^ hv) ShowButtonTextButton
+        (\v -> if v then "Help text enabled" else
+        "Help text disabled")
+        [IMPlay, IMEdit, IMReplay, IMMeta] Nothing
 uiOB5 = UIOptButton fullscreen (\v o -> o {fullscreen=v}) [True,False]
-	(periphery 0 +^ 4 *^ hu +^ 2 *^ hv) FullscreenButton
-	(\v -> if v then "Currently in fullscreen mode; click to toggle" else
-	"Currently in windowed mode; click to toggle")
-	[IMPlay, IMEdit, IMReplay, IMMeta] (Just $ const $ initVideo 0 0)
+        (periphery 0 +^ 4 *^ hu +^ 2 *^ hv) FullscreenButton
+        (\v -> if v then "Currently in fullscreen mode; click to toggle" else
+        "Currently in windowed mode; click to toggle")
+        [IMPlay, IMEdit, IMReplay, IMMeta] (Just $ const $ initVideo 0 0)
 uiOB6 = UIOptButton useSounds (\v o -> o {useSounds=v}) [True,False]
-	(periphery 0 +^ 3 *^ hu +^ hv) UseSoundsButton
-	(\v -> if v then "Sound effects enabled" else
-	"Sound effects disabled")
-	[IMPlay, IMEdit, IMReplay] Nothing
+        (periphery 0 +^ 3 *^ hu +^ hv) UseSoundsButton
+        (\v -> if v then "Sound effects enabled" else
+        "Sound effects disabled")
+        [IMPlay, IMEdit, IMReplay] Nothing
 
 drawUIOptionButtons :: InputMode -> UIM ()
 drawUIOptionButtons mode = do
@@ -423,7 +423,7 @@
 drawUIOptionButton im b = when (im `elem` uiOptModes b) $ do
     value <- gets $ (getUIOpt b).uiOptions
     renderToMain $ mapM_ (\g -> drawAtRel g (uiOptPos b))
-	[HollowGlyph $ obscure purple, uiOptGlyph b value]
+        [HollowGlyph $ obscure purple, uiOptGlyph b value]
 describeUIOptionButton :: UIOptButton a -> MaybeT UIM String
 describeUIOptionButton b = do
     value <- gets $ (getUIOpt b).uiOptions
@@ -434,16 +434,16 @@
     let value' = head $ drop (1 + (fromMaybe 0 $ elemIndex value vals)) $ cycle vals
     modifyUIOptions $ setopt value'
     case monSet of
-	Nothing -> return ()
-	Just onSet -> onSet value'
+        Nothing -> return ()
+        Just onSet -> onSet value'
 
 readUIConfigFile :: UIM ()
 readUIConfigFile = do
     path <- liftIO $ confFilePath "SDLUI.conf"
     mOpts <- liftIO $ readReadFile path
     case mOpts of
-	Just opts -> modify $ \s -> s {uiOptions = opts}
-	Nothing -> return ()
+        Just opts -> modify $ \s -> s {uiOptions = opts}
+        Nothing -> return ()
 writeUIConfigFile :: UIM ()
 writeUIConfigFile = do
     path <- liftIO $ confFilePath "SDLUI.conf"
@@ -456,8 +456,8 @@
     path <- liftIO $ confFilePath "bindings"
     mbdgs <- liftIO $ readReadFile path
     case mbdgs of
-	Just bdgs -> modify $ \s -> s {uiKeyBindings = bdgs}
-	Nothing -> return ()
+        Just bdgs -> modify $ \s -> s {uiKeyBindings = bdgs}
+        Nothing -> return ()
 writeBindings :: UIM ()
 writeBindings = do
     path <- liftIO $ confFilePath "bindings"
@@ -496,16 +496,16 @@
 drawPaintButtons = do
     pti <- getEffPaintTileIndex
     renderToMain $ sequence_ [
-	do
-	    let gl = case paintTiles!!i of
-		    Nothing -> HollowInnerGlyph $ dim purple
-		    Just t -> TileGlyph t $ dim purple
-	    drawAtRel gl pos
-	    when selected $ drawAtRel cursorGlyph pos
-	| i <- take (length paintTiles) [0..]
-	, let pos = paintButtonStart +^ i*^hv
-	, let selected = i == pti
-	]
+        do
+            let gl = case paintTiles!!i of
+                    Nothing -> HollowInnerGlyph $ dim purple
+                    Just t -> TileGlyph t $ dim purple
+            drawAtRel gl pos
+            when selected $ drawAtRel cursorGlyph pos
+        | i <- take (length paintTiles) [0..]
+        , let pos = paintButtonStart +^ i*^hv
+        , let selected = i == pti
+        ]
 
 periphery 0 = ((3*maxlocksize)`div`2)*^hu +^ ((3*maxlocksize)`div`4)*^hv
 periphery n = rotate n $ periphery 0
@@ -524,11 +524,11 @@
     let scrCentre = SVec (w`div`2) (h`div`2)
     -- |size is the greatest integer such that
     -- and [2*size*screenWidthHexes <= width
-    --	, 3*ysize size*screenHeightHexes <= height]
-    --	where ysize size = round $ fi size / sqrt 3
+    --        , 3*ysize size*screenHeightHexes <= height]
+    --        where ysize size = round $ fi size / sqrt 3
     -- Minimum allowed size is 2 (get segfaults on SDL_FreeSurface with 1).
     let size = max 2 $ minimum [ w`div`(2*screenWidthHexes)
-	    , floor $ sqrt 3 * (0.5 + (fi $ h`div`(3*screenHeightHexes)))]
+            , floor $ sqrt 3 * (0.5 + (fi $ h`div`(3*screenHeightHexes)))]
     return (scrCentre, size)
 
 data DrawArgs = DrawArgs [PieceIdx] Bool [Alert] GameState UIOptions
@@ -543,58 +543,58 @@
 drawMainGameState' args@(DrawArgs highlight colourFixed alerts st uiopts) = do
     lastArgs <- gets lastDrawArgs
     when (case lastArgs of
-	    Nothing -> True
-	    Just (DrawArgs _ _ lastAlerts lastSt _) ->
-		lastAlerts /= alerts || lastSt /= st) $
-	modify $ \ds -> ds { animFrame = 0, nextAnimFrameAt = Nothing }
+            Nothing -> True
+            Just (DrawArgs _ _ lastAlerts lastSt _) ->
+                lastAlerts /= alerts || lastSt /= st) $
+        modify $ \ds -> ds { animFrame = 0, nextAnimFrameAt = Nothing }
 
     lastAnimFrame <- gets animFrame
     now <- liftIO getTicks
     anim <- maybe False (<now) <$> gets nextAnimFrameAt
     when anim $
-	modify $ \ds -> ds { animFrame = lastAnimFrame+1, nextAnimFrameAt = Nothing }
+        modify $ \ds -> ds { animFrame = lastAnimFrame+1, nextAnimFrameAt = Nothing }
     animFrameToDraw <- gets animFrame
     void $ if (lastArgs == Just args && lastAnimFrame == animFrameToDraw)
-	then do
-	    vidSurf <- liftIO getVideoSurface
-	    gsSurf <- liftM fromJust $ gets gsSurface
-	    liftIO $ blitSurface gsSurf Nothing vidSurf Nothing
-	else do
-	    modify $ \ds -> ds { lastDrawArgs = Just args }
+        then do
+            vidSurf <- liftIO getVideoSurface
+            gsSurf <- liftM fromJust $ gets gsSurface
+            liftIO $ blitSurface gsSurf Nothing vidSurf Nothing
+        else do
+            modify $ \ds -> ds { lastDrawArgs = Just args }
 
-	    -- split the alerts at intermediate states, and associate alerts
-	    -- to the right states:
-	    let (globalAlerts,transitoryAlerts) = partition isGlobalAlert alerts
-		splitAlerts frameAs (AlertIntermediateState st' : as) =
-		    (frameAs,st',True) : splitAlerts [] as
-		splitAlerts frameAs (a:as) =
-		    splitAlerts (a:frameAs) as
-		splitAlerts frameAs [] = [(frameAs,st,False)]
-		isGlobalAlert (AlertAppliedForce _) = False
-		isGlobalAlert (AlertIntermediateState _) = False
-		isGlobalAlert _ = True
-	    let animAlertedStates = nub $
-		    let ass = splitAlerts [] transitoryAlerts
-		    in if last ass == ([],st,False) then ass else ass ++ [([],st,False)]
-	    let frames = length animAlertedStates
-	    let (drawAlerts',drawSt,isIntermediate) = animAlertedStates !! animFrameToDraw
-	    let drawAlerts = drawAlerts' ++ globalAlerts
-	    -- let drawAlerts = takeWhile (/= AlertIntermediateState drawSt) alerts
-	    nextIsSet <- isJust <$> gets nextAnimFrameAt
-	    when (not nextIsSet && frames > animFrameToDraw+1) $ do
-		time <- (if isIntermediate then uiAnimTime else shortUiAnimTime) <$>
+            -- split the alerts at intermediate states, and associate alerts
+            -- to the right states:
+            let (globalAlerts,transitoryAlerts) = partition isGlobalAlert alerts
+                splitAlerts frameAs (AlertIntermediateState st' : as) =
+                    (frameAs,st',True) : splitAlerts [] as
+                splitAlerts frameAs (a:as) =
+                    splitAlerts (a:frameAs) as
+                splitAlerts frameAs [] = [(frameAs,st,False)]
+                isGlobalAlert (AlertAppliedForce _) = False
+                isGlobalAlert (AlertIntermediateState _) = False
+                isGlobalAlert _ = True
+            let animAlertedStates = nub $
+                    let ass = splitAlerts [] transitoryAlerts
+                    in if last ass == ([],st,False) then ass else ass ++ [([],st,False)]
+            let frames = length animAlertedStates
+            let (drawAlerts',drawSt,isIntermediate) = animAlertedStates !! animFrameToDraw
+            let drawAlerts = drawAlerts' ++ globalAlerts
+            -- let drawAlerts = takeWhile (/= AlertIntermediateState drawSt) alerts
+            nextIsSet <- isJust <$> gets nextAnimFrameAt
+            when (not nextIsSet && frames > animFrameToDraw+1) $ do
+                time <- (if isIntermediate then uiAnimTime else shortUiAnimTime) <$>
                     gets uiOptions
-		modify $ \ds -> ds { nextAnimFrameAt = Just $ now + time }
+                modify $ \ds -> ds { nextAnimFrameAt = Just $ now + time }
 
-	    let board = stateBoard drawSt
-	    lastCol <- gets dispLastCol
-	    let coloured = colouredPieces colourFixed drawSt
-	    let colouring = if useFiveColouring uiopts
-		then boardColouring drawSt coloured lastCol
-		else pieceTypeColouring drawSt coloured
-	    modify $ \ds -> ds { dispLastCol = colouring }
-	    gsSurf <- liftM fromJust $ gets gsSurface
-	    renderToMainWithSurf gsSurf $ do
+            let board = stateBoard drawSt
+            lastCol <- gets dispLastCol
+            let coloured = colouredPieces colourFixed drawSt
+            let colouring = if useFiveColouring uiopts
+                then boardColouring drawSt coloured lastCol
+                else pieceTypeColouring drawSt coloured
+            modify $ \ds -> ds { dispLastCol = colouring }
+            gsSurf <- liftM fromJust $ gets gsSurface
+            renderToMainWithSurf gsSurf $ do
                 let tileGlyphs = fmap (ownedTileGlyph colouring highlight) board
 
                     applyAlert (AlertAppliedForce f@(Torque idx tdir)) =
@@ -640,25 +640,25 @@
 
                     applyAlerts = flip (foldr applyAlert) drawAlerts
 
-		erase
-		sequence_ [ drawAt glyph pos |
-		    (pos,glyph) <- Map.toList $ applyAlerts tileGlyphs
-		    ]
+                erase
+                sequence_ [ drawAt glyph pos |
+                    (pos,glyph) <- Map.toList $ applyAlerts tileGlyphs
+                    ]
 
-		when (showBlocks uiopts /= ShowBlocksNone) $ sequence_
-		    $ [ drawBlocked drawSt colouring False force
-			| AlertBlockedForce force <- drawAlerts
-			, showBlocks uiopts == ShowBlocksAll ]
-		    ++ [ drawBlocked drawSt colouring True force
-			| AlertBlockingForce force <- drawAlerts ]
-		    -- ++ [ drawBlocked drawSt colouring True force |
-		    -- AlertResistedForce force <- drawAlerts ]
-		    ++ [ drawAt CollisionMarker pos
-			| AlertCollision pos <- drawAlerts ]
-		    -- ++ [ drawApplied drawSt colouring force
-		    --    | AlertAppliedForce force <- drawAlerts ]
-	    vidSurf <- liftIO getVideoSurface
-	    liftIO $ blitSurface gsSurf Nothing vidSurf Nothing
+                when (showBlocks uiopts /= ShowBlocksNone) $ sequence_
+                    $ [ drawBlocked drawSt colouring False force
+                        | AlertBlockedForce force <- drawAlerts
+                        , showBlocks uiopts == ShowBlocksAll ]
+                    ++ [ drawBlocked drawSt colouring True force
+                        | AlertBlockingForce force <- drawAlerts ]
+                    -- ++ [ drawBlocked drawSt colouring True force |
+                    -- AlertResistedForce force <- drawAlerts ]
+                    ++ [ drawAt CollisionMarker pos
+                        | AlertCollision pos <- drawAlerts ]
+                    -- ++ [ drawApplied drawSt colouring force
+                    --    | AlertAppliedForce force <- drawAlerts ]
+            vidSurf <- liftIO getVideoSurface
+            liftIO $ blitSurface gsSurf Nothing vidSurf Nothing
 
 playAlertSounds :: GameState -> [Alert] -> UIM ()
 #ifdef SOUND
@@ -666,36 +666,36 @@
     use <- useSounds <$> gets uiOptions
     when use $ mapM_ (maybe (return ()) playSound . alertSound) alerts
     where
-	alertSound (AlertBlockedForce force) =
-	    let PlacedPiece _ piece = getpp st $ forceIdx force
-	    in case piece of
-		Wrench _ -> Just "wrenchblocked"
-		Hook _ _ -> if isPush force then Just "hookblocked" else Just "hookarmblocked"
-		_ -> Nothing
-	alertSound (AlertDivertedWrench _) = Just "wrenchscrape"
-	alertSound (AlertAppliedForce (Torque idx _))
-	    | isPivot.placedPiece.getpp st $ idx = Just "pivot"
-	alertSound (AlertAppliedForce (Push idx dir))
-	    | isBall.placedPiece.getpp st $ idx = Just "ballmove"
-	alertSound (AlertAppliedForce (Push idx dir)) = do
-	    (align,newLen) <- listToMaybe [(align,newLen)
-		| c@(Connection (startIdx,_) (endIdx,_) (Spring outDir natLen)) <- connections st
-		, let align = (if outDir == dir then 1 else if outDir == neg dir then -1 else 0)
-			* (if idx == startIdx then 1 else if idx == endIdx then -1 else 0)
-		, align /= 0
-		, let newLen = connectionLength st c ]
-	    return $ "spring" ++ (if align == 1 then "contract" else "extend")
-		++ show (min newLen 12)
-	alertSound AlertUnlocked = Just "unlocked"
-	alertSound _ = Nothing
-	playSound :: String -> UIM ()
-	playSound sound = void.runMaybeT $ do
-	    ss <- MaybeT $ Map.lookup sound <$> gets sounds
-	    guard.not.null $ ss
-	    liftIO $ randFromList ss >>= \(Just s) -> void $ tryPlayChannel (-1) s 0
-	randFromList :: [a] -> IO (Maybe a)
-	randFromList [] = return Nothing
-	randFromList as = (Just.(as!!)) <$> randomRIO (0,length as - 1)
+        alertSound (AlertBlockedForce force) =
+            let PlacedPiece _ piece = getpp st $ forceIdx force
+            in case piece of
+                Wrench _ -> Just "wrenchblocked"
+                Hook _ _ -> if isPush force then Just "hookblocked" else Just "hookarmblocked"
+                _ -> Nothing
+        alertSound (AlertDivertedWrench _) = Just "wrenchscrape"
+        alertSound (AlertAppliedForce (Torque idx _))
+            | isPivot.placedPiece.getpp st $ idx = Just "pivot"
+        alertSound (AlertAppliedForce (Push idx dir))
+            | isBall.placedPiece.getpp st $ idx = Just "ballmove"
+        alertSound (AlertAppliedForce (Push idx dir)) = do
+            (align,newLen) <- listToMaybe [(align,newLen)
+                | c@(Connection (startIdx,_) (endIdx,_) (Spring outDir natLen)) <- connections st
+                , let align = (if outDir == dir then 1 else if outDir == neg dir then -1 else 0)
+                        * (if idx == startIdx then 1 else if idx == endIdx then -1 else 0)
+                , align /= 0
+                , let newLen = connectionLength st c ]
+            return $ "spring" ++ (if align == 1 then "contract" else "extend")
+                ++ show (min newLen 12)
+        alertSound AlertUnlocked = Just "unlocked"
+        alertSound _ = Nothing
+        playSound :: String -> UIM ()
+        playSound sound = void.runMaybeT $ do
+            ss <- MaybeT $ Map.lookup sound <$> gets sounds
+            guard.not.null $ ss
+            liftIO $ randFromList ss >>= \(Just s) -> void $ tryPlayChannel (-1) s 0
+        randFromList :: [a] -> IO (Maybe a)
+        randFromList [] = return Nothing
+        randFromList as = (Just.(as!!)) <$> randomRIO (0,length as - 1)
 #else
 playAlertSounds _ _ = return ()
 #endif
@@ -706,27 +706,27 @@
     surface <- Map.lookup lock <$> gets miniLocks >>= maybe new return
     renderToMain $ blitAt surface v
     where
-	miniLocksize = 3
-	new = do
-	    (_, size) <- getGeom
-	    let minisize = size `div` (ceiling $ lockSize lock % miniLocksize)
-	    let width = size*2*(miniLocksize*2+1)
-	    let height = ceiling $ fi size * sqrt 3 * fi (miniLocksize*2+1+1)
-	    surf <- liftIO $ createRGBSurface [] width height 16 0 0 0 0
-	    liftIO $ setColorKey surf [SrcColorKey,RLEAccel] $ Pixel 0
-	    uiopts <- gets uiOptions
-	    let st = snd $ reframe lock
-		coloured = colouredPieces False st
-		colouring = if useFiveColouring uiopts
-		    then boardColouring st coloured Map.empty
-		    else pieceTypeColouring st coloured
-		draw = sequence_ [ drawAt glyph pos |
-		    (pos,glyph) <- Map.toList $ fmap (ownedTileGlyph colouring []) $ stateBoard st ]
-	    liftIO $ runRenderM draw emptyCachedGlyphs $
-		RenderContext surf Nothing (PHS zero) (SVec (width`div`2) (height`div`2)) minisize Nothing
-	    clearOldMiniLocks
-	    modify $ \ds -> ds { miniLocks = Map.insert lock surf $ miniLocks ds }
-	    return surf
+        miniLocksize = 3
+        new = do
+            (_, size) <- getGeom
+            let minisize = size `div` (ceiling $ lockSize lock % miniLocksize)
+            let width = size*2*(miniLocksize*2+1)
+            let height = ceiling $ fi size * sqrt 3 * fi (miniLocksize*2+1+1)
+            surf <- liftIO $ createRGBSurface [] width height 16 0 0 0 0
+            liftIO $ setColorKey surf [SrcColorKey,RLEAccel] $ Pixel 0
+            uiopts <- gets uiOptions
+            let st = snd $ reframe lock
+                coloured = colouredPieces False st
+                colouring = if useFiveColouring uiopts
+                    then boardColouring st coloured Map.empty
+                    else pieceTypeColouring st coloured
+                draw = sequence_ [ drawAt glyph pos |
+                    (pos,glyph) <- Map.toList $ fmap (ownedTileGlyph colouring []) $ stateBoard st ]
+            liftIO $ runRenderM draw emptyCachedGlyphs $
+                RenderContext surf Nothing (PHS zero) (SVec (width`div`2) (height`div`2)) minisize Nothing
+            clearOldMiniLocks
+            modify $ \ds -> ds { miniLocks = Map.insert lock surf $ miniLocks ds }
+            return surf
 
 -- | TODO: do this more cleverly
 clearOldMiniLocks =
@@ -741,8 +741,8 @@
     setting <- gets settingBinding
     uibdgs <- Map.findWithDefault [] mode `liftM` gets uiKeyBindings
     return (\cmd ->
-	if Just cmd == setting then "??"
-	else maybe "" showKey $ findBinding (uibdgs ++ bindings mode) cmd)
+        if Just cmd == setting then "??"
+        else maybe "" showKey $ findBinding (uibdgs ++ bindings mode) cmd)
 
 drawButtons :: InputMode -> UIM ()
 drawButtons mode = do
@@ -751,16 +751,16 @@
     showBT <- showButtonText <$> gets uiOptions
     smallFont <- gets dispFontSmall
     renderToMain $ sequence_ $ concat [ [ do
-		drawAtRel (ButtonGlyph col) v
-		(if length bdg > 2 then withFont smallFont else id) $
+                drawAtRel (ButtonGlyph col) v
+                (if length bdg > 2 then withFont smallFont else id) $
                     renderStrColAt buttonTextCol bdg v
-		when showBT $
-		    withFont smallFont $ recentreAt v $ rescaleRender (1/4) $
-		    sequence_ [ renderStrColAtLeft white s dv | (s,dv) <- helps ]
-	    | (i,(v,bdg,helps)) <- enumerate $ map (\b->(buttonPos b, bindingStr $ buttonCmd b, buttonHelp b)) $ buttonGroup
-		, let col = dim $ colourWheel (base+inc*i) ]
-	| (buttonGroup,(base,inc)) <- buttons
-	]
+                when showBT $
+                    withFont smallFont $ recentreAt v $ rescaleRender (1/4) $
+                    sequence_ [ renderStrColAtLeft white s dv | (s,dv) <- helps ]
+            | (i,(v,bdg,helps)) <- enumerate $ map (\b->(buttonPos b, bindingStr $ buttonCmd b, buttonHelp b)) $ buttonGroup
+                , let col = dim $ colourWheel (base+inc*i) ]
+        | (buttonGroup,(base,inc)) <- buttons
+        ]
     where enumerate = zip [0..]
 
 initMisc :: IO ()
@@ -769,21 +769,21 @@
 initVideo :: Int -> Int -> UIM ()
 initVideo w h = do
     liftIO $ (((w,h)==(0,0) &&) . (InitVideo `elem`) <$> wasInit [InitVideo]) >>?
-	-- reset video so that passing (0,0) to setVideoMode sets to
-	-- current screen res rather than current window size
-	(quitSubSystem [InitVideo] >> initSubSystem [InitVideo] >> initMisc)
+        -- reset video so that passing (0,0) to setVideoMode sets to
+        -- current screen res rather than current window size
+        (quitSubSystem [InitVideo] >> initSubSystem [InitVideo] >> initMisc)
 
     fs <- fullscreen <$> gets uiOptions
     liftIO $ do
-	(w',h') <- if (fs || (w,h)/=(0,0)) then return (w,h) else do
-	    -- use smaller dimensions than the screen's, to work around a bug
-	    -- seen on mac, whereby a resizable window created with
-	    -- (w,h)=(0,0), or even with the (w,h) given by getDimensions
-	    -- after creating such a window, is reported to be larger than it
-	    -- is.
-	    (w',h') <- getDimensions
-	    return $ (4*w'`div`5,4*h'`div`5)
-	setVideoMode w' h' 0 $ if fs then [Fullscreen] else [Resizable]
+        (w',h') <- if (fs || (w,h)/=(0,0)) then return (w,h) else do
+            -- use smaller dimensions than the screen's, to work around a bug
+            -- seen on mac, whereby a resizable window created with
+            -- (w,h)=(0,0), or even with the (w,h) given by getDimensions
+            -- after creating such a window, is reported to be larger than it
+            -- is.
+            (w',h') <- getDimensions
+            return $ (4*w'`div`5,4*h'`div`5)
+        setVideoMode w' h' 0 $ if fs then [Fullscreen] else [Resizable]
 
     (w',h') <- liftIO getDimensions
 
@@ -801,21 +801,21 @@
 
     useBG <- gets $ useBackground.uiOptions
     mbg <- if useBG then do
-	    bgsurf <- liftIO $ createRGBSurface [] w' h' 16 0 0 0 0
-	    renderToMainWithSurf bgsurf $ drawBasicBG $ 2*(max screenWidthHexes screenHeightHexes)`div`3
-	    return $ Just bgsurf
-	else return Nothing
+            bgsurf <- liftIO $ createRGBSurface [] w' h' 16 0 0 0 0
+            renderToMainWithSurf bgsurf $ drawBasicBG $ 2*(max screenWidthHexes screenHeightHexes)`div`3
+            return $ Just bgsurf
+        else return Nothing
     modify $ \ds -> ds { bgSurface = mbg }
 
     clearMiniLocks
 
     when (isNothing font) $ lift $ do
-	let text = "Warning: font file not found at "++fontpath++".\n"
-	putStr text
-	writeFile "error.log" text
+        let text = "Warning: font file not found at "++fontpath++".\n"
+        putStr text
+        writeFile "error.log" text
 
     where
-	getDimensions = (videoInfoWidth &&& videoInfoHeight) <$> getVideoInfo
+        getDimensions = (videoInfoWidth &&& videoInfoHeight) <$> getVideoInfo
 
 
 initAudio :: UIM ()
@@ -825,27 +825,27 @@
     -- liftIO $ querySpec >>= print
     liftIO $ allocateChannels 16
     let seqWhileJust (m:ms) = m >>= \ret -> case ret of
-	    Nothing -> return []
-	    Just a -> (a:) <$> seqWhileJust ms
+            Nothing -> return []
+            Just a -> (a:) <$> seqWhileJust ms
     soundsdir <- liftIO $ getDataPath "sounds"
     sounds <- sequence [ do
-	    chunks <- liftIO $ seqWhileJust
-		[ runMaybeT $ do
-		    chunk <- msum $ map (MaybeT . tryLoadWAV) paths
-		    liftIO $ volumeChunk chunk vol
-		    return chunk
-		| n <- [1..]
-		, let paths = [soundsdir ++ [pathSeparator] ++ sound ++
-			"-" ++ (if n < 10 then ('0':) else id) (show n) ++ ext
-			| ext <- [".ogg", ".wav"] ]
-		, let vol = case sound of
-			"pivot" -> 64
-			"wrenchscrape" -> 64
-			_ -> 128
-		]
-	    return (sound,chunks)
-	| sound <- ["hookblocked","hookarmblocked","wrenchblocked","wrenchscrape","pivot","unlocked","ballmove"]
-		++ ["spring" ++ d ++ show l | d <- ["extend","contract"], l <- [1..12]] ]
+            chunks <- liftIO $ seqWhileJust
+                [ runMaybeT $ do
+                    chunk <- msum $ map (MaybeT . tryLoadWAV) paths
+                    liftIO $ volumeChunk chunk vol
+                    return chunk
+                | n <- [1..]
+                , let paths = [soundsdir ++ [pathSeparator] ++ sound ++
+                        "-" ++ (if n < 10 then ('0':) else id) (show n) ++ ext
+                        | ext <- [".ogg", ".wav"] ]
+                , let vol = case sound of
+                        "pivot" -> 64
+                        "wrenchscrape" -> 64
+                        _ -> 128
+                ]
+            return (sound,chunks)
+        | sound <- ["hookblocked","hookarmblocked","wrenchblocked","wrenchscrape","pivot","unlocked","ballmove"]
+                ++ ["spring" ++ d ++ show l | d <- ["extend","contract"], l <- [1..12]] ]
     -- liftIO $ print sounds
     modify $ \s -> s { sounds = Map.fromList sounds }
 #else
@@ -855,22 +855,22 @@
 pollEvents = do
     e <- pollEvent
     case e of
-	NoEvent -> return []
-	_ -> do
-	    es <- pollEvents
-	    return $ e:es
+        NoEvent -> return []
+        _ -> do
+            es <- pollEvents
+            return $ e:es
 
 drawMsgLine = void.runMaybeT $ do
     (col,str) <- msum
-	[ ((,) dimWhiteCol) <$> MaybeT (gets hoverStr)
-	, MaybeT $ gets message
-	]
+        [ ((,) dimWhiteCol) <$> MaybeT (gets hoverStr)
+        , MaybeT $ gets message
+        ]
     lift $ do
-	renderToMain $ blankRow messageLineCentre
-	smallFont <- gets dispFontSmall
-	renderToMain $
-	    (if length str > screenWidthHexes * 3 then withFont smallFont else id) $
-		renderStrColAt col str messageLineCentre
+        renderToMain $ blankRow messageLineCentre
+        smallFont <- gets dispFontSmall
+        renderToMain $
+            (if length str > screenWidthHexes * 3 then withFont smallFont else id) $
+                renderStrColAt col str messageLineCentre
 
 setMsgLineNoRefresh col str = do
     modify $ \s -> s { message = Just (col,str) }
diff --git a/SDLUIMInstance.hs b/SDLUIMInstance.hs
--- a/SDLUIMInstance.hs
+++ b/SDLUIMInstance.hs
@@ -54,817 +54,817 @@
 instance UIMonad (StateT UIState IO) where
     runUI m = evalStateT m nullUIState
     drawMainState = do
-	lift $ clearButtons >> clearSelectables
-	s <- get
-	let mode = ms2im s
-	lift $ waitFrame
-	drawMainState' s
-	lift . drawTitle =<< getTitle
-	lift $ do
-	    drawButtons mode
-	    drawUIOptionButtons mode
-	    gets needHoverUpdate >>? do
-		updateHoverStr mode
-		modify (\ds -> ds {needHoverUpdate=False})
-	    drawMsgLine
-	    drawShortMouseHelp mode
-	    refresh
-	where
-        drawMainState' (PlayState { psCurrentState=st, psLastAlerts=alerts,
-                wrenchSelected=wsel, psIsTut=isTut, psSolved=solved }) = do
-	    canUndo <- null <$> gets psGameStateMoveStack
-	    canRedo <- null <$> gets psUndoneStack
-	    lift $ do
-		let selTools = [ idx |
-			(idx, PlacedPiece pos p) <- enumVec $ placedPieces st
-			, or [wsel && isWrench p, not wsel && isHook p] ]
-		drawMainGameState selTools False alerts st
-		lb <- isJust <$> gets leftButtonDown
-		rb <- isJust <$> gets leftButtonDown
-		when isTut $ do
-		    centre <- gets dispCentre
-		    sequence_
-			[ registerSelectable (pos -^ centre) 0 $
-			    if isWrench p then SelToolWrench else SelToolHook
-			| PlacedPiece pos p <- Vector.toList $ placedPieces st
-			, not $ lb || rb
-			, isTool p
-			]
-		registerUndoButtons canUndo canRedo
-                registerButton (periphery 0) CmdOpen (if solved then 2 else 0) $
-                    [("open", hu+^neg hw)] ++ if solved && isTut
-                        then [("Click-->",9*^neg hu)]
-                        else []
-	drawMainState' (ReplayState { rsCurrentState=st, rsLastAlerts=alerts } ) = do
-	    canUndo <- null <$> gets rsGameStateMoveStack
-	    canRedo <- null <$> gets rsMoveStack
-	    lift $ do
-		drawMainGameState [] False alerts st
-		registerUndoButtons canUndo canRedo
-		renderToMain $ drawCursorAt Nothing
-	drawMainState' (EditState { esGameStateStack=(st:sts), esUndoneStack=undostack,
-		selectedPiece=selPiece, selectedPos=selPos }) = lift $ do
-	    drawMainGameState (maybeToList selPiece) True [] st
-	    renderToMain $ drawCursorAt $ if isNothing selPiece then Just selPos else Nothing
-	    registerUndoButtons (null sts) (null undostack)
-	    when (isJust selPiece) $ mapM_ registerButtonGroup
-		[ singleButton (periphery 2 +^ 3*^hw+^hv) CmdDelete 0 [("delete",hu+^neg hw)]
-		, singleButton (periphery 2 +^ 3*^hw) CmdMerge 1 [("merge",hu+^neg hw)]
-		]
-	    sequence_
-		[ when (null . filter (pred . placedPiece) . Vector.toList $ placedPieces st)
-		    $ registerButton (periphery 0 +^ d) cmd 2 [("place",hu+^neg hw),(tool,hu+^neg hv)]
-		| (pred,tool,cmd,d) <- [
-		    (isWrench, "wrench", CmdTile $ WrenchTile zero, (-4)*^hv +^ hw),
-		    (isHook, "hook", CmdTile $ HookTile, (-3)*^hv +^ hw) ] ]
-	    drawPaintButtons
-	drawMainState' (MetaState {curServer=saddr, undeclareds=undecls,
-		cacheOnly=cOnly, curAuth=auth, codenameStack=names,
-		randomCodenames=rnamestvar, retiredLocks=mretired, curLockPath=path,
-		curLock=mlock, listOffset=offset, asyncCount=count}) = do
-	    let ourName = authUser <$> auth
-	    let selName = listToMaybe names
-	    let home = isJust ourName && ourName == selName
-	    lift $ renderToMain $ (erase >> drawCursorAt Nothing)
-	    lift $ do
-		smallFont <- gets dispFontSmall
-		renderToMain $ withFont smallFont $ renderStrColAtLeft purple
-			(saddrStr saddr ++ if cOnly then " (offline mode)" else "")
-		    $ serverPos +^ hu
-
-	    when (length names > 1) $ lift $ registerButton
-		(codenamePos +^ neg hu +^ 2*^hw) CmdBackCodename 0 [("back",3*^hw)]
-
-	    runMaybeT $ do
-		name <- MaybeT (return selName)
-		FetchedRecord fresh err muirc <- lift $ getUInfoFetched 300 name
-		pending <- ((>0) <$>) $ liftIO $ atomically $ readTVar count
-		lift $ do
-		    lift $ do
-			unless ((fresh && not pending) || cOnly) $ do
-			    smallFont <- gets dispFontSmall
-			    let str = if pending then "(response pending)" else "(updating)"
-			    renderToMain $ withFont smallFont $
-				renderStrColBelow (opaquify $ dim errorCol) str $ codenamePos
-			maybe (return ()) (setMsgLineNoRefresh errorCol) err
-			when (fresh && (isNothing ourName || isNothing muirc || home)) $
-			    let reg = isNothing muirc || isJust ourName
-			    in registerButton (codenamePos +^ 2*^hu)
-				(if reg then CmdRegister $ isJust ourName else CmdAuth)
-				(if isNothing ourName then 2 else 0)
-				[(if reg then "reg" else "auth", 3*^hw)]
-		    (if isJust muirc then drawName else drawNullName) name codenamePos
-		    lift $ registerSelectable codenamePos 0 (SelSelectedCodeName name)
-		    drawRelScore name (codenamePos+^hu)
-		    when (isJust muirc) $ lift $
-			registerButton retiredPos CmdShowRetired 5 [("retired",hu+^neg hw)]
-		    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]])
-				    [ \pos -> (lift $ registerSelectable pos 1 (SelOldLock ls)) >> drawOldLock ls pos
-				    | ls <- retired ]
-				lift $ registerButton (retiredPos +^ hv) (CmdPlayLockSpec Nothing) 1 [("play",hu+^neg hw),("no.",hu+^neg hv)]
-			    Nothing -> do
-				sequence_ [ drawLockInfo (ActiveLock (codename uinfo) i) mlockinfo |
-				    (i,mlockinfo) <- assocs $ userLocks uinfo ]
-				when (isJust $ msum $ elems $ userLocks uinfo) $ lift $ do
-				    registerButton interactButtonsPos (CmdSolve Nothing) 2 [("solve",hu+^neg hw),("lock",hu+^neg hv)]
-                                    when (isJust ourName) $
-                                        registerButton (interactButtonsPos+^hw) (CmdViewSolution Nothing) 1 [("view",hu+^neg hw),("soln",hu+^neg hv)]
-
-	    when home $ do
-		lift.renderToMain $ renderStrColAt messageCol
-		    "Home" (codenamePos+^hw+^neg hv)
-		unless (null undecls) $ do
-		    lift.renderToMain $ renderStrColAtLeft messageCol "Undeclared:" (undeclsPos+^2*^hv+^neg hu)
-		    lift $ registerButton (undeclsPos+^hw+^neg hu) (CmdDeclare Nothing) 2 [("decl",hv+^4*^neg hu),("soln",hw+^4*^neg hu)]
-		    fillArea (undeclsPos+^hv)
-			(map (undeclsPos+^) $ hexDisc 1 ++ [hu+^neg hw, neg hu+^hv])
-			[ \pos -> (lift $ registerSelectable pos 0 (SelUndeclared undecl)) >> drawActiveLock al pos
-			| undecl@(Undeclared _ _ al) <- undecls ]
-		lift $ do
-		    maybe (drawEmptyMiniLock miniLockPos)
-			(\lock -> drawMiniLock lock miniLockPos)
-			(fst<$>mlock)
-		    registerSelectable miniLockPos 1 SelOurLock
-		    registerButton (miniLockPos+^3*^neg hw+^2*^hu) CmdEdit 2
-			[("edit",hu+^neg hw),("lock",hu+^neg hv)]
-		    registerButton lockLinePos CmdSelectLock 1 []
-		lift $ when (not $ null path) $ do
-		    renderToMain $ renderStrColAtLeft messageCol (take 16 path) $ lockLinePos +^ hu
-		    registerSelectable (lockLinePos +^ 2*^hu) 1 SelLockPath
-		    sequence_
-			[ registerButton (miniLockPos +^ 2*^neg hv +^ 2*^hu +^ dv) cmd 1
-			    [(dirText,hu+^neg hw),("lock",hu+^neg hv)]
-			| (dv,cmd,dirText) <- [(zero,CmdPrevLock,"prev"),(neg hw,CmdNextLock,"next")] ]
-		let tested = maybe False (isJust.snd) mlock
-		when (isJust mlock && home) $ lift $ registerButton
-		    (miniLockPos+^2*^neg hw+^3*^hu) (CmdPlaceLock Nothing)
-			(if tested then 2 else 1)
-			[("place",hu+^neg hw),("lock",hu+^neg hv)]
-	    rnames <- liftIO $ atomically $ readTVar rnamestvar
-	    unless (null rnames) $
-		fillArea randomNamesPos
-		    (map (randomNamesPos+^) $ hexDisc 2)
-		    [ \pos -> (lift $ registerSelectable pos 0 (SelRandom name)) >> drawName name pos
-		    | name <- rnames ]
-
-	    when (ourName /= selName) $ void $ runMaybeT $ do
-		when (isJust ourName) $
-		    lift.lift $ registerButton (codenamePos +^ hw +^ neg hv) CmdHome 1 [("home",3*^hw)]
-		sel <- liftMaybe selName
-		us <- liftMaybe ourName
-		ourUInfo <- mgetUInfo us
-		selUInfo <- mgetUInfo sel
-		let accesses = map (uncurry getAccessInfo) [(ourUInfo,selUInfo),(selUInfo,ourUInfo)]
-		let posLeft = scoresPos +^ hw +^ neg hu
-		let posRight = posLeft +^ 3*^hu
-		size <- snd <$> (lift.lift) getGeom
-		lift $ do
-		    lift.renderToMain $ renderStrColAbove (brightish white) "ESTEEM" $ scoresPos
-		    lift $ sequence_ [ registerSelectable (scoresPos+^v) 0 SelRelScore | v <- [hv, hv+^hu] ]
-		    drawRelScore sel scoresPos
-		    fillArea (posLeft+^hw) (map (posLeft+^) [zero,hw,neg hv])
-			[ \pos -> (lift $ registerSelectable pos 0 (SelScoreLock (Just sel) accessed $ ActiveLock us i)) >>
-			    drawNameWithCharAndCol us white (lockIndexChar i) col pos
-			| i <- [0..2]
-			, let accessed = accesses !! 0 !! i
-			, let col
-				| accessed == Just AccessedPub = dim pubColour
-				| (maybe False winsPoint) accessed = dim $ scoreColour $ -3
-				| otherwise = obscure $ scoreColour 3 ]
-		    fillArea (posRight+^hw) (map (posRight+^) [zero,hw,neg hv])
-			[ \pos -> (lift $ registerSelectable pos 0 (SelScoreLock Nothing accessed $ ActiveLock sel i)) >>
-			    drawNameWithCharAndCol sel white (lockIndexChar i) col pos
-			| i <- [0..2]
-			, let accessed = accesses !! 1 !! i
-			, let col
-				| accessed == Just AccessedPub = obscure pubColour
-				| (maybe False winsPoint) accessed = dim $ scoreColour $ 3
-				| otherwise = obscure $ scoreColour $ -3 ]
-		(posScore,negScore) <- MaybeT $ (snd<$>) <$> getRelScoreDetails sel
-		lift.lift $ sequence_
-		    [ do
-			renderToMain $ renderStrColAt (scoreColour score) (sign:show (abs score)) pos
-			registerSelectable pos 0 SelRelScoreComponent
-		    | (sign,score,pos) <-
-			[ ('-',-negScore,posLeft+^neg hv+^hw)
-			, ('+',posScore,posRight+^neg hv+^hw) ] ]
-
-	drawMainState' _ = return ()
-
-    drawMessage = say
-    drawPrompt full s = say $ s ++ (if full then "" else "_")
-    endPrompt = say ""
-    drawError = sayError
-
-    reportAlerts = playAlertSounds
-
-    getChRaw = resetMouseButtons >> getChRaw'
-        where
-            resetMouseButtons = modify $ \s -> s
-                { leftButtonDown = Nothing
-                , middleButtonDown = Nothing
-                , rightButtonDown = Nothing
-                }
-            getChRaw' = do
-                events <- liftIO getEvents
-                if not.null $ [ True | MouseButtonDown _ _ ButtonRight <- events ]
-                then return Nothing
-                else maybe getChRaw' (return.Just) $ listToMaybe $ [ ch
-                    | KeyDown (Keysym _ _ ch) <- events
-                    , ch /= '\0' ]
-
-    setUIBinding mode cmd ch =
-	modify $ \s -> s { uiKeyBindings =
-		Map.insertWith (\[bdg] -> \bdgs -> if bdg `elem` bdgs then delete bdg bdgs else bdg:bdgs)
-		    mode [(ch,cmd)] $ uiKeyBindings s }
-
-    getUIBinding mode cmd = ($cmd) <$> getBindingStr mode
-
-    initUI = liftM isJust (runMaybeT $ do
-	catchIOErrorMT $ SDL.init
-#ifdef SOUND
-            [InitVideo,InitAudio]
-#else
-            [InitVideo]
-#endif
-	catchIOErrorMT TTF.init
-	lift $ do
-	    readUIConfigFile
-	    initVideo 0 0
-	    liftIO $ initMisc
-	    w <- gets scrWidth
-	    h <- gets scrHeight
-	    liftIO $ warpMouse (fi $ w`div`2) (fi $ h`div`2)
-	    renderToMain $ erase
-	    initAudio
-	    readBindings
-	)
-	where
-	    catchIOErrorMT m = MaybeT $ liftIO $ catchIO (m >> return (Just ())) (\_ -> return Nothing)
-
-    endUI = do
-	writeUIConfigFile
-	writeBindings
-	liftIO $ quit
-
-    unblockInput = return $ pushEvent VideoExpose
-    suspend = return ()
-    redraw = return ()
-
-    impatience ticks = do
-	liftIO $ threadDelay 50000
-	if (ticks>20) then do
-		let pos = serverWaitPos
-		smallFont <- gets dispFontSmall
-		renderToMain $ do
-		    mapM (drawAtRel (FilledHexGlyph $ bright black)) [ pos +^ i*^hu | i <- [0..3] ]
-		    withFont smallFont $
-			renderStrColAtLeft errorCol ("waiting..."++replicate ((ticks`div`5)`mod`3) '.') $ pos
-		clearButtons
-		registerButton (pos +^ neg hv) CmdQuit 0 [("abort",hu+^neg hw)]
-		drawButtons IMImpatience
-		refresh
-		cmds <- getInput IMImpatience
-		return $ CmdQuit `elem` cmds
-	    else return False
-
-    warpPointer pos = do
-	(scrCentre, size) <- getGeom
-	centre <- gets dispCentre
-	let SVec x y = hexVec2SVec size (pos-^centre) +^ scrCentre
-	liftIO $ warpMouse (fi x) (fi y)
-	lbp <- gets leftButtonDown
-	rbp <- gets rightButtonDown
-	let [lbp',rbp'] = fmap (fmap (\_ -> (pos-^centre))) [lbp,rbp]
-	modify $ \s -> s {leftButtonDown = lbp', rightButtonDown = rbp'}
-
-    getUIMousePos = do
-	centre <- gets dispCentre
-	(Just.(+^centre).fst) <$> gets mousePos
-
-    setYNButtons = do
-	clearButtons
-	registerButton (periphery 5 +^ hw) (CmdInputChar 'Y') 2 []
-	registerButton (periphery 5 +^ neg hv) (CmdInputChar 'N') 0 []
-	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)
-	(cmds,uiChanged) <- if null events then return ([],False) else do
-	    oldUIState <- get
-	    cmds <- concat <$> mapM processEvent events
-	    setPaintFromCmds cmds
-	    newUIState <- get
-	    return (cmds,uistatesMayVisiblyDiffer oldUIState newUIState)
-	now <- liftIO getTicks
-	animFrameReady <- maybe False (<now) <$> gets nextAnimFrameAt
-	return $ cmds ++ if uiChanged || animFrameReady then [CmdRefresh] else []
-	where
-	    nubMouseMotions evs =
-		-- drop all but last mouse motion event
-		let nubMouseMotions' False (mm@(MouseMotion {}):evs) = mm:(nubMouseMotions' True evs)
-		    nubMouseMotions' True (mm@(MouseMotion {}):evs) = nubMouseMotions' True evs
-		    nubMouseMotions' b (ev:evs) = ev:(nubMouseMotions' b evs)
-		    nubMouseMotions' _ [] = []
-		in reverse $ nubMouseMotions' False $ reverse evs
-	    setPaintFromCmds cmds = sequence_
-		[ modify $ \s -> s { paintTileIndex = pti }
-		    | (pti,pt) <- zip [0..] paintTiles
-		    , cmd <- cmds
-		    , (isNothing pt && cmd == CmdDelete) ||
-			(isJust $ do
-			    pt' <- pt
-			    CmdTile t <- Just cmd
-			    guard $ ((==)`on`tileType) t pt') ]
-
-	    uistatesMayVisiblyDiffer uis1 uis2 =
-		uis1 { mousePos = (zero,False), lastFrameTicks=0 }
-		/= uis2 {mousePos = (zero,False), lastFrameTicks=0 }
-	    processEvent (KeyDown (Keysym _ _ ch)) = case mode of
-		IMTextInput -> return [CmdInputChar ch]
-		_ -> do
-		    setting <- gets settingBinding
-		    if isJust setting && ch /= '\0'
-		    then do
-			modify $ \s -> s {settingBinding = Nothing}
-			when (ch /= '\ESC') $ setUIBinding mode (fromJust setting) ch
-			return []
-		    else do
-			uibdgs <- Map.findWithDefault [] mode `liftM` gets uiKeyBindings
-			let mCmd = lookup ch $ uibdgs ++ bindings mode
-			return $ maybeToList mCmd
-	    processEvent (MouseMotion {}) = do
-		(oldMPos,_) <- gets mousePos
-		(pos@(mPos,_),(sx,sy,sz)) <- getMousePos
-		updateMousePos mode pos
-		lbp <- gets leftButtonDown
-		rbp <- gets rightButtonDown
-		centre <- gets dispCentre
-		let drag :: Maybe HexVec -> Maybe Command
-		    drag bp = do
-			fromPos@(HexVec x y z) <- bp
-			-- check we've dragged at least a full hex's distance:
-			guard $ not.all (\(a,b) -> abs ((fi a) - b) < 1.0) $ [(x,sx),(y,sy),(z,sz)]
-			let dir = hexVec2HexDirOrZero $ mPos -^ fromPos
-			guard $ dir /= zero
-			return $ CmdDrag (fromPos+^centre) dir
-		case mode of
-		    IMEdit -> case drag rbp of
-			Just cmd -> return [cmd]
-			Nothing -> if mPos /= oldMPos
-			    then do
-				pti <- getEffPaintTileIndex
-				return $ [ CmdMoveTo $ mPos +^ centre ] ++
-				    (if isJust lbp then [ CmdPaintFromTo (paintTiles!!pti) (oldMPos+^centre) (mPos+^centre) ] else [])
-			    else return []
-		    IMPlay -> return $ maybeToList $ msum $ map drag [lbp, rbp]
-		    _ -> return []
-		where
-		    mouseFromTo from to = do
-			let dir = hexVec2HexDirOrZero $ to -^ from
-			if dir /= zero
-			    then (CmdDir WHSSelected dir:) <$> mouseFromTo (from +^ dir) to
-			    else return []
-	    processEvent (MouseButtonDown _ _ ButtonLeft) = do
-		pos@(mPos,central) <- gets mousePos
-		modify $ \s -> s { leftButtonDown = Just mPos }
-		rb <- isJust <$> gets rightButtonDown
-		mcmd <- cmdAtMousePos pos mode (Just False)
-		let hotspotAction = listToMaybe
-			$ map (\cmd -> return [cmd]) (maybeToList mcmd)
-			++ [ (modify $ \s -> s {paintTileIndex = i}) >> return []
-			    | i <- take (length paintTiles) [0..]
-			    , mPos == paintButtonStart +^ i*^hv ]
-			++ [ toggleUIOption uiOB1 >> updateHoverStr mode >> return []
-			    | mPos == uiOptPos uiOB1 && mode `elem` uiOptModes uiOB1 ]
-			++ [ toggleUIOption uiOB2 >> updateHoverStr mode >> return []
-			    | mPos == uiOptPos uiOB2 && mode `elem` uiOptModes uiOB2 ]
-			++ [ toggleUIOption uiOB3 >> updateHoverStr mode >> return []
-			    | mPos == uiOptPos uiOB3 && mode `elem` uiOptModes uiOB3 ]
-			++ [ toggleUIOption uiOB4 >> updateHoverStr mode >> return []
-			    | mPos == uiOptPos uiOB4 && mode `elem` uiOptModes uiOB4 ]
-			++ [ toggleUIOption uiOB5 >> updateHoverStr mode >> return []
-			    | mPos == uiOptPos uiOB5 && mode `elem` uiOptModes uiOB5 ]
-#ifdef SOUND
-			++ [ toggleUIOption uiOB6 >> updateHoverStr mode >> return []
-			    | mPos == uiOptPos uiOB6 && mode `elem` uiOptModes uiOB6 ]
-#endif
-
-		if rb
-		then return [ CmdWait ]
-		else flip fromMaybe hotspotAction $ case mode of
-		    IMEdit -> do
-			pti <- getEffPaintTileIndex
-			return $ [ drawCmd (paintTiles!!pti) False ]
-		    IMPlay -> do
-			centre <- gets dispCentre
-			return $ [ CmdManipulateToolAt $ mPos +^ centre ]
-		    _ -> return []
-	    processEvent (MouseButtonUp _ _ ButtonLeft) = do
-		modify $ \s -> s { leftButtonDown = Nothing }
-		return []
-	    processEvent (MouseButtonDown _ _ ButtonRight) = do
-		pos@(mPos,_) <- gets mousePos
-		modify $ \s -> s { rightButtonDown = Just mPos }
-		lb <- isJust <$> gets leftButtonDown
-		if lb
-		then return [ CmdWait ]
-		else (fromMaybe [] <$>) $ runMaybeT $ msum
-		    [ do
-			cmd <- MaybeT $ cmdAtMousePos pos mode Nothing
-			guard $ mode /= IMTextInput
-			-- modify $ \s -> s { settingBinding = Just cmd }
-			return [ CmdBind $ Just cmd ]
-		    , do
-			cmd <- MaybeT $ cmdAtMousePos pos mode (Just True)
-			return [cmd]
-		    , case mode of
-			IMPlay -> return [ CmdClear, CmdWait ]
-			_ -> return [ CmdClear, CmdSelect ] ]
-	    processEvent (MouseButtonUp _ _ ButtonRight) = do
-		modify $ \s -> s { rightButtonDown = Nothing }
-		return [ CmdUnselect ]
-	    processEvent (MouseButtonDown _ _ ButtonWheelUp) = doWheel 1
-	    processEvent (MouseButtonDown _ _ ButtonWheelDown) = doWheel $ -1
-	    processEvent (MouseButtonDown _ _ ButtonMiddle) = do
-		(mPos,_) <- gets mousePos
-		modify $ \s -> s { middleButtonDown = Just mPos }
-		rb <- isJust <$> gets rightButtonDown
-		return $ if rb then [ CmdDelete ] else []
-	    processEvent (MouseButtonUp _ _ ButtonMiddle) = do
-		modify $ \s -> s { middleButtonDown = Nothing }
-		return []
-	    processEvent (VideoResize w h) = do
-		initVideo w h
-		return [ CmdRedraw ]
-	    processEvent VideoExpose = return [ CmdRefresh ]
-	    processEvent Quit = return [ CmdForceQuit ]
-
-	    processEvent _ = return []
-
-	    doWheel dw = do
-		rb <- isJust <$> gets rightButtonDown
-		mb <- isJust <$> gets middleButtonDown
-		if ((rb || mb || mode == IMReplay) && mode /= IMEdit)
-		    || (mb && mode == IMEdit)
-		then return [ if dw == 1 then CmdRedo else CmdUndo ]
-		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
-
-	    getMousePos :: UIM ((HexVec,Bool),(Double,Double,Double))
-	    getMousePos = do
-		(scrCentre, size) <- getGeom
-		(x,y,_) <- lift getMouseState
-		let sv = (SVec (fi x) (fi y)) +^ neg scrCentre
-		let mPos@(HexVec x y z) = sVec2HexVec size sv
-		let (sx,sy,sz) = sVec2dHV size sv
-		let isCentral = all (\(a,b) -> abs ((fi a) - b) < 0.5) $
-			[(x,sx),(y,sy),(z,sz)]
-		return ((mPos,isCentral),(sx,sy,sz))
-	    updateMousePos mode newPos = do
-		oldPos <- gets mousePos
-		when (newPos /= oldPos) $ do
-		    modify $ \ds -> ds { mousePos = newPos }
-		    updateHoverStr mode
-
-    showHelp mode HelpPageInput = do
-	bdgs <- nub <$> getBindings mode
-	smallFont <- gets dispFontSmall
-	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
-		extraHelpStrs = [["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."]]
-		    ++ case mode of
-			IMMeta -> [[
-			    "Basic game instructions:"
-			    , "Choose [C]odename, then [R]egister it;"
-			    , "select other players, and [S]olve their locks;"
-			    , "go [H]ome, then [E]dit and [P]lace a lock of your own;"
-			    , "you can then [D]eclare your solutions."
-			    , "Make other players green by solving their locks and not letting them solve yours."]]
-			_ -> []
-	    renderStrColAt cyan "Keybindings:" $ (screenHeightHexes`div`4)*^(hv+^neg hw)
-	    let keybindingsHeight = screenHeightHexes - (3 + length extraHelpStrs + sum (map length extraHelpStrs))
-	    sequence_ [ with $ renderStrColAtLeft messageCol
-			( keysStr ++ ": " ++ desc )
-			$ (x*bdgWidth-(screenWidthHexes-6)`div`2)*^hu +^ neg hv +^
-			  (screenHeightHexes`div`4 - y`div`2)*^(hv+^neg hw) +^
-			  (y`mod`2)*^hw
-		| ((keysStr,with,desc),(x,y)) <- zip [(keysStr,with,desc)
-			| group <- groupBy ((==) `on` snd) $ sortBy (compare `on` snd) bdgs
-			, let cmd = snd $ head group
-			, let desc = describeCommand cmd
-			, not $ null desc
-			, let chs = map fst group
-			, let keysStr = showKeys chs
-			, let with = if True -- 3*(bdgWidth-1) < length desc + length keysStr + 1
-				then withFont smallFont
-				else id
-			]
-		    (map (`divMod` keybindingsHeight) [0..])
-		, (x+1)*bdgWidth < screenWidthHexes]
-	    sequence_ [ renderStrColAt (if firstLine then cyan else messageCol) str
-			$ (screenHeightHexes`div`4 - y`div`2)*^(hv+^neg hw)
-			  +^ hw
-			  +^ (y`mod`2)*^hw
-		| ((str,firstLine),y) <- (intercalate [("",False)] $ (map (`zip` (True:repeat False)) extraHelpStrs)) `zip` [(keybindingsHeight+1)..] ]
-	refresh
-	return True
-    showHelp IMMeta HelpPageGame = do
-        renderToMain $ drawBasicHelpPage ("INTRICACY",red) (metagameHelpText,purple)
-        return True
-    showHelp IMMeta (HelpPageInitiated n) = do
-        renderToMain $ drawBasicHelpPage ("Initiation complete",purple) (initiationHelpText n,red)
-        return True
-    showHelp IMEdit HelpPageFirstEdit = do
-        renderToMain $ drawBasicHelpPage ("Your first lock:",purple) (firstEditHelpText,green)
-        return True
-    showHelp _ _ = return False
-
-    onNewMode mode = modify (\ds -> ds{needHoverUpdate=True}) >> say ""
-
-    withNoBG m = do
-        bg <- gets bgSurface
-        modify $ \uiState -> uiState{bgSurface=Nothing}
-        m
-        isNothing <$> gets bgSurface >>?
-            modify (\uiState -> uiState{bgSurface=bg})
-
-
-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 _ = []
-
--- waitEvent' : copy of SDL.Events.waitEvent, with the timeout increased
--- drastically to reduce CPU load when idling.
-waitEvent' :: IO Event
-waitEvent' = loop
-    where loop = do pumpEvents
-                    event <- pollEvent
-                    case event of
-                      NoEvent -> threadDelay 10000 >> loop
-                      _ -> return event
-
-getEvents = do
-    e <- waitEvent'
-    es <- pollEvents
-    return $ e:es
-
-getEventsTimeout us = do
-    es <- maybeToList <$> timeout us waitEvent'
-    es' <- pollEvents
-    return $ es++es'
-
-updateHoverStr :: InputMode -> UIM ()
-updateHoverStr mode = do
-    p@(mPos,isCentral) <- gets mousePos
-    showBT <- showButtonText <$> gets uiOptions
-    hstr <- runMaybeT $ msum
-	[ MaybeT ( cmdAtMousePos p mode Nothing ) >>= lift . describeCommandAndKeys
-	, guard showBT >> MaybeT (helpAtMousePos p mode)
-	, guard (showBT && mode == IMEdit) >> msum
-	    [ return $ "set paint mode: " ++ describeCommand (paintTileCmds!!i)
-	    | i <- take (length paintTiles) [0..]
-	    , mPos == paintButtonStart +^ i*^hv ]
-	, guard (mPos == uiOptPos uiOB1 && mode `elem` uiOptModes uiOB1) >> describeUIOptionButton uiOB1
-	, guard (mPos == uiOptPos uiOB2 && mode `elem` uiOptModes uiOB2) >> describeUIOptionButton uiOB2
-	, guard (mPos == uiOptPos uiOB3 && mode `elem` uiOptModes uiOB3) >> describeUIOptionButton uiOB3
-	, guard (mPos == uiOptPos uiOB4 && mode `elem` uiOptModes uiOB4) >> describeUIOptionButton uiOB4
-	, guard (mPos == uiOptPos uiOB5 && mode `elem` uiOptModes uiOB5) >> describeUIOptionButton uiOB5
-#ifdef SOUND
-	, guard (mPos == uiOptPos uiOB6 && mode `elem` uiOptModes uiOB6) >> describeUIOptionButton uiOB6
-#endif
-	]
-    modify $ \ds -> ds { hoverStr = hstr }
-    where
-	describeCommandAndKeys :: Command -> UIM String
-	describeCommandAndKeys cmd = do
-	    uibdgs <- Map.findWithDefault [] mode `liftM` gets uiKeyBindings
-	    return $ describeCommand cmd ++ " ["
-		++ concat (intersperse ","
-		    (map showKeyFriendly $ findBindings (uibdgs ++ bindings mode) cmd))
-		++ "]"
-
-
-fillArea :: HexVec -> [HexVec] -> [HexVec -> MainStateT UIM ()] -> MainStateT UIM ()
-fillArea centre area draws = do
-    offset <- gets listOffset
-    let na = length area
-	listButton cmd = \pos -> lift $ registerButton pos cmd 3 []
-	draws' = if offset > 0 && length draws > na
-	    then listButton CmdPrevPage :
-		drop (max 0 $ min (length draws - (na-1)) (na-1 + (na-2)*(offset-1))) draws
-	    else draws
-	selDraws = if length draws' > na
-	    then take (na-1) draws' ++ [listButton CmdNextPage]
-	    else take na draws'
-    sequence_ $ map (uncurry ($)) $
-	zip selDraws $ sortBy (compare `on` hexVec2SVec 37) $
-	    take (length selDraws) $ sortBy
-		(compare `on` (hexLen . (-^centre)))
-		area
-
-drawOldLock ls pos = void.runMaybeT $ msum [ do
-	lock <- mgetLock ls
-	lift.lift $ drawMiniLock lock pos
-    , 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
-	drawAtRel (playerGlyph col) pos
-	renderStrColAt buttonTextCol name pos
-drawRelScore name pos = do
-    col <- nameCol name
-    relScore <- getRelScore name
-    flip (maybe (return ())) relScore $ \score ->
-	lift $ do
-	    renderToMain $ renderStrColAt col
-		((if score > 0 then "+" else "") ++ show score) pos
-	    registerSelectable pos 0 SelRelScore
-
-drawNote note pos = case noteBehind note of
-    Just al -> drawActiveLock al pos
-    Nothing -> drawPublicNote (noteAuthor note) pos
-drawActiveLock al@(ActiveLock name i) pos = do
-    accessed <- accessedAL al
-    drawNameWithChar name
-	(if accessed then accColour else white)
-	(lockIndexChar i) pos
-drawPublicNote name =
-    drawNameWithChar name pubColour 'P'
-drawNameWithChar name charcol char pos = do
-    col <- nameCol name
-    drawNameWithCharAndCol name charcol char col pos
-drawNameWithCharAndCol :: String -> Pixel -> Char -> Pixel -> HexVec -> MainStateT UIM ()
-drawNameWithCharAndCol name charcol char col pos = do
-    size <- fi.snd <$> lift getGeom
-    let up = FVec 0 $ 1/2 - ylen
-    let down = FVec 0 $ ylen
-    smallFont <- lift $ gets dispFontSmall
-    lift.renderToMain $ do
-	drawAtRel (playerGlyph col) pos
-	displaceRender up $
-	    renderStrColAt buttonTextCol name pos
-	displaceRender down $ withFont smallFont $
-	    renderStrColAt charcol [char] pos
-pubWheelAngle = 5
-pubColour = colourWheel pubWheelAngle -- ==purple
-accColour = cyan
-nameCol name = do
-    ourName <- (authUser <$>) <$> gets curAuth
-    relScore <- getRelScore name
-    return $ dim $ case relScore of
-	    Nothing -> Pixel $ if ourName == Just name then 0xc0c0c000 else 0x80808000
-	    Just score -> scoreColour score
-scoreColour :: Int -> Pixel
-scoreColour score = Pixel $ case score of
-	0 -> 0x80800000
-	1 -> 0x70a00000
-	2 -> 0x40c00000
-	3 -> 0x00ff0000
-	(-1) -> 0xa0700000
-	(-2) -> 0xc0400000
-	(-3) -> 0xff000000
-
-drawLockInfo :: ActiveLock -> Maybe LockInfo -> MainStateT UIM ()
-drawLockInfo al@(ActiveLock name idx) Nothing = do
-    let centre = hw+^neg hv +^ 7*(idx-1)*^hu
-    lift $ drawEmptyMiniLock centre
-    drawNameWithCharAndCol name white (lockIndexChar idx) (invisible white) centre
-    ourName <- (authUser <$>) <$> gets curAuth
-    lift $ registerSelectable centre 3 $ SelLockUnset (ourName == Just name) al
-drawLockInfo al@(ActiveLock name idx) (Just lockinfo) = do
-    let centre = locksPos +^ 7*(idx-1)*^hu
-    let accessedByPos = centre +^ 3*^(hv +^ neg hw)
-    let accessedPos = centre +^ 2*^(hw +^ neg hv)
-    let notesPos = centre +^ 3*^(hw +^ neg hv)
-    ourName <- (authUser <$>) <$> gets curAuth
-    runMaybeT $ msum [
-	do
-	    lock <- mgetLock $ lockSpec lockinfo
-	    lift.lift $ do
-		drawMiniLock lock centre
-		registerSelectable centre 3 $ SelLock al
-	, lift $ do
-		drawActiveLock al centre
-		lift $ registerSelectable centre 3 $ SelLock al
-	]
-
-    size <- snd <$> lift getGeom
-    lift $ do
-	renderToMain $ displaceRender (FVec 1 0) $ renderStrColAt (brightish white) "UNLOCKED BY" $ accessedByPos +^ hv
-	registerSelectable (accessedByPos +^ hv) 0 SelPrivyHeader
-	registerSelectable (accessedByPos +^ hv +^ hu) 0 SelPrivyHeader
-    if public lockinfo
-    then lift $ do
-	renderToMain $ renderStrColAt pubColour "All" accessedByPos
-	registerSelectable accessedByPos 1 SelPublicLock
-    else if null $ accessedBy lockinfo
-	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
-		    , let d = j*^hw +^ i*^hu ]
-		$ [ \pos -> (lift $ registerSelectable pos 0 (SelSolution note)) >> drawNote note pos
-		    | 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
-		then Just (pubColour,"Accessed!",AccessedPublic)
-		else Just (accColour, "Solved!",AccessedSolved)
-	    else if any (\(Undeclared _ ls _) -> ls == lockSpec lockinfo) undecls
-		then Just (yellow, "Undeclared",AccessedUndeclared)
-		else Nothing
-	of
-	Just (col,str,selstr) -> lift $ do
-	    renderToMain $ renderStrColAt col str accessedPos
-	    registerSelectable accessedPos 1 (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 (SelAccessedInfo AccessedReadNotes)
-		fillArea (accessedPos+^neg hu) [ accessedPos +^ i*^hu | i <- [-1..1] ]
-		    $ take 3 $ [ \pos -> (lift $ registerSelectable pos 0 (SelReadNote note)) >> drawNote note pos
-			| note <- read ] ++ (repeat $ \pos -> (lift $ registerSelectable pos 0 SelReadNoteSlot >>
-				renderToMain (drawAtRel (HollowGlyph $ dim green) pos)))
-
-    lift $ do
-	renderToMain $ displaceRender (FVec 1 0) $ renderStrColAt (brightish white) "SECURING" $ notesPos +^ hv
-	registerSelectable (notesPos +^ hv) 0 SelNotesHeader
-	registerSelectable (notesPos +^ hv +^ hu) 0 SelNotesHeader
-    if null $ notesSecured lockinfo
-	then lift.renderToMain $ renderStrColAt dimWhiteCol "None" notesPos
-	else fillArea notesPos
-		[ notesPos +^ d | j <- [0..2], i <- [-2..3]
-		    , i-j > -4, i-j < 3
-		    , let d = j*^hw +^ i*^hu ]
-		[ \pos -> (lift $ registerSelectable pos 0 (SelSecured note)) >> drawActiveLock (noteOn note) pos
-		    | note <- notesSecured lockinfo ]
+        lift $ clearButtons >> clearSelectables
+        s <- get
+        let mode = ms2im s
+        lift $ waitFrame
+        drawMainState' s
+        lift . drawTitle =<< getTitle
+        lift $ do
+            drawButtons mode
+            drawUIOptionButtons mode
+            gets needHoverUpdate >>? do
+                updateHoverStr mode
+                modify (\ds -> ds {needHoverUpdate=False})
+            drawMsgLine
+            drawShortMouseHelp mode
+            refresh
+        where
+        drawMainState' (PlayState { psCurrentState=st, psLastAlerts=alerts,
+                wrenchSelected=wsel, psIsTut=isTut, psSolved=solved }) = do
+            canUndo <- null <$> gets psGameStateMoveStack
+            canRedo <- null <$> gets psUndoneStack
+            lift $ do
+                let selTools = [ idx |
+                        (idx, PlacedPiece pos p) <- enumVec $ placedPieces st
+                        , or [wsel && isWrench p, not wsel && isHook p] ]
+                drawMainGameState selTools False alerts st
+                lb <- isJust <$> gets leftButtonDown
+                rb <- isJust <$> gets leftButtonDown
+                when isTut $ do
+                    centre <- gets dispCentre
+                    sequence_
+                        [ registerSelectable (pos -^ centre) 0 $
+                            if isWrench p then SelToolWrench else SelToolHook
+                        | PlacedPiece pos p <- Vector.toList $ placedPieces st
+                        , not $ lb || rb
+                        , isTool p
+                        ]
+                registerUndoButtons canUndo canRedo
+                registerButton (periphery 0) CmdOpen (if solved then 2 else 0) $
+                    [("open", hu+^neg hw)] ++ if solved && isTut
+                        then [("Click-->",9*^neg hu)]
+                        else []
+        drawMainState' (ReplayState { rsCurrentState=st, rsLastAlerts=alerts } ) = do
+            canUndo <- null <$> gets rsGameStateMoveStack
+            canRedo <- null <$> gets rsMoveStack
+            lift $ do
+                drawMainGameState [] False alerts st
+                registerUndoButtons canUndo canRedo
+                renderToMain $ drawCursorAt Nothing
+        drawMainState' (EditState { esGameStateStack=(st:sts), esUndoneStack=undostack,
+                selectedPiece=selPiece, selectedPos=selPos }) = lift $ do
+            drawMainGameState (maybeToList selPiece) True [] st
+            renderToMain $ drawCursorAt $ if isNothing selPiece then Just selPos else Nothing
+            registerUndoButtons (null sts) (null undostack)
+            when (isJust selPiece) $ mapM_ registerButtonGroup
+                [ singleButton (periphery 2 +^ 3*^hw+^hv) CmdDelete 0 [("delete",hu+^neg hw)]
+                , singleButton (periphery 2 +^ 3*^hw) CmdMerge 1 [("merge",hu+^neg hw)]
+                ]
+            sequence_
+                [ when (null . filter (pred . placedPiece) . Vector.toList $ placedPieces st)
+                    $ registerButton (periphery 0 +^ d) cmd 2 [("place",hu+^neg hw),(tool,hu+^neg hv)]
+                | (pred,tool,cmd,d) <- [
+                    (isWrench, "wrench", CmdTile $ WrenchTile zero, (-4)*^hv +^ hw),
+                    (isHook, "hook", CmdTile $ HookTile, (-3)*^hv +^ hw) ] ]
+            drawPaintButtons
+        drawMainState' (MetaState {curServer=saddr, undeclareds=undecls,
+                cacheOnly=cOnly, curAuth=auth, codenameStack=names,
+                randomCodenames=rnamestvar, retiredLocks=mretired, curLockPath=path,
+                curLock=mlock, listOffset=offset, asyncCount=count}) = do
+            let ourName = authUser <$> auth
+            let selName = listToMaybe names
+            let home = isJust ourName && ourName == selName
+            lift $ renderToMain $ (erase >> drawCursorAt Nothing)
+            lift $ do
+                smallFont <- gets dispFontSmall
+                renderToMain $ withFont smallFont $ renderStrColAtLeft purple
+                        (saddrStr saddr ++ if cOnly then " (offline mode)" else "")
+                    $ serverPos +^ hu
+
+            when (length names > 1) $ lift $ registerButton
+                (codenamePos +^ neg hu +^ 2*^hw) CmdBackCodename 0 [("back",3*^hw)]
+
+            runMaybeT $ do
+                name <- MaybeT (return selName)
+                FetchedRecord fresh err muirc <- lift $ getUInfoFetched 300 name
+                pending <- ((>0) <$>) $ liftIO $ atomically $ readTVar count
+                lift $ do
+                    lift $ do
+                        unless ((fresh && not pending) || cOnly) $ do
+                            smallFont <- gets dispFontSmall
+                            let str = if pending then "(response pending)" else "(updating)"
+                            renderToMain $ withFont smallFont $
+                                renderStrColBelow (opaquify $ dim errorCol) str $ codenamePos
+                        maybe (return ()) (setMsgLineNoRefresh errorCol) err
+                        when (fresh && (isNothing ourName || isNothing muirc || home)) $
+                            let reg = isNothing muirc || isJust ourName
+                            in registerButton (codenamePos +^ 2*^hu)
+                                (if reg then CmdRegister $ isJust ourName else CmdAuth)
+                                (if isNothing ourName then 2 else 0)
+                                [(if reg then "reg" else "auth", 3*^hw)]
+                    (if isJust muirc then drawName else drawNullName) name codenamePos
+                    lift $ registerSelectable codenamePos 0 (SelSelectedCodeName name)
+                    drawRelScore name (codenamePos+^hu)
+                    when (isJust muirc) $ lift $
+                        registerButton retiredPos CmdShowRetired 5 [("retired",hu+^neg hw)]
+                    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]])
+                                    [ \pos -> (lift $ registerSelectable pos 1 (SelOldLock ls)) >> drawOldLock ls pos
+                                    | ls <- retired ]
+                                lift $ registerButton (retiredPos +^ hv) (CmdPlayLockSpec Nothing) 1 [("play",hu+^neg hw),("no.",hu+^neg hv)]
+                            Nothing -> do
+                                sequence_ [ drawLockInfo (ActiveLock (codename uinfo) i) mlockinfo |
+                                    (i,mlockinfo) <- assocs $ userLocks uinfo ]
+                                when (isJust $ msum $ elems $ userLocks uinfo) $ lift $ do
+                                    registerButton interactButtonsPos (CmdSolve Nothing) 2 [("solve",hu+^neg hw),("lock",hu+^neg hv)]
+                                    when (isJust ourName) $
+                                        registerButton (interactButtonsPos+^hw) (CmdViewSolution Nothing) 1 [("view",hu+^neg hw),("soln",hu+^neg hv)]
+
+            when home $ do
+                lift.renderToMain $ renderStrColAt messageCol
+                    "Home" (codenamePos+^hw+^neg hv)
+                unless (null undecls) $ do
+                    lift.renderToMain $ renderStrColAtLeft messageCol "Undeclared:" (undeclsPos+^2*^hv+^neg hu)
+                    lift $ registerButton (undeclsPos+^hw+^neg hu) (CmdDeclare Nothing) 2 [("decl",hv+^4*^neg hu),("soln",hw+^4*^neg hu)]
+                    fillArea (undeclsPos+^hv)
+                        (map (undeclsPos+^) $ hexDisc 1 ++ [hu+^neg hw, neg hu+^hv])
+                        [ \pos -> (lift $ registerSelectable pos 0 (SelUndeclared undecl)) >> drawActiveLock al pos
+                        | undecl@(Undeclared _ _ al) <- undecls ]
+                lift $ do
+                    maybe (drawEmptyMiniLock miniLockPos)
+                        (\lock -> drawMiniLock lock miniLockPos)
+                        (fst<$>mlock)
+                    registerSelectable miniLockPos 1 SelOurLock
+                    registerButton (miniLockPos+^3*^neg hw+^2*^hu) CmdEdit 2
+                        [("edit",hu+^neg hw),("lock",hu+^neg hv)]
+                    registerButton lockLinePos CmdSelectLock 1 []
+                lift $ when (not $ null path) $ do
+                    renderToMain $ renderStrColAtLeft messageCol (take 16 path) $ lockLinePos +^ hu
+                    registerSelectable (lockLinePos +^ 2*^hu) 1 SelLockPath
+                    sequence_
+                        [ registerButton (miniLockPos +^ 2*^neg hv +^ 2*^hu +^ dv) cmd 1
+                            [(dirText,hu+^neg hw),("lock",hu+^neg hv)]
+                        | (dv,cmd,dirText) <- [(zero,CmdPrevLock,"prev"),(neg hw,CmdNextLock,"next")] ]
+                let tested = maybe False (isJust.snd) mlock
+                when (isJust mlock && home) $ lift $ registerButton
+                    (miniLockPos+^2*^neg hw+^3*^hu) (CmdPlaceLock Nothing)
+                        (if tested then 2 else 1)
+                        [("place",hu+^neg hw),("lock",hu+^neg hv)]
+            rnames <- liftIO $ atomically $ readTVar rnamestvar
+            unless (null rnames) $
+                fillArea randomNamesPos
+                    (map (randomNamesPos+^) $ hexDisc 2)
+                    [ \pos -> (lift $ registerSelectable pos 0 (SelRandom name)) >> drawName name pos
+                    | name <- rnames ]
+
+            when (ourName /= selName) $ void $ runMaybeT $ do
+                when (isJust ourName) $
+                    lift.lift $ registerButton (codenamePos +^ hw +^ neg hv) CmdHome 1 [("home",3*^hw)]
+                sel <- liftMaybe selName
+                us <- liftMaybe ourName
+                ourUInfo <- mgetUInfo us
+                selUInfo <- mgetUInfo sel
+                let accesses = map (uncurry getAccessInfo) [(ourUInfo,selUInfo),(selUInfo,ourUInfo)]
+                let posLeft = scoresPos +^ hw +^ neg hu
+                let posRight = posLeft +^ 3*^hu
+                size <- snd <$> (lift.lift) getGeom
+                lift $ do
+                    lift.renderToMain $ renderStrColAbove (brightish white) "ESTEEM" $ scoresPos
+                    lift $ sequence_ [ registerSelectable (scoresPos+^v) 0 SelRelScore | v <- [hv, hv+^hu] ]
+                    drawRelScore sel scoresPos
+                    fillArea (posLeft+^hw) (map (posLeft+^) [zero,hw,neg hv])
+                        [ \pos -> (lift $ registerSelectable pos 0 (SelScoreLock (Just sel) accessed $ ActiveLock us i)) >>
+                            drawNameWithCharAndCol us white (lockIndexChar i) col pos
+                        | i <- [0..2]
+                        , let accessed = accesses !! 0 !! i
+                        , let col
+                                | accessed == Just AccessedPub = dim pubColour
+                                | (maybe False winsPoint) accessed = dim $ scoreColour $ -3
+                                | otherwise = obscure $ scoreColour 3 ]
+                    fillArea (posRight+^hw) (map (posRight+^) [zero,hw,neg hv])
+                        [ \pos -> (lift $ registerSelectable pos 0 (SelScoreLock Nothing accessed $ ActiveLock sel i)) >>
+                            drawNameWithCharAndCol sel white (lockIndexChar i) col pos
+                        | i <- [0..2]
+                        , let accessed = accesses !! 1 !! i
+                        , let col
+                                | accessed == Just AccessedPub = obscure pubColour
+                                | (maybe False winsPoint) accessed = dim $ scoreColour $ 3
+                                | otherwise = obscure $ scoreColour $ -3 ]
+                (posScore,negScore) <- MaybeT $ (snd<$>) <$> getRelScoreDetails sel
+                lift.lift $ sequence_
+                    [ do
+                        renderToMain $ renderStrColAt (scoreColour score) (sign:show (abs score)) pos
+                        registerSelectable pos 0 SelRelScoreComponent
+                    | (sign,score,pos) <-
+                        [ ('-',-negScore,posLeft+^neg hv+^hw)
+                        , ('+',posScore,posRight+^neg hv+^hw) ] ]
+
+        drawMainState' _ = return ()
+
+    drawMessage = say
+    drawPrompt full s = say $ s ++ (if full then "" else "_")
+    endPrompt = say ""
+    drawError = sayError
+
+    reportAlerts = playAlertSounds
+
+    getChRaw = resetMouseButtons >> getChRaw'
+        where
+            resetMouseButtons = modify $ \s -> s
+                { leftButtonDown = Nothing
+                , middleButtonDown = Nothing
+                , rightButtonDown = Nothing
+                }
+            getChRaw' = do
+                events <- liftIO getEvents
+                if not.null $ [ True | MouseButtonDown _ _ ButtonRight <- events ]
+                then return Nothing
+                else maybe getChRaw' (return.Just) $ listToMaybe $ [ ch
+                    | KeyDown (Keysym _ _ ch) <- events
+                    , ch /= '\0' ]
+
+    setUIBinding mode cmd ch =
+        modify $ \s -> s { uiKeyBindings =
+                Map.insertWith (\[bdg] -> \bdgs -> if bdg `elem` bdgs then delete bdg bdgs else bdg:bdgs)
+                    mode [(ch,cmd)] $ uiKeyBindings s }
+
+    getUIBinding mode cmd = ($cmd) <$> getBindingStr mode
+
+    initUI = liftM isJust (runMaybeT $ do
+        catchIOErrorMT $ SDL.init
+#ifdef SOUND
+            [InitVideo,InitAudio]
+#else
+            [InitVideo]
+#endif
+        catchIOErrorMT TTF.init
+        lift $ do
+            readUIConfigFile
+            initVideo 0 0
+            liftIO $ initMisc
+            w <- gets scrWidth
+            h <- gets scrHeight
+            liftIO $ warpMouse (fi $ w`div`2) (fi $ h`div`2)
+            renderToMain $ erase
+            initAudio
+            readBindings
+        )
+        where
+            catchIOErrorMT m = MaybeT $ liftIO $ catchIO (m >> return (Just ())) (\_ -> return Nothing)
+
+    endUI = do
+        writeUIConfigFile
+        writeBindings
+        liftIO $ quit
+
+    unblockInput = return $ pushEvent VideoExpose
+    suspend = return ()
+    redraw = return ()
+
+    impatience ticks = do
+        liftIO $ threadDelay 50000
+        if (ticks>20) then do
+                let pos = serverWaitPos
+                smallFont <- gets dispFontSmall
+                renderToMain $ do
+                    mapM (drawAtRel (FilledHexGlyph $ bright black)) [ pos +^ i*^hu | i <- [0..3] ]
+                    withFont smallFont $
+                        renderStrColAtLeft errorCol ("waiting..."++replicate ((ticks`div`5)`mod`3) '.') $ pos
+                clearButtons
+                registerButton (pos +^ neg hv) CmdQuit 0 [("abort",hu+^neg hw)]
+                drawButtons IMImpatience
+                refresh
+                cmds <- getInput IMImpatience
+                return $ CmdQuit `elem` cmds
+            else return False
+
+    warpPointer pos = do
+        (scrCentre, size) <- getGeom
+        centre <- gets dispCentre
+        let SVec x y = hexVec2SVec size (pos-^centre) +^ scrCentre
+        liftIO $ warpMouse (fi x) (fi y)
+        lbp <- gets leftButtonDown
+        rbp <- gets rightButtonDown
+        let [lbp',rbp'] = fmap (fmap (\_ -> (pos-^centre))) [lbp,rbp]
+        modify $ \s -> s {leftButtonDown = lbp', rightButtonDown = rbp'}
+
+    getUIMousePos = do
+        centre <- gets dispCentre
+        (Just.(+^centre).fst) <$> gets mousePos
+
+    setYNButtons = do
+        clearButtons
+        registerButton (periphery 5 +^ hw) (CmdInputChar 'Y') 2 []
+        registerButton (periphery 5 +^ neg hv) (CmdInputChar 'N') 0 []
+        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)
+        (cmds,uiChanged) <- if null events then return ([],False) else do
+            oldUIState <- get
+            cmds <- concat <$> mapM processEvent events
+            setPaintFromCmds cmds
+            newUIState <- get
+            return (cmds,uistatesMayVisiblyDiffer oldUIState newUIState)
+        now <- liftIO getTicks
+        animFrameReady <- maybe False (<now) <$> gets nextAnimFrameAt
+        return $ cmds ++ if uiChanged || animFrameReady then [CmdRefresh] else []
+        where
+            nubMouseMotions evs =
+                -- drop all but last mouse motion event
+                let nubMouseMotions' False (mm@(MouseMotion {}):evs) = mm:(nubMouseMotions' True evs)
+                    nubMouseMotions' True (mm@(MouseMotion {}):evs) = nubMouseMotions' True evs
+                    nubMouseMotions' b (ev:evs) = ev:(nubMouseMotions' b evs)
+                    nubMouseMotions' _ [] = []
+                in reverse $ nubMouseMotions' False $ reverse evs
+            setPaintFromCmds cmds = sequence_
+                [ modify $ \s -> s { paintTileIndex = pti }
+                    | (pti,pt) <- zip [0..] paintTiles
+                    , cmd <- cmds
+                    , (isNothing pt && cmd == CmdDelete) ||
+                        (isJust $ do
+                            pt' <- pt
+                            CmdTile t <- Just cmd
+                            guard $ ((==)`on`tileType) t pt') ]
+
+            uistatesMayVisiblyDiffer uis1 uis2 =
+                uis1 { mousePos = (zero,False), lastFrameTicks=0 }
+                /= uis2 {mousePos = (zero,False), lastFrameTicks=0 }
+            processEvent (KeyDown (Keysym _ _ ch)) = case mode of
+                IMTextInput -> return [CmdInputChar ch]
+                _ -> do
+                    setting <- gets settingBinding
+                    if isJust setting && ch /= '\0'
+                    then do
+                        modify $ \s -> s {settingBinding = Nothing}
+                        when (ch /= '\ESC') $ setUIBinding mode (fromJust setting) ch
+                        return []
+                    else do
+                        uibdgs <- Map.findWithDefault [] mode `liftM` gets uiKeyBindings
+                        let mCmd = lookup ch $ uibdgs ++ bindings mode
+                        return $ maybeToList mCmd
+            processEvent (MouseMotion {}) = do
+                (oldMPos,_) <- gets mousePos
+                (pos@(mPos,_),(sx,sy,sz)) <- getMousePos
+                updateMousePos mode pos
+                lbp <- gets leftButtonDown
+                rbp <- gets rightButtonDown
+                centre <- gets dispCentre
+                let drag :: Maybe HexVec -> Maybe Command
+                    drag bp = do
+                        fromPos@(HexVec x y z) <- bp
+                        -- check we've dragged at least a full hex's distance:
+                        guard $ not.all (\(a,b) -> abs ((fi a) - b) < 1.0) $ [(x,sx),(y,sy),(z,sz)]
+                        let dir = hexVec2HexDirOrZero $ mPos -^ fromPos
+                        guard $ dir /= zero
+                        return $ CmdDrag (fromPos+^centre) dir
+                case mode of
+                    IMEdit -> case drag rbp of
+                        Just cmd -> return [cmd]
+                        Nothing -> if mPos /= oldMPos
+                            then do
+                                pti <- getEffPaintTileIndex
+                                return $ [ CmdMoveTo $ mPos +^ centre ] ++
+                                    (if isJust lbp then [ CmdPaintFromTo (paintTiles!!pti) (oldMPos+^centre) (mPos+^centre) ] else [])
+                            else return []
+                    IMPlay -> return $ maybeToList $ msum $ map drag [lbp, rbp]
+                    _ -> return []
+                where
+                    mouseFromTo from to = do
+                        let dir = hexVec2HexDirOrZero $ to -^ from
+                        if dir /= zero
+                            then (CmdDir WHSSelected dir:) <$> mouseFromTo (from +^ dir) to
+                            else return []
+            processEvent (MouseButtonDown _ _ ButtonLeft) = do
+                pos@(mPos,central) <- gets mousePos
+                modify $ \s -> s { leftButtonDown = Just mPos }
+                rb <- isJust <$> gets rightButtonDown
+                mcmd <- cmdAtMousePos pos mode (Just False)
+                let hotspotAction = listToMaybe
+                        $ map (\cmd -> return [cmd]) (maybeToList mcmd)
+                        ++ [ (modify $ \s -> s {paintTileIndex = i}) >> return []
+                            | i <- take (length paintTiles) [0..]
+                            , mPos == paintButtonStart +^ i*^hv ]
+                        ++ [ toggleUIOption uiOB1 >> updateHoverStr mode >> return []
+                            | mPos == uiOptPos uiOB1 && mode `elem` uiOptModes uiOB1 ]
+                        ++ [ toggleUIOption uiOB2 >> updateHoverStr mode >> return []
+                            | mPos == uiOptPos uiOB2 && mode `elem` uiOptModes uiOB2 ]
+                        ++ [ toggleUIOption uiOB3 >> updateHoverStr mode >> return []
+                            | mPos == uiOptPos uiOB3 && mode `elem` uiOptModes uiOB3 ]
+                        ++ [ toggleUIOption uiOB4 >> updateHoverStr mode >> return []
+                            | mPos == uiOptPos uiOB4 && mode `elem` uiOptModes uiOB4 ]
+                        ++ [ toggleUIOption uiOB5 >> updateHoverStr mode >> return []
+                            | mPos == uiOptPos uiOB5 && mode `elem` uiOptModes uiOB5 ]
+#ifdef SOUND
+                        ++ [ toggleUIOption uiOB6 >> updateHoverStr mode >> return []
+                            | mPos == uiOptPos uiOB6 && mode `elem` uiOptModes uiOB6 ]
+#endif
+
+                if rb
+                then return [ CmdWait ]
+                else flip fromMaybe hotspotAction $ case mode of
+                    IMEdit -> do
+                        pti <- getEffPaintTileIndex
+                        return $ [ drawCmd (paintTiles!!pti) False ]
+                    IMPlay -> do
+                        centre <- gets dispCentre
+                        return $ [ CmdManipulateToolAt $ mPos +^ centre ]
+                    _ -> return []
+            processEvent (MouseButtonUp _ _ ButtonLeft) = do
+                modify $ \s -> s { leftButtonDown = Nothing }
+                return []
+            processEvent (MouseButtonDown _ _ ButtonRight) = do
+                pos@(mPos,_) <- gets mousePos
+                modify $ \s -> s { rightButtonDown = Just mPos }
+                lb <- isJust <$> gets leftButtonDown
+                if lb
+                then return [ CmdWait ]
+                else (fromMaybe [] <$>) $ runMaybeT $ msum
+                    [ do
+                        cmd <- MaybeT $ cmdAtMousePos pos mode Nothing
+                        guard $ mode /= IMTextInput
+                        -- modify $ \s -> s { settingBinding = Just cmd }
+                        return [ CmdBind $ Just cmd ]
+                    , do
+                        cmd <- MaybeT $ cmdAtMousePos pos mode (Just True)
+                        return [cmd]
+                    , case mode of
+                        IMPlay -> return [ CmdClear, CmdWait ]
+                        _ -> return [ CmdClear, CmdSelect ] ]
+            processEvent (MouseButtonUp _ _ ButtonRight) = do
+                modify $ \s -> s { rightButtonDown = Nothing }
+                return [ CmdUnselect ]
+            processEvent (MouseButtonDown _ _ ButtonWheelUp) = doWheel 1
+            processEvent (MouseButtonDown _ _ ButtonWheelDown) = doWheel $ -1
+            processEvent (MouseButtonDown _ _ ButtonMiddle) = do
+                (mPos,_) <- gets mousePos
+                modify $ \s -> s { middleButtonDown = Just mPos }
+                rb <- isJust <$> gets rightButtonDown
+                return $ if rb then [ CmdDelete ] else []
+            processEvent (MouseButtonUp _ _ ButtonMiddle) = do
+                modify $ \s -> s { middleButtonDown = Nothing }
+                return []
+            processEvent (VideoResize w h) = do
+                initVideo w h
+                return [ CmdRedraw ]
+            processEvent VideoExpose = return [ CmdRefresh ]
+            processEvent Quit = return [ CmdForceQuit ]
+
+            processEvent _ = return []
+
+            doWheel dw = do
+                rb <- isJust <$> gets rightButtonDown
+                mb <- isJust <$> gets middleButtonDown
+                if ((rb || mb || mode == IMReplay) && mode /= IMEdit)
+                    || (mb && mode == IMEdit)
+                then return [ if dw == 1 then CmdRedo else CmdUndo ]
+                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
+
+            getMousePos :: UIM ((HexVec,Bool),(Double,Double,Double))
+            getMousePos = do
+                (scrCentre, size) <- getGeom
+                (x,y,_) <- lift getMouseState
+                let sv = (SVec (fi x) (fi y)) +^ neg scrCentre
+                let mPos@(HexVec x y z) = sVec2HexVec size sv
+                let (sx,sy,sz) = sVec2dHV size sv
+                let isCentral = all (\(a,b) -> abs ((fi a) - b) < 0.5) $
+                        [(x,sx),(y,sy),(z,sz)]
+                return ((mPos,isCentral),(sx,sy,sz))
+            updateMousePos mode newPos = do
+                oldPos <- gets mousePos
+                when (newPos /= oldPos) $ do
+                    modify $ \ds -> ds { mousePos = newPos }
+                    updateHoverStr mode
+
+    showHelp mode HelpPageInput = do
+        bdgs <- nub <$> getBindings mode
+        smallFont <- gets dispFontSmall
+        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
+                extraHelpStrs = [["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."]]
+                    ++ case mode of
+                        IMMeta -> [[
+                            "Basic game instructions:"
+                            , "Choose [C]odename, then [R]egister it;"
+                            , "select other players, and [S]olve their locks;"
+                            , "go [H]ome, then [E]dit and [P]lace a lock of your own;"
+                            , "you can then [D]eclare your solutions."
+                            , "Make other players green by solving their locks and not letting them solve yours."]]
+                        _ -> []
+            renderStrColAt cyan "Keybindings:" $ (screenHeightHexes`div`4)*^(hv+^neg hw)
+            let keybindingsHeight = screenHeightHexes - (3 + length extraHelpStrs + sum (map length extraHelpStrs))
+            sequence_ [ with $ renderStrColAtLeft messageCol
+                        ( keysStr ++ ": " ++ desc )
+                        $ (x*bdgWidth-(screenWidthHexes-6)`div`2)*^hu +^ neg hv +^
+                          (screenHeightHexes`div`4 - y`div`2)*^(hv+^neg hw) +^
+                          (y`mod`2)*^hw
+                | ((keysStr,with,desc),(x,y)) <- zip [(keysStr,with,desc)
+                        | group <- groupBy ((==) `on` snd) $ sortBy (compare `on` snd) bdgs
+                        , let cmd = snd $ head group
+                        , let desc = describeCommand cmd
+                        , not $ null desc
+                        , let chs = map fst group
+                        , let keysStr = showKeys chs
+                        , let with = if True -- 3*(bdgWidth-1) < length desc + length keysStr + 1
+                                then withFont smallFont
+                                else id
+                        ]
+                    (map (`divMod` keybindingsHeight) [0..])
+                , (x+1)*bdgWidth < screenWidthHexes]
+            sequence_ [ renderStrColAt (if firstLine then cyan else messageCol) str
+                        $ (screenHeightHexes`div`4 - y`div`2)*^(hv+^neg hw)
+                          +^ hw
+                          +^ (y`mod`2)*^hw
+                | ((str,firstLine),y) <- (intercalate [("",False)] $ (map (`zip` (True:repeat False)) extraHelpStrs)) `zip` [(keybindingsHeight+1)..] ]
+        refresh
+        return True
+    showHelp IMMeta HelpPageGame = do
+        renderToMain $ drawBasicHelpPage ("INTRICACY",red) (metagameHelpText,purple)
+        return True
+    showHelp IMMeta (HelpPageInitiated n) = do
+        renderToMain $ drawBasicHelpPage ("Initiation complete",purple) (initiationHelpText n,red)
+        return True
+    showHelp IMEdit HelpPageFirstEdit = do
+        renderToMain $ drawBasicHelpPage ("Your first lock:",purple) (firstEditHelpText,green)
+        return True
+    showHelp _ _ = return False
+
+    onNewMode mode = modify (\ds -> ds{needHoverUpdate=True}) >> say ""
+
+    withNoBG m = do
+        bg <- gets bgSurface
+        modify $ \uiState -> uiState{bgSurface=Nothing}
+        m
+        isNothing <$> gets bgSurface >>?
+            modify (\uiState -> uiState{bgSurface=bg})
+
+
+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 _ = []
+
+-- waitEvent' : copy of SDL.Events.waitEvent, with the timeout increased
+-- drastically to reduce CPU load when idling.
+waitEvent' :: IO Event
+waitEvent' = loop
+    where loop = do pumpEvents
+                    event <- pollEvent
+                    case event of
+                      NoEvent -> threadDelay 10000 >> loop
+                      _ -> return event
+
+getEvents = do
+    e <- waitEvent'
+    es <- pollEvents
+    return $ e:es
+
+getEventsTimeout us = do
+    es <- maybeToList <$> timeout us waitEvent'
+    es' <- pollEvents
+    return $ es++es'
+
+updateHoverStr :: InputMode -> UIM ()
+updateHoverStr mode = do
+    p@(mPos,isCentral) <- gets mousePos
+    showBT <- showButtonText <$> gets uiOptions
+    hstr <- runMaybeT $ msum
+        [ MaybeT ( cmdAtMousePos p mode Nothing ) >>= lift . describeCommandAndKeys
+        , guard showBT >> MaybeT (helpAtMousePos p mode)
+        , guard (showBT && mode == IMEdit) >> msum
+            [ return $ "set paint mode: " ++ describeCommand (paintTileCmds!!i)
+            | i <- take (length paintTiles) [0..]
+            , mPos == paintButtonStart +^ i*^hv ]
+        , guard (mPos == uiOptPos uiOB1 && mode `elem` uiOptModes uiOB1) >> describeUIOptionButton uiOB1
+        , guard (mPos == uiOptPos uiOB2 && mode `elem` uiOptModes uiOB2) >> describeUIOptionButton uiOB2
+        , guard (mPos == uiOptPos uiOB3 && mode `elem` uiOptModes uiOB3) >> describeUIOptionButton uiOB3
+        , guard (mPos == uiOptPos uiOB4 && mode `elem` uiOptModes uiOB4) >> describeUIOptionButton uiOB4
+        , guard (mPos == uiOptPos uiOB5 && mode `elem` uiOptModes uiOB5) >> describeUIOptionButton uiOB5
+#ifdef SOUND
+        , guard (mPos == uiOptPos uiOB6 && mode `elem` uiOptModes uiOB6) >> describeUIOptionButton uiOB6
+#endif
+        ]
+    modify $ \ds -> ds { hoverStr = hstr }
+    where
+        describeCommandAndKeys :: Command -> UIM String
+        describeCommandAndKeys cmd = do
+            uibdgs <- Map.findWithDefault [] mode `liftM` gets uiKeyBindings
+            return $ describeCommand cmd ++ " ["
+                ++ concat (intersperse ","
+                    (map showKeyFriendly $ findBindings (uibdgs ++ bindings mode) cmd))
+                ++ "]"
+
+
+fillArea :: HexVec -> [HexVec] -> [HexVec -> MainStateT UIM ()] -> MainStateT UIM ()
+fillArea centre area draws = do
+    offset <- gets listOffset
+    let na = length area
+        listButton cmd = \pos -> lift $ registerButton pos cmd 3 []
+        draws' = if offset > 0 && length draws > na
+            then listButton CmdPrevPage :
+                drop (max 0 $ min (length draws - (na-1)) (na-1 + (na-2)*(offset-1))) draws
+            else draws
+        selDraws = if length draws' > na
+            then take (na-1) draws' ++ [listButton CmdNextPage]
+            else take na draws'
+    sequence_ $ map (uncurry ($)) $
+        zip selDraws $ sortBy (compare `on` hexVec2SVec 37) $
+            take (length selDraws) $ sortBy
+                (compare `on` (hexLen . (-^centre)))
+                area
+
+drawOldLock ls pos = void.runMaybeT $ msum [ do
+        lock <- mgetLock ls
+        lift.lift $ drawMiniLock lock pos
+    , 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
+        drawAtRel (playerGlyph col) pos
+        renderStrColAt buttonTextCol name pos
+drawRelScore name pos = do
+    col <- nameCol name
+    relScore <- getRelScore name
+    flip (maybe (return ())) relScore $ \score ->
+        lift $ do
+            renderToMain $ renderStrColAt col
+                ((if score > 0 then "+" else "") ++ show score) pos
+            registerSelectable pos 0 SelRelScore
+
+drawNote note pos = case noteBehind note of
+    Just al -> drawActiveLock al pos
+    Nothing -> drawPublicNote (noteAuthor note) pos
+drawActiveLock al@(ActiveLock name i) pos = do
+    accessed <- accessedAL al
+    drawNameWithChar name
+        (if accessed then accColour else white)
+        (lockIndexChar i) pos
+drawPublicNote name =
+    drawNameWithChar name pubColour 'P'
+drawNameWithChar name charcol char pos = do
+    col <- nameCol name
+    drawNameWithCharAndCol name charcol char col pos
+drawNameWithCharAndCol :: String -> Pixel -> Char -> Pixel -> HexVec -> MainStateT UIM ()
+drawNameWithCharAndCol name charcol char col pos = do
+    size <- fi.snd <$> lift getGeom
+    let up = FVec 0 $ 1/2 - ylen
+    let down = FVec 0 $ ylen
+    smallFont <- lift $ gets dispFontSmall
+    lift.renderToMain $ do
+        drawAtRel (playerGlyph col) pos
+        displaceRender up $
+            renderStrColAt buttonTextCol name pos
+        displaceRender down $ withFont smallFont $
+            renderStrColAt charcol [char] pos
+pubWheelAngle = 5
+pubColour = colourWheel pubWheelAngle -- ==purple
+accColour = cyan
+nameCol name = do
+    ourName <- (authUser <$>) <$> gets curAuth
+    relScore <- getRelScore name
+    return $ dim $ case relScore of
+            Nothing -> Pixel $ if ourName == Just name then 0xc0c0c000 else 0x80808000
+            Just score -> scoreColour score
+scoreColour :: Int -> Pixel
+scoreColour score = Pixel $ case score of
+        0 -> 0x80800000
+        1 -> 0x70a00000
+        2 -> 0x40c00000
+        3 -> 0x00ff0000
+        (-1) -> 0xa0700000
+        (-2) -> 0xc0400000
+        (-3) -> 0xff000000
+
+drawLockInfo :: ActiveLock -> Maybe LockInfo -> MainStateT UIM ()
+drawLockInfo al@(ActiveLock name idx) Nothing = do
+    let centre = hw+^neg hv +^ 7*(idx-1)*^hu
+    lift $ drawEmptyMiniLock centre
+    drawNameWithCharAndCol name white (lockIndexChar idx) (invisible white) centre
+    ourName <- (authUser <$>) <$> gets curAuth
+    lift $ registerSelectable centre 3 $ SelLockUnset (ourName == Just name) al
+drawLockInfo al@(ActiveLock name idx) (Just lockinfo) = do
+    let centre = locksPos +^ 7*(idx-1)*^hu
+    let accessedByPos = centre +^ 3*^(hv +^ neg hw)
+    let accessedPos = centre +^ 2*^(hw +^ neg hv)
+    let notesPos = centre +^ 3*^(hw +^ neg hv)
+    ourName <- (authUser <$>) <$> gets curAuth
+    runMaybeT $ msum [
+        do
+            lock <- mgetLock $ lockSpec lockinfo
+            lift.lift $ do
+                drawMiniLock lock centre
+                registerSelectable centre 3 $ SelLock al
+        , lift $ do
+                drawActiveLock al centre
+                lift $ registerSelectable centre 3 $ SelLock al
+        ]
+
+    size <- snd <$> lift getGeom
+    lift $ do
+        renderToMain $ displaceRender (FVec 1 0) $ renderStrColAt (brightish white) "UNLOCKED BY" $ accessedByPos +^ hv
+        registerSelectable (accessedByPos +^ hv) 0 SelPrivyHeader
+        registerSelectable (accessedByPos +^ hv +^ hu) 0 SelPrivyHeader
+    if public lockinfo
+    then lift $ do
+        renderToMain $ renderStrColAt pubColour "All" accessedByPos
+        registerSelectable accessedByPos 1 SelPublicLock
+    else if null $ accessedBy lockinfo
+        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
+                    , let d = j*^hw +^ i*^hu ]
+                $ [ \pos -> (lift $ registerSelectable pos 0 (SelSolution note)) >> drawNote note pos
+                    | 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
+                then Just (pubColour,"Accessed!",AccessedPublic)
+                else Just (accColour, "Solved!",AccessedSolved)
+            else if any (\(Undeclared _ ls _) -> ls == lockSpec lockinfo) undecls
+                then Just (yellow, "Undeclared",AccessedUndeclared)
+                else Nothing
+        of
+        Just (col,str,selstr) -> lift $ do
+            renderToMain $ renderStrColAt col str accessedPos
+            registerSelectable accessedPos 1 (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 (SelAccessedInfo AccessedReadNotes)
+                fillArea (accessedPos+^neg hu) [ accessedPos +^ i*^hu | i <- [-1..1] ]
+                    $ take 3 $ [ \pos -> (lift $ registerSelectable pos 0 (SelReadNote note)) >> drawNote note pos
+                        | note <- read ] ++ (repeat $ \pos -> (lift $ registerSelectable pos 0 SelReadNoteSlot >>
+                                renderToMain (drawAtRel (HollowGlyph $ dim green) pos)))
+
+    lift $ do
+        renderToMain $ displaceRender (FVec 1 0) $ renderStrColAt (brightish white) "SECURING" $ notesPos +^ hv
+        registerSelectable (notesPos +^ hv) 0 SelNotesHeader
+        registerSelectable (notesPos +^ hv +^ hu) 0 SelNotesHeader
+    if null $ notesSecured lockinfo
+        then lift.renderToMain $ renderStrColAt dimWhiteCol "None" notesPos
+        else fillArea notesPos
+                [ notesPos +^ d | j <- [0..2], i <- [-2..3]
+                    , i-j > -4, i-j < 3
+                    , let d = j*^hw +^ i*^hu ]
+                [ \pos -> (lift $ registerSelectable pos 0 (SelSecured note)) >> drawActiveLock (noteOn note) pos
+                    | note <- notesSecured lockinfo ]
 
 drawBasicHelpPage :: (String,Pixel) -> ([String],Pixel) -> RenderM ()
 drawBasicHelpPage (title,titleCol) (body,bodyCol) = do
diff --git a/Server.hs b/Server.hs
--- a/Server.hs
+++ b/Server.hs
@@ -47,7 +47,7 @@
 import Text.Feed.Import (parseFeedFromFile)
 import Text.Feed.Export (xmlFeed)
 import Text.Feed.Constructor
-import Text.XML.Light.Output (showTopElement)
+import qualified Text.XML as XML
 import Data.Time.Format
 import Data.Time.LocalTime
 
@@ -95,8 +95,8 @@
 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))
+        (o,n,[]) -> return (o,n)
+        (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
     where header = "Usage: intricacy-server [OPTION...]"
 
 main = do
@@ -110,15 +110,15 @@
     when (Help `elem` opts) $ putStr usage >> exitSuccess
     when (Version `elem` opts) $ putStrLn version >> exitSuccess
     let delay = fromMaybe 0 $ listToMaybe [ d | RequestDelay d <- opts ]
-	port = fromMaybe defaultPort $ listToMaybe [ p | Port p <- opts ]
-	dbpath = fromMaybe "intricacydb" $ listToMaybe [ p | DBDir p <- opts ]
-	mfeedPath = listToMaybe [ p | FeedPath p <- opts ]
-	locksize = min maxlocksize $ fromMaybe 8 $ listToMaybe [ s | ServerLockSize s <- opts ]
+        port = fromMaybe defaultPort $ listToMaybe [ p | Port p <- opts ]
+        dbpath = fromMaybe "intricacydb" $ listToMaybe [ p | DBDir p <- opts ]
+        mfeedPath = listToMaybe [ p | FeedPath p <- opts ]
+        locksize = min maxlocksize $ fromMaybe 8 $ listToMaybe [ s | ServerLockSize s <- opts ]
     withDB dbpath $ setDefaultServerInfo locksize >> setKeyPair
     writeFile (lockFilePath dbpath) ""
     logh <- case listToMaybe [ f | LogFile f <- opts ] of
-	Nothing -> return stdout
-	Just path -> openFile path AppendMode
+        Nothing -> return stdout
+        Just path -> openFile path AppendMode
     streamServer serverSpec{address = IPv4 "" port, threading=Threaded} $ handler dbpath delay logh mfeedPath
     sleepForever
 
@@ -147,8 +147,8 @@
     liftIO $ hClose h
     return ret
     where
-	getDBLock lockMode =
-	    catchIO (openFile (lockFilePath dbpath) lockMode) (\_ -> threadDelay (50*10^3) >> getDBLock lockMode)
+        getDBLock lockMode =
+            catchIO (openFile (lockFilePath dbpath) lockMode) (\_ -> threadDelay (50*10^3) >> getDBLock lockMode)
 
 lockFilePath dbpath = dbpath ++ [pathSeparator] ++ "lockfile"
 
@@ -158,22 +158,22 @@
 handler dbpath delay logh mfeedPath 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 <$> BL.hGetContents hdl
-		let hostname = case addr of
-			IP n _ -> n
-			IPv4 n _ -> n
-			IPv6 n _ -> n
-			Unix path -> path
-		    hashedHostname = take 8 $ hash hostname
-		now <- liftIO getCurrentTime
-		logit logh $ show now ++ ": " ++ hashedHostname ++ " >>> " ++ showRequest request
-		response <- handleRequest dbpath mfeedPath request
-		when (delay > 0) $ threadDelay delay
-		now' <- liftIO getCurrentTime
-		logit logh $ show now' ++ ": " ++ hashedHostname ++ " <<< " ++ showResponse response
-		return response
-	    BL.hPut hdl $ B.encode response
+            response <- handle (\e -> return $ ServerError $ show (e::SomeException)) $ do
+                request <- B.decode <$> BL.hGetContents hdl
+                let hostname = case addr of
+                        IP n _ -> n
+                        IPv4 n _ -> n
+                        IPv6 n _ -> n
+                        Unix path -> path
+                    hashedHostname = take 8 $ hash hostname
+                now <- liftIO getCurrentTime
+                logit logh $ show now ++ ": " ++ hashedHostname ++ " >>> " ++ showRequest request
+                response <- handleRequest dbpath mfeedPath request
+                when (delay > 0) $ threadDelay delay
+                now' <- liftIO getCurrentTime
+                logit logh $ show now' ++ ": " ++ hashedHostname ++ " <<< " ++ showResponse response
+                return response
+            BL.hPut hdl $ B.encode response
 
 showRequest :: ClientRequest -> String
 showRequest (ClientRequest ver mauth act) = show ver ++ " "
@@ -194,194 +194,194 @@
 handleRequest :: FilePath -> Maybe FilePath -> ClientRequest -> IO ServerResponse
 handleRequest dbpath mfeedPath req@(ClientRequest pv auth action) = do
     let lockMode = case action of
-	    Authenticate -> ReadMode
-	    GetServerInfo -> ReadMode
-	    GetPublicKey -> ReadMode
-	    GetLock _ -> ReadMode
-	    GetUserInfo _ _ -> ReadMode
-	    GetRetired _ -> ReadMode
-	    GetSolution _ -> ReadMode
-	    GetRandomNames _ -> ReadMode
-	    _ -> ReadWriteMode
+            Authenticate -> ReadMode
+            GetServerInfo -> ReadMode
+            GetPublicKey -> ReadMode
+            GetLock _ -> ReadMode
+            GetUserInfo _ _ -> ReadMode
+            GetRetired _ -> ReadMode
+            GetSolution _ -> ReadMode
+            GetRandomNames _ -> ReadMode
+            _ -> ReadWriteMode
 
     -- check solutions prior to write-locking database:
     (withDBLock dbpath ReadMode $ runExceptT checkRequest) >>= 
-	either (return . ServerError) (const $
-	withDBLock dbpath lockMode $ runExceptT handleRequest' >>= 
-	    either (return . ServerError) return)
+        either (return . ServerError) (const $
+        withDBLock dbpath lockMode $ runExceptT handleRequest' >>= 
+            either (return . ServerError) return)
     where
-	checkRequest = do
-	    when (pv /= protocolVersion) $ throwE "Bad protocol version"
-	    case action of
-		DeclareSolution soln ls target idx -> do
-		    info <- getUserInfoOfAuth auth
-		    lock <- getLock ls
-		    tinfo <- getALock target
-		    when (ls /= lockSpec tinfo) $ throwE "Lock no longer in use!"
-		    when (public tinfo) $ throwE "Lock solution already public knowledge!"
-		    let name = codename info
-		    let behind = ActiveLock name idx
-		    when (name `elem` map noteAuthor (lockSolutions tinfo)) $
-			throwE "Note already taken on that lock!"
-		    when (name == lockOwner target) $
-			throwE "That's your lock!"
-		    behindLock <- getALock behind
-		    when (public behindLock) $ throwE "Your lock is cracked!"
-		    unless (checkSolution lock soln) $ throwE "Bad solution"
-		SetLock lock@(frame,_) idx soln -> do
-		    ServerInfo serverSize _ <- getServerInfo
-		    when (frame /= BasicFrame serverSize) $ throwE $
-			"Server only accepts size "++show serverSize++" locks."
-		    unless (validLock $ reframe lock) $ throwE "Invalid lock!"
-		    unless (not.checkSolved $ reframe lock) $ throwE "Lock not locked!"
-		    RCLockHashes hashes <- getRecordErrored RecLockHashes
-			    `catchE` const (return (RCLockHashes []))
-		    let hashed = hash $ show lock
-		    when (hashed `elem` hashes) $ throwE "Lock has already been used"
-		    unless (checkSolution lock soln) $ throwE "Bad solution"
-		_ -> return ()
-	handleRequest' =
-	    case action of
+        checkRequest = do
+            when (pv /= protocolVersion) $ throwE "Bad protocol version"
+            case action of
+                DeclareSolution soln ls target idx -> do
+                    info <- getUserInfoOfAuth auth
+                    lock <- getLock ls
+                    tinfo <- getALock target
+                    when (ls /= lockSpec tinfo) $ throwE "Lock no longer in use!"
+                    when (public tinfo) $ throwE "Lock solution already public knowledge!"
+                    let name = codename info
+                    let behind = ActiveLock name idx
+                    when (name `elem` map noteAuthor (lockSolutions tinfo)) $
+                        throwE "Note already taken on that lock!"
+                    when (name == lockOwner target) $
+                        throwE "That's your lock!"
+                    behindLock <- getALock behind
+                    when (public behindLock) $ throwE "Your lock is cracked!"
+                    unless (checkSolution lock soln) $ throwE "Bad solution"
+                SetLock lock@(frame,_) idx soln -> do
+                    ServerInfo serverSize _ <- getServerInfo
+                    when (frame /= BasicFrame serverSize) $ throwE $
+                        "Server only accepts size "++show serverSize++" locks."
+                    unless (validLock $ reframe lock) $ throwE "Invalid lock!"
+                    unless (not.checkSolved $ reframe lock) $ throwE "Lock not locked!"
+                    RCLockHashes hashes <- getRecordErrored RecLockHashes
+                            `catchE` const (return (RCLockHashes []))
+                    let hashed = hash $ show lock
+                    when (hashed `elem` hashes) $ throwE "Lock has already been used"
+                    unless (checkSolution lock soln) $ throwE "Bad solution"
+                _ -> return ()
+        handleRequest' =
+            case action of
                 UndefinedAction -> throwE "Request not recognised by this server"
-		Authenticate -> do
-		    checkAuth auth
-		    return $ ServerMessage $ "Welcome, " ++ authUser (fromJust auth)
-		Register -> do
-		    newUser auth
-		    doNews $ "New user " ++ authUser (fromJust auth) ++ " registered."
-		    return ServerAck
-		ResetPassword passwd -> resetPassword auth passwd >> return ServerAck
-		SetEmail address -> setEmail auth address >> return ServerAck
-		GetServerInfo -> ServedServerInfo <$> getServerInfo
-		GetPublicKey -> ServedPublicKey <$> getPublicKey
-		GetLock ls -> ServedLock <$> getLock ls
-		GetRetired name -> ServedRetired <$> getRetired name
-		GetUserInfo name mversion -> (do
-			RCUserInfo (curV,info) <- getRecordErrored $ RecUserInfo name
-			(fromJust<$>)$ runMaybeT $ msum [ do
-			    v <- MaybeT $ return mversion
-			    msum [ guard (v >= curV) >> return ServerFresh
-				, do
-				    guard (v >= curV - 10)
-				    RCUserInfoDeltas deltas <- lift $ getRecordErrored $ RecUserInfoLog name
-				    return $ ServedUserInfoDeltas $ take (curV-v) deltas
-				]
-			    , return $ ServedUserInfo (curV,info)
-			    ]
-		    ) `catchE` \_ -> return ServerCodenameFree
-		GetSolution note -> do
-		    uinfo <- getUserInfoOfAuth auth
-		    let uname = codename uinfo
-		    onLinfo <- getALock $ noteOn note
-		    behindMLinfo <- maybe (return Nothing) ((Just<$>).getALock) $ noteBehind note
-		    if uname == lockOwner (noteOn note)
-			|| uname == noteAuthor note
-		    then ServedSolution <$> getSolution note
-		    else if case behindMLinfo of
-				Nothing -> True
-				Just behindInfo -> public behindInfo || uname `elem` accessedBy behindInfo
-			    || note `elem` notesRead uinfo
-			then if public onLinfo || uname `elem` accessedBy onLinfo
-			    then ServedSolution <$> getSolution note
-			    else throwE "You can't wholly decipher this note - you would need more notes on the same lock."
-			else throwE "This note is secured behind a lock you have not opened."
-		DeclareSolution soln ls target idx -> do
-		    info <- getUserInfoOfAuth auth
-		    let name = codename info
-		    let behind = ActiveLock name idx
-		    let note = NoteInfo name (Just behind) target
-		    erroredDB $ putRecord (RecNote note) (RCSolution soln)
-		    execStateT (declareNote note behind) [] >>= applyDeltasToRecords
-		    doNews $ name ++ " declares solution to "
-			++ alockStr target ++ ", securing their note behind "
-			++ alockStr behind ++ "."
-		    mailDeclaration target behind
-		    return ServerAck
-		SetLock lock@(frame,_) idx soln -> do
-		    info <- getUserInfoOfAuth auth
-		    let name = codename info
-		    let al = ActiveLock name idx
-		    RCLockHashes hashes <- getRecordErrored RecLockHashes
-			    `catchE` const (return (RCLockHashes []))
-		    let hashed = hash $ show lock
-		    erroredDB $ putRecord RecLockHashes $ RCLockHashes $ hashed:hashes
+                Authenticate -> do
+                    checkAuth auth
+                    return $ ServerMessage $ "Welcome, " ++ authUser (fromJust auth)
+                Register -> do
+                    newUser auth
+                    doNews $ "New user " ++ authUser (fromJust auth) ++ " registered."
+                    return ServerAck
+                ResetPassword passwd -> resetPassword auth passwd >> return ServerAck
+                SetEmail address -> setEmail auth address >> return ServerAck
+                GetServerInfo -> ServedServerInfo <$> getServerInfo
+                GetPublicKey -> ServedPublicKey <$> getPublicKey
+                GetLock ls -> ServedLock <$> getLock ls
+                GetRetired name -> ServedRetired <$> getRetired name
+                GetUserInfo name mversion -> (do
+                        RCUserInfo (curV,info) <- getRecordErrored $ RecUserInfo name
+                        (fromJust<$>)$ runMaybeT $ msum [ do
+                            v <- MaybeT $ return mversion
+                            msum [ guard (v >= curV) >> return ServerFresh
+                                , do
+                                    guard (v >= curV - 10)
+                                    RCUserInfoDeltas deltas <- lift $ getRecordErrored $ RecUserInfoLog name
+                                    return $ ServedUserInfoDeltas $ take (curV-v) deltas
+                                ]
+                            , return $ ServedUserInfo (curV,info)
+                            ]
+                    ) `catchE` \_ -> return ServerCodenameFree
+                GetSolution note -> do
+                    uinfo <- getUserInfoOfAuth auth
+                    let uname = codename uinfo
+                    onLinfo <- getALock $ noteOn note
+                    behindMLinfo <- maybe (return Nothing) ((Just<$>).getALock) $ noteBehind note
+                    if uname == lockOwner (noteOn note)
+                        || uname == noteAuthor note
+                    then ServedSolution <$> getSolution note
+                    else if case behindMLinfo of
+                                Nothing -> True
+                                Just behindInfo -> public behindInfo || uname `elem` accessedBy behindInfo
+                            || note `elem` notesRead uinfo
+                        then if public onLinfo || uname `elem` accessedBy onLinfo
+                            then ServedSolution <$> getSolution note
+                            else throwE "You can't wholly decipher this note - you would need more notes on the same lock."
+                        else throwE "This note is secured behind a lock you have not opened."
+                DeclareSolution soln ls target idx -> do
+                    info <- getUserInfoOfAuth auth
+                    let name = codename info
+                    let behind = ActiveLock name idx
+                    let note = NoteInfo name (Just behind) target
+                    erroredDB $ putRecord (RecNote note) (RCSolution soln)
+                    execStateT (declareNote note behind) [] >>= applyDeltasToRecords
+                    doNews $ name ++ " declares solution to "
+                        ++ alockStr target ++ ", securing their note behind "
+                        ++ alockStr behind ++ "."
+                    mailDeclaration target behind
+                    return ServerAck
+                SetLock lock@(frame,_) idx soln -> do
+                    info <- getUserInfoOfAuth auth
+                    let name = codename info
+                    let al = ActiveLock name idx
+                    RCLockHashes hashes <- getRecordErrored RecLockHashes
+                            `catchE` const (return (RCLockHashes []))
+                    let hashed = hash $ show lock
+                    erroredDB $ putRecord RecLockHashes $ RCLockHashes $ hashed:hashes
 
-		    ls <- erroredDB $ newLockRecord lock
-		    let oldLockInfo = userLocks info ! idx
-		    execStateT (do
-			    when (isJust $ oldLockInfo) $
-				lift (getALock al) >>= retireLock
-			    addDelta name $ PutLock ls idx
-			) [] >>= applyDeltasToRecords
+                    ls <- erroredDB $ newLockRecord lock
+                    let oldLockInfo = userLocks info ! idx
+                    execStateT (do
+                            when (isJust $ oldLockInfo) $
+                                lift (getALock al) >>= retireLock
+                            addDelta name $ PutLock ls idx
+                        ) [] >>= applyDeltasToRecords
 
-		    for_ oldLockInfo $ \oldui -> do
-			lss <- getRetired name
-			erroredDB $ putRecord (RecRetiredLocks name) $ RCLockSpecs $ (lockSpec oldui):lss
-		    doNews $ "New lock " ++ alockStr al ++ "."
-		    return ServerAck
-		GetRandomNames n -> do
-		    names <- erroredDB $ listUsers
-		    gen <- erroredIO $ getStdGen
-		    let l = length names
-			namesArray = listArray (0,l-1) names
-			negligible name = do
-			    uinfo <- getUserInfo name
-			    return $ all (maybe True public . (userLocks uinfo !)) [0..2]
+                    for_ oldLockInfo $ \oldui -> do
+                        lss <- getRetired name
+                        erroredDB $ putRecord (RecRetiredLocks name) $ RCLockSpecs $ (lockSpec oldui):lss
+                    doNews $ "New lock " ++ alockStr al ++ "."
+                    return ServerAck
+                GetRandomNames n -> do
+                    names <- erroredDB $ listUsers
+                    gen <- erroredIO $ getStdGen
+                    let l = length names
+                        namesArray = listArray (0,l-1) names
+                        negligible name = do
+                            uinfo <- getUserInfo name
+                            return $ all (maybe True public . (userLocks uinfo !)) [0..2]
 
-		    -- huzzah for pipes!
-		    shuffled <- P.toListM $
-			    mapM_ Pipes.yield (nub $ randomRs (0,l-1) gen)
-			>-> P.take l -- give up once we've permuted all of [0..l-1]
-			>-> P.map (namesArray !)
-			>-> P.filterM ((not <$>) . negligible) -- throw away negligibles
-			>-> P.take n -- try to take as many as we were asked for
-		    liftIO newStdGen
-		    return $ ServedRandomNames shuffled
-		_ -> throwE "BUG: bad request"
-	erroredIO :: IO a -> ExceptT String IO a
-	erroredIO c = do
-	    ret <- liftIO $ catchIO (Right <$> c) (return.Left)
-	    case ret of
-		Left e -> throwE $ "Server IO error: " ++ show e
-		Right x -> return x
-	erroredDB :: DBM a -> ExceptT String IO a
-	erroredDB = erroredIO . withDB dbpath
-	getRecordErrored :: Record -> ExceptT String IO RecordContents
-	getRecordErrored rec = do
-	    mrc <- lift $ withDB dbpath $ getRecord rec
-	    case mrc of
-		Just rc -> return rc
-		Nothing -> throwE $ "Bad record on server! Record was: " ++ show rec
-	getLock ls = do
-	    RCLock lock <- getRecordErrored $ RecLock ls
-	    return lock
-	getSolution note = do
-	    RCSolution soln <- getRecordErrored $ RecNote note
-	    return soln
-	getServerInfo = do
-	    RCServerInfo sinfo <- getRecordErrored $ RecServerInfo
-	    return sinfo
-	getPublicKey = do
-	    RCPublicKey publicKey <- getRecordErrored $ RecPublicKey
-	    return publicKey
-	getRetired name = do
-	    RCLockSpecs lss <- fromMaybe (RCLockSpecs []) <$> (erroredDB $ getRecord $ RecRetiredLocks name)
-	    return lss
-	getALock (ActiveLock name idx) = do
-	    info <- getUserInfo name
-	    checkValidLockIndex idx
-	    case ((!idx).userLocks) info of
-		Nothing -> throwE "Lock not set"
-		Just lockinfo -> return lockinfo
-	checkValidLockIndex idx =
-	    unless (0<=idx && idx < maxLocks) $ throwE "Bad lock index"
-	getUserInfo name = do
-	    RCUserInfo (version,info) <- getRecordErrored $ RecUserInfo name
-	    return info
-	getUserInfoOfAuth auth = do
-	    checkAuth auth
-	    let Just (Auth name _) = auth
-	    getUserInfo name
+                    -- huzzah for pipes!
+                    shuffled <- P.toListM $
+                            mapM_ Pipes.yield (nub $ randomRs (0,l-1) gen)
+                        >-> P.take l -- give up once we've permuted all of [0..l-1]
+                        >-> P.map (namesArray !)
+                        >-> P.filterM ((not <$>) . negligible) -- throw away negligibles
+                        >-> P.take n -- try to take as many as we were asked for
+                    liftIO newStdGen
+                    return $ ServedRandomNames shuffled
+                _ -> throwE "BUG: bad request"
+        erroredIO :: IO a -> ExceptT String IO a
+        erroredIO c = do
+            ret <- liftIO $ catchIO (Right <$> c) (return.Left)
+            case ret of
+                Left e -> throwE $ "Server IO error: " ++ show e
+                Right x -> return x
+        erroredDB :: DBM a -> ExceptT String IO a
+        erroredDB = erroredIO . withDB dbpath
+        getRecordErrored :: Record -> ExceptT String IO RecordContents
+        getRecordErrored rec = do
+            mrc <- lift $ withDB dbpath $ getRecord rec
+            case mrc of
+                Just rc -> return rc
+                Nothing -> throwE $ "Bad record on server! Record was: " ++ show rec
+        getLock ls = do
+            RCLock lock <- getRecordErrored $ RecLock ls
+            return lock
+        getSolution note = do
+            RCSolution soln <- getRecordErrored $ RecNote note
+            return soln
+        getServerInfo = do
+            RCServerInfo sinfo <- getRecordErrored $ RecServerInfo
+            return sinfo
+        getPublicKey = do
+            RCPublicKey publicKey <- getRecordErrored $ RecPublicKey
+            return publicKey
+        getRetired name = do
+            RCLockSpecs lss <- fromMaybe (RCLockSpecs []) <$> (erroredDB $ getRecord $ RecRetiredLocks name)
+            return lss
+        getALock (ActiveLock name idx) = do
+            info <- getUserInfo name
+            checkValidLockIndex idx
+            case ((!idx).userLocks) info of
+                Nothing -> throwE "Lock not set"
+                Just lockinfo -> return lockinfo
+        checkValidLockIndex idx =
+            unless (0<=idx && idx < maxLocks) $ throwE "Bad lock index"
+        getUserInfo name = do
+            RCUserInfo (version,info) <- getRecordErrored $ RecUserInfo name
+            return info
+        getUserInfoOfAuth auth = do
+            checkAuth auth
+            let Just (Auth name _) = auth
+            getUserInfo name
 
         decryptPassword :: String -> ExceptT String IO String
         decryptPassword pw = do
@@ -390,135 +390,139 @@
                 decrypt secretKey . BL.fromStrict . CS.pack $ pw)
                 -- <=intricacy-0.6.2 sends the hashed password unencrypted
                 `catch` \(e :: RSAError) -> return pw
-	checkAuth :: Maybe Auth -> ExceptT String IO ()
-	checkAuth Nothing = throwE "Authentication required"
-	checkAuth (Just (Auth name pw)) = do
-	    exists <- checkCodeName name
-	    unless exists $ throwE "No such user"
-	    RCPassword correctPw <- getRecordErrored (RecPassword name)
+        checkAuth :: Maybe Auth -> ExceptT String IO ()
+        checkAuth Nothing = throwE "Authentication required"
+        checkAuth (Just (Auth name pw)) = do
+            exists <- checkCodeName name
+            unless exists $ throwE "No such user"
+            RCPassword correctPw <- getRecordErrored (RecPassword name)
             pw' <- decryptPassword pw
             when (pw' /= correctPw) $ throwE "Wrong password"
-	newUser :: Maybe Auth -> ExceptT String IO ()
-	newUser Nothing = throwE "Require authentication"
-	newUser (Just (Auth name pw)) = do
-	    exists <- checkCodeName name
-	    when exists $ throwE "Codename taken"
+        newUser :: Maybe Auth -> ExceptT String IO ()
+        newUser Nothing = throwE "Require authentication"
+        newUser (Just (Auth name pw)) = do
+            exists <- checkCodeName name
+            when exists $ throwE "Codename taken"
             pw' <- decryptPassword pw
-	    erroredDB $ putRecord (RecPassword name) (RCPassword pw')
-	    erroredDB $ putRecord (RecUserInfo name) (RCUserInfo $ (1,initUserInfo name))
-	    erroredDB $ putRecord (RecUserInfoLog name) (RCUserInfoDeltas [])
-	resetPassword Nothing _ = throwE "Authentication required"
-	resetPassword auth@(Just (Auth name _)) newpw = do
-	    checkAuth auth
+            erroredDB $ putRecord (RecPassword name) (RCPassword pw')
+            erroredDB $ putRecord (RecUserInfo name) (RCUserInfo $ (1,initUserInfo name))
+            erroredDB $ putRecord (RecUserInfoLog name) (RCUserInfoDeltas [])
+        resetPassword Nothing _ = throwE "Authentication required"
+        resetPassword auth@(Just (Auth name _)) newpw = do
+            checkAuth auth
             newpw' <- decryptPassword newpw
-	    erroredDB $ putRecord (RecPassword name) (RCPassword newpw')
-	setEmail Nothing _ = throwE "Authentication required"
-	setEmail auth@(Just (Auth name _)) addressStr = do
-	    checkAuth auth
-	    serverAddr <- erroredDB $ getRecord RecServerEmail
-	    when (isNothing serverAddr) $ throwE "This server is not configured to support email notifications."
-	    let addr = CS.pack addressStr
-	    when (not $ CS.null addr || Text.Email.Validate.isValid addr) $ throwE "Invalid email address"
-	    erroredDB $ putRecord (RecEmail name) (RCEmail addr)
-	checkCodeName :: Codename -> ExceptT String IO Bool
-	checkCodeName name = do
-	    unless (validCodeName name) $ throwE "Invalid codename"
-	    liftIO $ withDB dbpath $ recordExists $ RecPassword name
-	--- | TODO: journalling so we can survive death during database writes?
-	applyDeltasToRecords :: [(Codename, UserInfoDelta)] -> ExceptT String IO ()
-	applyDeltasToRecords nds = sequence_ $ [applyDeltasToRecord name deltas
-		| group <- groupBy ((==) `on` fst) nds
-		, let name = fst $ head group
-		, let deltas = map snd group ]
-	applyDeltasToRecord name deltas = do
-	    erroredDB $ modifyRecord (RecUserInfoLog name) $
-		\(RCUserInfoDeltas deltas') -> RCUserInfoDeltas $ deltas ++ deltas'
-	    erroredDB $ modifyRecord (RecUserInfo name) $
-		\(RCUserInfo (v,info)) -> RCUserInfo $
-		    (v+length deltas, applyDeltas info deltas)
-	declareNote note@(NoteInfo _ _ target) behind@(ActiveLock name idx) = do
-	    accessLock name target =<< getCurrALock target
-	    addDelta (lockOwner target) $ LockDelta (lockIndex target) $ AddSolution note
-	    addDelta name $ LockDelta idx $ AddSecured note
-	    accessed <- accessedBy <$> getCurrALock behind
-	    mapM_ (addReadNote note) (name:accessed)
-	addReadNote note@(NoteInfo _ _ target) name = do
-	    info <- getCurrUserInfo name
-	    tlock <- getCurrALock target
-	    unless (note `elem` notesRead info) $ do
-		addDelta name $ AddRead note
-		checkSuffReadNotes target name
-	accessLock name target@(ActiveLock tname ti) tlock = do
-	    addDelta tname $ LockDelta ti $ AddAccessed name
-	    mapM_ (`addReadNote` name) $ notesSecured tlock
-	publiciseLock al@(ActiveLock name idx) lock = do
-	    addDelta name $ LockDelta idx SetPublic
-	    retireLock lock
-	retireLock lock = do
-	    mapM_ scrapNote $ lockSolutions lock
-	    mapM_ publiciseNote $ notesSecured lock
-	scrapNote note@(NoteInfo _ (Just al@(ActiveLock name idx)) _) = do
-	    addDelta name $ LockDelta idx (DelSecured note)
-	    unreadNote note
-	scrapNote _ = return ()
-	unreadNote note@(NoteInfo name (Just al) _) = do
-	    lock <- getCurrALock al
-	    mapM_ (\name' -> addDelta name' (DelRead note)) $ name:(accessedBy lock)
-	publiciseNote note@(NoteInfo _ _ al@(ActiveLock name idx)) = do
-	    unreadNote note
-	    addDelta name $ LockDelta idx $ SetPubNote note
-	    publified <- checkSuffPubNotes al
-	    unless publified $ do
+            erroredDB $ putRecord (RecPassword name) (RCPassword newpw')
+        setEmail Nothing _ = throwE "Authentication required"
+        setEmail auth@(Just (Auth name _)) addressStr = do
+            checkAuth auth
+            serverAddr <- erroredDB $ getRecord RecServerEmail
+            when (isNothing serverAddr) $ throwE "This server is not configured to support email notifications."
+            let addr = CS.pack addressStr
+            when (not $ CS.null addr || Text.Email.Validate.isValid addr) $ throwE "Invalid email address"
+            erroredDB $ putRecord (RecEmail name) (RCEmail addr)
+        checkCodeName :: Codename -> ExceptT String IO Bool
+        checkCodeName name = do
+            unless (validCodeName name) $ throwE "Invalid codename"
+            liftIO $ withDB dbpath $ recordExists $ RecPassword name
+        --- | TODO: journalling so we can survive death during database writes?
+        applyDeltasToRecords :: [(Codename, UserInfoDelta)] -> ExceptT String IO ()
+        applyDeltasToRecords nds = sequence_ $ [applyDeltasToRecord name deltas
+                | group <- groupBy ((==) `on` fst) nds
+                , let name = fst $ head group
+                , let deltas = map snd group ]
+        applyDeltasToRecord name deltas = do
+            erroredDB $ modifyRecord (RecUserInfoLog name) $
+                \(RCUserInfoDeltas deltas') -> RCUserInfoDeltas $ deltas ++ deltas'
+            erroredDB $ modifyRecord (RecUserInfo name) $
+                \(RCUserInfo (v,info)) -> RCUserInfo $
+                    (v+length deltas, applyDeltas info deltas)
+        declareNote note@(NoteInfo _ _ target) behind@(ActiveLock name idx) = do
+            accessLock name target =<< getCurrALock target
+            addDelta (lockOwner target) $ LockDelta (lockIndex target) $ AddSolution note
+            addDelta name $ LockDelta idx $ AddSecured note
+            accessed <- accessedBy <$> getCurrALock behind
+            mapM_ (addReadNote note) (name:accessed)
+        addReadNote note@(NoteInfo _ _ target) name = do
+            info <- getCurrUserInfo name
+            tlock <- getCurrALock target
+            unless (note `elem` notesRead info) $ do
+                addDelta name $ AddRead note
+                checkSuffReadNotes target name
+        accessLock name target@(ActiveLock tname ti) tlock = do
+            addDelta tname $ LockDelta ti $ AddAccessed name
+            mapM_ (`addReadNote` name) $ notesSecured tlock
+        publiciseLock al@(ActiveLock name idx) lock = do
+            addDelta name $ LockDelta idx SetPublic
+            retireLock lock
+        retireLock lock = do
+            mapM_ scrapNote $ lockSolutions lock
+            mapM_ publiciseNote $ notesSecured lock
+        scrapNote note@(NoteInfo _ (Just al@(ActiveLock name idx)) _) = do
+            addDelta name $ LockDelta idx (DelSecured note)
+            unreadNote note
+        scrapNote _ = return ()
+        unreadNote note@(NoteInfo name (Just al) _) = do
+            lock <- getCurrALock al
+            mapM_ (\name' -> addDelta name' (DelRead note)) $ name:(accessedBy lock)
+        publiciseNote note@(NoteInfo _ _ al@(ActiveLock name idx)) = do
+            unreadNote note
+            addDelta name $ LockDelta idx $ SetPubNote note
+            publified <- checkSuffPubNotes al
+            unless publified $ do
                 lock <- getCurrALock al
                 accessorsOfNotesOnLock <- ((++ map noteAuthor (lockSolutions lock)).concat)
                     <$> (sequence
                         [ accessedBy <$> getCurrALock behind | NoteInfo _ (Just behind) _ <- lockSolutions lock ] )
                 forM_ accessorsOfNotesOnLock $ checkSuffReadNotes al
-	checkSuffReadNotes target name = do
-	    info <- getCurrUserInfo name
-	    tlock <- getCurrALock target
-	    unless (name `elem` accessedBy tlock || public tlock || name == lockOwner target) $ do
-		when (countRead info tlock == notesNeeded) $
-		    accessLock name target tlock
-	checkSuffPubNotes al@(ActiveLock name idx) = do
+        checkSuffReadNotes target name = do
+            info <- getCurrUserInfo name
+            tlock <- getCurrALock target
+            unless (name `elem` accessedBy tlock || public tlock || name == lockOwner target) $ do
+                when (countRead info tlock == notesNeeded) $
+                    accessLock name target tlock
+        checkSuffPubNotes al@(ActiveLock name idx) = do
             lock <- getCurrALock al
-	    let countPub = fromIntegral $ length $
-		    filter (isNothing.noteBehind) $ lockSolutions lock
-	    if (countPub == notesNeeded)
-		then publiciseLock al lock >> return True
-		else return False
-	-- | XXX we apply deltas right-to-left, so in the order of adding
-	addDelta name delta = modify ((name,delta):)
-	getCurrUserInfo name = do
-	    info <- lift $ getUserInfo name
-	    (applyDeltas info . map snd . filter ((==name).fst)) <$> get
-	getCurrALock al@(ActiveLock name idx) =
-	     (fromJust.(!idx).userLocks) <$> getCurrUserInfo name
-	doNews news = case mfeedPath of
-	    Nothing -> return ()
-	    Just feedPath -> lift $ void $ forkIO $ do
-		let baseFeed = withFeedTitle "Intricacy updates" $ newFeed $ RSSKind Nothing
-		feed <- (parseFeedFromFile feedPath) `catchAll`
-		    (const $ return baseFeed)
-		time <- formatTime defaultTimeLocale rfc822DateFormat <$> getZonedTime
-		let item = withItemTitle news $ withItemDescription news $
-			withItemPubDate time $ newItem $ RSSKind Nothing
-		-- TODO: purge old entries
-		writeFile feedPath $ showTopElement $ xmlFeed $
-		    withFeedLastUpdate time $ addItem item feed
-	mailDeclaration target@(ActiveLock name _) behind@(ActiveLock solverName _) = runMaybeT $ do
-	    let makeAddr :: CS.ByteString -> SMTP.Address
-		makeAddr bs = SMTP.Address Nothing $ TS.pack $ CS.unpack bs
-	    RCEmail serverAddr <-  MaybeT $ erroredDB $ getRecord RecServerEmail
-	    RCEmail playerAddr <- MaybeT $ erroredDB $ getRecord $ RecEmail name
-	    guard $ not $ CS.null playerAddr
-	    lift.lift $ SMTP.sendMail "localhost" $ SMTP.simpleMail (makeAddr serverAddr)
-		[makeAddr playerAddr] [] []
-		(TS.pack $ "[Intricacy] " ++ alockStr target ++" solved by " ++ solverName)
-		[SMTP.plainTextPart $ TL.pack $ "A solution to your lock " ++ alockStr target ++ " has been declared by " ++ solverName ++
-		    " and secured behind " ++ alockStr behind ++ "." ++
-		    "\n\n-----\n\nYou received this email from the game Intricacy" ++
-		    "\n\thttp://sdf.org/~mbays/intricacy ." ++
-		    "\nYou can disable notifications in-game by pressing 'R' on your home" ++
-		    "\nscreen and setting an empty address." ++
-		    "\nAlternatively, just reply to this email with the phrase \"stop bugging me\"." ]
+            let countPub = fromIntegral $ length $
+                    filter (isNothing.noteBehind) $ lockSolutions lock
+            if (countPub == notesNeeded)
+                then publiciseLock al lock >> return True
+                else return False
+        -- | XXX we apply deltas right-to-left, so in the order of adding
+        addDelta name delta = modify ((name,delta):)
+        getCurrUserInfo name = do
+            info <- lift $ getUserInfo name
+            (applyDeltas info . map snd . filter ((==name).fst)) <$> get
+        getCurrALock al@(ActiveLock name idx) =
+             (fromJust.(!idx).userLocks) <$> getCurrUserInfo name
+        doNews :: String -> ExceptT String IO ()
+        doNews news = case mfeedPath of
+            Nothing -> return ()
+            Just feedPath -> lift $ void $ forkIO $ do
+                let baseFeed = withFeedTitle (TS.pack "Intricacy updates") $ newFeed $ RSSKind Nothing
+                feed <- (parseFeedFromFile feedPath) `catchAll`
+                    (const $ return baseFeed)
+                time <- formatTime defaultTimeLocale rfc822DateFormat <$> getZonedTime
+                let newsText = TS.pack news
+                    timeText = TS.pack time
+                    item = withItemTitle newsText $ withItemDescription newsText $
+                        withItemPubDate timeText $ newItem $ RSSKind Nothing
+                -- TODO: purge old entries
+                let Right element = XML.fromXMLElement $ xmlFeed $ withFeedLastUpdate timeText $ addItem item feed
+                    document = XML.Document (XML.Prologue [] Nothing []) element []
+                writeFile feedPath $ TL.unpack $ XML.renderText XML.def document
+        mailDeclaration target@(ActiveLock name _) behind@(ActiveLock solverName _) = runMaybeT $ do
+            let makeAddr :: CS.ByteString -> SMTP.Address
+                makeAddr bs = SMTP.Address Nothing $ TS.pack $ CS.unpack bs
+            RCEmail serverAddr <-  MaybeT $ erroredDB $ getRecord RecServerEmail
+            RCEmail playerAddr <- MaybeT $ erroredDB $ getRecord $ RecEmail name
+            guard $ not $ CS.null playerAddr
+            lift.lift $ SMTP.sendMail "localhost" $ SMTP.simpleMail (makeAddr serverAddr)
+                [makeAddr playerAddr] [] []
+                (TS.pack $ "[Intricacy] " ++ alockStr target ++" solved by " ++ solverName)
+                [SMTP.plainTextPart $ TL.pack $ "A solution to your lock " ++ alockStr target ++ " has been declared by " ++ solverName ++
+                    " and secured behind " ++ alockStr behind ++ "." ++
+                    "\n\n-----\n\nYou received this email from the game Intricacy" ++
+                    "\n\thttp://sdf.org/~mbays/intricacy ." ++
+                    "\nYou can disable notifications in-game by pressing 'R' on your home" ++
+                    "\nscreen and setting an empty address." ++
+                    "\nAlternatively, just reply to this email with the phrase \"stop bugging me\"." ]
diff --git a/ServerAddr.hs b/ServerAddr.hs
--- a/ServerAddr.hs
+++ b/ServerAddr.hs
@@ -33,8 +33,8 @@
 
 strToSaddr str =
     case elemIndex ':' str of
-	Nothing -> Just $ ServerAddr str defaultPort
-	Just idx -> do
-	    let (addr,portstr) = splitAt idx str
-	    port <- fst <$> listToMaybe (reads (drop 1 portstr))
-	    return $ ServerAddr addr port
+        Nothing -> Just $ ServerAddr str defaultPort
+        Just idx -> do
+            let (addr,portstr) = splitAt idx str
+            port <- fst <$> listToMaybe (reads (drop 1 portstr))
+            return $ ServerAddr addr port
diff --git a/Version.hs b/Version.hs
--- a/Version.hs
+++ b/Version.hs
@@ -11,4 +11,4 @@
 module Version where
 
 version :: String
-version = "0.7.1"
+version = "0.7.1.1"
diff --git a/intricacy.cabal b/intricacy.cabal
--- a/intricacy.cabal
+++ b/intricacy.cabal
@@ -1,5 +1,5 @@
 name:                intricacy
-version:             0.7.1
+version:             0.7.1.1
 synopsis:            A game of competitive puzzle-design
 homepage:            http://mbays.freeshell.org/intricacy
 license:             GPL-3
@@ -9,10 +9,9 @@
 -- copyright:           
 category:            Game
 build-type:          Simple
-cabal-version:       >=1.18
+cabal-version:       >=1.10
 data-files: VeraMoBd.ttf tutorial/*.lock tutorial/*.text sounds/*.ogg
-extra-doc-files: README BUILD NEWS tutorial-extra/*.lock tutorial-extra/README
-extra-source-files: Main_stub.h
+extra-source-files: Main_stub.h README BUILD NEWS tutorial-extra/*.lock tutorial-extra/README
 
 description:
     A networked game with client-server architecture. The core game is a
@@ -50,7 +49,7 @@
 
 executable intricacy
   if flag(Game)
-      extensions: DoAndIfThenElse
+      default-extensions: DoAndIfThenElse
       build-depends: base >=4.3, base < 5
         , mtl >=2.2, transformers >=0.4, stm >= 2.1
         , directory >= 1.0, filepath >= 1.0, time >= 1.2
@@ -99,7 +98,7 @@
       main-is: MainBoth.hs
       Buildable: False
 
-  ghc-options: -fno-warn-tabs
+  default-language: Haskell2010
   other-modules: AsciiLock, BinaryInstances, BoardColouring, Cache, Command,
       CursesRender, CursesUI, CursesUIMInstance, CVec, Database,
       EditGameState, Frame, GameState, GameStateTypes, GraphColouring, Hex, Init,
@@ -109,7 +108,7 @@
 
 executable intricacy-server
   if flag(Server)
-      extensions: DoAndIfThenElse
+      default-extensions: DoAndIfThenElse
       build-depends: base >=4.3, base < 5
         , mtl >=2.2, transformers >=0.4, stm >= 2.1
         , directory >= 1.0, filepath >= 1.0, time >= 1.5
@@ -119,12 +118,12 @@
         , cryptohash >= 0.8
         , RSA >= 2.0, crypto-pubkey-types >= 0.2, crypto-api >= 0.10
         , random >= 1.0, pipes >= 4
-        , feed >= 0.3.1, xml >= 1.2.6
+        , feed >= 1.0.0, xml-conduit >= 1.0.0
         , email-validate >= 1.0.0, text, smtp-mail >= 0.1.4.1
   else
     Buildable: False
   main-is:  Server.hs
-  ghc-options: -fno-warn-tabs
+  default-language: Haskell2010
   other-modules: AsciiLock, BinaryInstances, BoardColouring, CVec, Database,
       Frame, GameState, GameStateTypes, GraphColouring, Hex, Lock,
       Maxlocksize, Metagame, Mundanities, Physics, Protocol, Util, Version