diff --git a/AsciiLock.hs b/AsciiLock.hs
--- a/AsciiLock.hs
+++ b/AsciiLock.hs
@@ -8,29 +8,32 @@
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
 
+{-# LANGUAGE TupleSections #-}
+
 module AsciiLock (lockToAscii, lockOfAscii, stateToAscii
     , readAsciiLockFile, writeAsciiLockFile, monochromeOTileChar) where
 
-import Data.Function (on)
-import Control.Applicative
-import Control.Monad
-import Control.Arrow ((&&&))
-import qualified Data.Map as Map
-import Data.Map (Map)
-import qualified Data.Vector as Vector
-import Data.Maybe
-import Data.Traversable as T
-import Data.List
+import           Control.Applicative
+import           Control.Arrow       ((&&&))
+import           Control.Monad
+import           Data.Function       (on)
+import           Data.List
+import           Data.Map            (Map)
+import qualified Data.Map            as Map
+import           Data.Maybe
+import           Data.Traversable    as T
+import qualified Data.Vector         as Vector
+import           Safe                (maximumBound)
 
-import Lock
-import GameStateTypes
-import GameState
-import BoardColouring
-import Frame
-import Hex
-import CVec
-import Util
-import Mundanities
+import           BoardColouring
+import           CVec
+import           Frame
+import           GameState
+import           GameStateTypes
+import           Hex
+import           Lock
+import           Mundanities
+import           Util
 
 
 type AsciiLock = [String]
@@ -46,8 +49,9 @@
 lockOfAscii :: AsciiLock -> Maybe Lock
 lockOfAscii lines = do
     board <- asciiToBoard lines
-    let size = maximum $ map (hx . (-^origin)) $ Map.keys board
+    let size = maximumBound 0 $ hx . (-^origin) <$> Map.keys board
         frame = BasicFrame size
+    guard $ size > 0
     st <- asciiBoardState frame board
     return (frame, st)
 
@@ -55,9 +59,9 @@
 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
+            $ monochromeOTileChar colouring <$> board
+        (miny,maxy) = minmax $ cy <$> Map.keys asciiBoard
+        (minx,maxx) = minmax $ cx <$> Map.keys asciiBoard
         asciiBoard' = Map.mapKeys (-^CVec miny minx) asciiBoard
     in [ [ Map.findWithDefault ' ' (CVec y x) asciiBoard'
             | x <- [0..(maxx-minx)] ]
@@ -70,10 +74,10 @@
             | (line,y) <- zip lines [0..]
             , (ch,x) <- zip line [0..]
             , ch `notElem` "\t\r\n "]
-        (miny,maxy) = minmax $ map cy $ Map.keys asciiBoard
+        (miny,maxy) = minmax $ cy <$> Map.keys asciiBoard
         midy = miny+(maxy-miny)`div`2
         midline = filter ((==midy).cy) $ Map.keys asciiBoard
-        (minx,maxx) = minmax $ map cx $ midline
+        (minx,maxx) = minmax $ cx <$> midline
         centre = CVec midy (minx+(maxx-minx)`div`2)
     in Map.mapKeys ((+^origin) . cVec2HexVec . (-^centre))
         <$> T.mapM monoToOTile asciiBoard
@@ -83,12 +87,12 @@
     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 (BlockTile _)  = True
+        isBaseTile (PivotTile _)  = True
+        isBaseTile HookTile       = True
         isBaseTile (WrenchTile _) = True
-        isBaseTile (BallTile) = True
-        isBaseTile _ = False
+        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
@@ -101,13 +105,13 @@
         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) <- listToMaybe $ 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
+                    , not $ any (inBounds frame) fp
+                    , Block vs <- [placedPiece pp]
                     ]
             return $ delPiece idx $ setpp 0 pp st
         baseSt = setFrame . componentifyNew . addBase . addPreBase $ GameState Vector.empty []
@@ -133,8 +137,8 @@
                             , let pos' = i*^dir+^rpos
                             , Just (_,SpringTile extn _) <- [ Map.lookup pos' board ] ]
                         extnValue Compressed = 4
-                        extnValue Relaxed = 2
-                        extnValue Stretched = 1
+                        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
@@ -149,7 +153,7 @@
         Just 2 -> '"'
         Just 3 -> '&'
         Just 4 -> '~'
-        _ -> '#'
+        _      -> '#'
 monochromeOTileChar _ (_,t) = monochromeTileChar t
 monochromeTileChar :: Tile -> Char
 monochromeTileChar (PivotTile _) = 'o'
@@ -165,75 +169,74 @@
 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 [])
-monoToOTile '%' = Just $ (2,BlockTile [])
-monoToOTile '"' = Just $ (3,BlockTile [])
-monoToOTile '&' = Just $ (4,BlockTile [])
-monoToOTile '~' = Just $ (5,BlockTile [])
-monoToOTile ch = ((,) (-1)) <$> monoToTile ch
+monoToOTile '#' = Just (1,BlockTile [])
+monoToOTile '%' = Just (2,BlockTile [])
+monoToOTile '"' = Just (3,BlockTile [])
+monoToOTile '&' = Just (4,BlockTile [])
+monoToOTile '~' = Just (5,BlockTile [])
+monoToOTile ch  = (-1,) <$> monoToTile ch
 monoToTile :: Char -> Maybe Tile
-monoToTile 'o' = Just $ PivotTile zero
-monoToTile '-' = Just $ ArmTile hu False
+monoToTile 'o'  = Just $ PivotTile zero
+monoToTile '-'  = Just $ ArmTile hu False
 monoToTile '\\' = Just $ ArmTile hv False
-monoToTile '/' = Just $ ArmTile hw False
-monoToTile '.' = Just $ ArmTile (neg hu) False
-monoToTile '`' = Just $ ArmTile (neg hv) False
+monoToTile '/'  = Just $ ArmTile hw False
+monoToTile '.'  = Just $ ArmTile (neg hu) False
+monoToTile '`'  = Just $ ArmTile (neg hv) False
 monoToTile '\'' = Just $ ArmTile (neg hw) False
-monoToTile '@' = Just $ HookTile
-monoToTile '*' = Just $ WrenchTile zero
-monoToTile 'O' = Just $ BallTile
-monoToTile 's' = Just $ SpringTile Stretched hu
-monoToTile 'S' = Just $ SpringTile Relaxed hu
-monoToTile '$' = Just $ SpringTile Compressed hu
-monoToTile 'z' = Just $ SpringTile Stretched hv
-monoToTile 'Z' = Just $ SpringTile Relaxed hv
-monoToTile '5' = Just $ SpringTile Compressed hv
-monoToTile '(' = Just $ SpringTile Stretched hw
-monoToTile '[' = Just $ SpringTile Relaxed hw
-monoToTile '{' = Just $ SpringTile Compressed hw
-monoToTile 'c' = Just $ SpringTile Stretched (neg hu)
-monoToTile 'C' = Just $ SpringTile Relaxed (neg hu)
-monoToTile 'D' = Just $ SpringTile Compressed (neg hu)
-monoToTile ')' = Just $ SpringTile Stretched (neg hv)
-monoToTile ']' = Just $ SpringTile Relaxed (neg hv)
-monoToTile '}' = Just $ SpringTile Compressed (neg hv)
-monoToTile '1' = Just $ SpringTile Stretched (neg hw)
-monoToTile '7' = Just $ SpringTile Relaxed (neg hw)
-monoToTile '9' = Just $ SpringTile Compressed (neg hw)
-monoToTile _ = Nothing
+monoToTile '@'  = Just HookTile
+monoToTile '*'  = Just $ WrenchTile zero
+monoToTile 'O'  = Just BallTile
+monoToTile 's'  = Just $ SpringTile Stretched hu
+monoToTile 'S'  = Just $ SpringTile Relaxed hu
+monoToTile '$'  = Just $ SpringTile Compressed hu
+monoToTile 'z'  = Just $ SpringTile Stretched hv
+monoToTile 'Z'  = Just $ SpringTile Relaxed hv
+monoToTile '5'  = Just $ SpringTile Compressed hv
+monoToTile '('  = Just $ SpringTile Stretched hw
+monoToTile '['  = Just $ SpringTile Relaxed hw
+monoToTile '{'  = Just $ SpringTile Compressed hw
+monoToTile 'c'  = Just $ SpringTile Stretched (neg hu)
+monoToTile 'C'  = Just $ SpringTile Relaxed (neg hu)
+monoToTile 'D'  = Just $ SpringTile Compressed (neg hu)
+monoToTile ')'  = Just $ SpringTile Stretched (neg hv)
+monoToTile ']'  = Just $ SpringTile Relaxed (neg hv)
+monoToTile '}'  = Just $ SpringTile Compressed (neg hv)
+monoToTile '1'  = Just $ SpringTile Stretched (neg hw)
+monoToTile '7'  = Just $ SpringTile Relaxed (neg hw)
+monoToTile '9'  = Just $ SpringTile Compressed (neg hw)
+monoToTile _    = Nothing
 
 minmax :: Ord a => [a] -> (a,a)
 minmax = minimum &&& maximum
 
 readAsciiLockFile :: FilePath -> IO (Maybe Lock, Maybe Solution)
-readAsciiLockFile path = flip catchIO (const $ return (Nothing,Nothing)) $ do
-    lines <- readStrings path
-    return $ fromMaybe (lockOfAscii lines, Nothing) $ do
+readAsciiLockFile path = fromLines <$> readStrings path
+    where fromLines lines = fromMaybe (lockOfAscii lines, Nothing) $ do
             guard $ length lines > 2
             let (locklines, [header,solnLine]) = splitAt (length lines - 2) lines
             guard $ isPrefixOf "Solution:" header
@@ -242,5 +245,5 @@
 writeAsciiLockFile :: FilePath -> Maybe Solution -> Lock -> IO ()
 writeAsciiLockFile path msoln lock = do
     writeStrings path $ lockToAscii lock ++ case msoln of
-        Nothing -> []
+        Nothing   -> []
         Just soln -> ["Solution:", show soln]
diff --git a/BUILD b/BUILD
--- a/BUILD
+++ b/BUILD
@@ -14,8 +14,7 @@
     Install ghc, cabal, and development packages for the SDL dependencies
     above, then run
 	cabal update && cabal install
-    which should result in various haskell packages being compiled and
-    installed, probably in ~/.cabal/ . The game can then be run as
+    the intricacy binary should then be installed, possibly to
 	~/.cabal/bin/intricacy 
     Running cabal install as root should install it somewhere global.
 
@@ -25,7 +24,7 @@
 To compile the server:
 	cabal install -f Server -f -Game
 
-    The server will be installed in
+    The server will be installed as e.g.
 	~/.cabal/bin/intricacy-server
     The server runs on port 27001 by default. It writes the game database to
     a directory 'intricacydb' under the directory from which it is run.
diff --git a/BinaryInstances.hs b/BinaryInstances.hs
--- a/BinaryInstances.hs
+++ b/BinaryInstances.hs
@@ -9,15 +9,15 @@
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
 
 module BinaryInstances where
-import Data.Binary
-import qualified Data.Vector as Vector
-import Control.Monad
-import Data.Int (Int8)
+import           Control.Monad
+import           Data.Binary
+import           Data.Int       (Int8)
+import qualified Data.Vector    as Vector
 
-import GameStateTypes
-import Physics
-import Hex
-import Frame
+import           Frame
+import           GameStateTypes
+import           Hex
+import           Physics
 
 newtype SmallInt = SmallInt {fromSmallInt :: Int}
 newtype SmallNat = SmallNat {fromSmallNat :: Int}
@@ -25,27 +25,27 @@
     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'
+        if n' == 255 then 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
+    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'
+        if n' == 127 then SmallInt <$> get else return . SmallInt $ fromIntegral n'
 
 putPackedNat,putPackedInt :: Int -> Put
 putPackedNat n = put $ SmallNat n
 putPackedInt n = put $ SmallInt n
 getPackedNat,getPackedInt :: Get Int
-getPackedNat = liftM fromSmallNat get
-getPackedInt = liftM fromSmallInt get
+getPackedNat = fromSmallNat <$> get
+getPackedInt = fromSmallInt <$> get
 
 newtype ShortList a = ShortList {fromShortList :: [a]}
 instance Binary a => Binary (ShortList a) where
     put (ShortList as) = putPackedNat (length as) >> mapM_ put as
     get = do
         n <- getPackedNat
-        ShortList `liftM` getMany n
+        ShortList <$> getMany n
 
  -- | 'getMany n' get 'n' elements in order, without blowing the stack.
  -- [ copied from source of package 'binary' by Lennart Kolmodin ]
@@ -67,26 +67,26 @@
         return $ tupxy2hv (x,y)
 instance Binary g => Binary (PHS g) where
     put (PHS v) = put v
-    get = liftM PHS get
+    get = PHS <$> get
 instance Binary GameState where
     put (GameState pps conns) = put (ShortList $ Vector.toList pps) >> put (ShortList conns)
-    get = liftM2 GameState (liftM (Vector.fromList . fromShortList) get) (liftM fromShortList get)
+    get = liftM2 GameState (Vector.fromList . fromShortList <$> get) (fromShortList <$> get)
 instance Binary PlacedPiece where
     put (PlacedPiece ppos p) = put ppos >> put p
     get = liftM2 PlacedPiece get get
 instance Binary Piece where
-    put (Block patt) = put (0::Word8) >> put (ShortList patt)
-    put (Pivot arms) = put (1::Word8) >> put (ShortList arms)
+    put (Block patt)         = put (0::Word8) >> put (ShortList patt)
+    put (Pivot arms)         = put (1::Word8) >> put (ShortList arms)
     put (Hook arm stiffness) = put (2::Word8) >> put arm >> put stiffness
-    put (Wrench mom) = put (3::Word8) >> put mom
-    put Ball = put (4::Word8)
+    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
+            0 -> Block . fromShortList <$> get
+            1 -> Pivot . fromShortList <$> get
             2 -> liftM2 Hook get get
-            3 -> liftM Wrench get
+            3 -> 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
@@ -95,39 +95,38 @@
         rp <- get
         ei <- getPackedInt
         ep <- get
-        l <- get
-        return $ Connection (ri,rp) (ei,ep) l
+        Connection (ri,rp) (ei,ep) <$> get
 instance Binary Link where
-    put (Free p) = put (0::Word8) >> put p
+    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
+            0 -> Free <$> get
             1 -> liftM2 Spring get getPackedInt
 instance Binary HookForce where
-    put NullHF = put (0::Word8)
+    put NullHF         = put (0::Word8)
     put (TorqueHF dir) = put (1::Word8) >> putPackedInt dir
-    put (PushHF v) = put (2::Word8) >> put v
+    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
+            1 -> TorqueHF <$> getPackedInt
+            2 -> PushHF <$> get
 instance Binary Frame where
     put (BasicFrame s) = putPackedInt s
-    get = liftM BasicFrame getPackedInt
+    get = BasicFrame <$> getPackedInt
 
 instance Binary PlayerMove where
-    put NullPM = put (0::Word8)
-    put (HookPush v) = put (1::Word8) >> put v
+    put NullPM           = put (0::Word8)
+    put (HookPush v)     = put (1::Word8) >> put v
     put (HookTorque dir) = put (2::Word8) >> putPackedInt dir
-    put (WrenchPush v) = put (3::Word8) >> put v
+    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
+            1 -> HookPush <$> get
+            2 -> HookTorque <$> getPackedInt
+            3 -> WrenchPush <$> get
diff --git a/BoardColouring.hs b/BoardColouring.hs
--- a/BoardColouring.hs
+++ b/BoardColouring.hs
@@ -10,21 +10,21 @@
 
 module BoardColouring where
 
-import Control.Applicative
-import Control.Monad
-import Data.Function (on)
-import qualified Data.Map as Map
-import Data.Map (Map)
-import qualified Data.Set as Set
-import Data.Set (Set)
-import Data.List
-import Data.Maybe
+import           Control.Applicative
+import           Control.Monad
+import           Data.Function       (on)
+import           Data.List
+import           Data.Map            (Map)
+import qualified Data.Map            as Map
+import           Data.Maybe
+import           Data.Set            (Set)
+import qualified Data.Set            as Set
 
-import Hex
-import GameState
-import GameStateTypes
-import Util
-import GraphColouring
+import           GameState
+import           GameStateTypes
+import           GraphColouring
+import           Hex
+import           Util
 
 type PieceColouring = Map PieceIdx Int
 
@@ -32,8 +32,7 @@
 colouredPieces colourFixed st = [ idx |
     (idx, PlacedPiece _ p) <- enumVec $ placedPieces st
     , isPivot p ||
-        and [ isBlock p, idx > 0
-              , or [ colourFixed, not $ null $ springsEndAtIdx st idx ] ] ]
+        isBlock p && (idx > 0) && colourFixed || not (null $ springsEndAtIdx st idx) ]
 
 pieceTypeColouring :: GameState -> [PieceIdx] -> PieceColouring
 pieceTypeColouring st coloured = Map.fromList
@@ -43,8 +42,7 @@
 
 
 boardColouring :: GameState -> [PieceIdx] -> PieceColouring -> PieceColouring
-boardColouring st coloured lastCol =
-   fiveColour graph lastCol
+boardColouring st coloured = fiveColour graph
     where
         board = stateBoard st
         graph = Map.fromList [ (idx, nub $ neighbours idx)
@@ -82,11 +80,11 @@
                 mNext = listToMaybe
                     [ (pos', rotate (h-2) basedir)
                     | h <- [1..5]
-                    , let pos' = (rotate h basedir)+^pos
+                    , let pos' = rotate h basedir+^pos
                     , (fst <$> Map.lookup pos' board) /= Just idx
                     ]
                 (path,ns) = case mNext of
-                    Nothing -> ([],[])
+                    Nothing   -> ([],[])
                     Just next -> march idx startPos next False
-            in (pos:path, (maybeToList mn)++ns)
+            in (pos:path, maybeToList mn++ns)
 
diff --git a/CVec.hs b/CVec.hs
--- a/CVec.hs
+++ b/CVec.hs
@@ -10,9 +10,9 @@
 
 module CVec where
 
-import Hex
-import Data.Semigroup as Sem
-import Data.Monoid
+import           Data.Monoid
+import           Data.Semigroup as Sem
+import           Hex
 
 data CVec = CVec { cy, cx :: Int }
     deriving (Eq, Ord, Show)
diff --git a/Cache.hs b/Cache.hs
--- a/Cache.hs
+++ b/Cache.hs
@@ -10,26 +10,26 @@
 
 module Cache where
 
-import Network.Fancy
-import Control.Concurrent.STM
-import Control.Concurrent
-import Control.Applicative
-import Control.Exception
-import Control.Monad.Trans.Reader
-import System.Directory
-import Control.Monad
-import Data.Maybe
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Lazy as BL
-import Data.Binary
-import System.IO
-import System.FilePath
+import           Control.Applicative
+import           Control.Concurrent
+import           Control.Concurrent.STM
+import           Control.Monad
+import           Control.Monad.Catch
+import           Control.Monad.Trans.Reader
+import           Data.Binary
+import qualified Data.ByteString            as BS
+import qualified Data.ByteString.Lazy       as BL
+import           Data.Maybe
+import           Network.Fancy
+import           System.Directory
+import           System.FilePath
+import           System.IO
 
-import Database
-import Protocol
-import Metagame
-import Mundanities
-import ServerAddr
+import           Database
+import           Metagame
+import           Mundanities
+import           Protocol
+import           ServerAddr
 
 data FetchedRecord = FetchedRecord {fresh :: Bool, fetchError :: Maybe String, fetchedRC :: Maybe RecordContents}
     deriving (Eq, Show)
@@ -37,11 +37,11 @@
 
 getRecordCached :: ServerAddr -> Maybe Auth -> Maybe (TVar Bool) -> Bool -> Record -> IO (TVar FetchedRecord)
 getRecordCached saddr _ _ _ _ | nullSaddr saddr = do
-    atomically $ newTVar $ FetchedRecord True (Just "No server set.") Nothing
+    newTVarIO (FetchedRecord True (Just "No server set.") Nothing)
 getRecordCached saddr auth mflag cOnly rec = do
     fromCache <- withCache saddr $ getRecord rec
     let fresh = isJust fromCache && invariantRecord rec
-    tvar <- atomically $ newTVar $ FetchedRecord fresh Nothing fromCache
+    tvar <- newTVarIO (FetchedRecord fresh Nothing fromCache)
     unless (cOnly || fresh) $ void $ forkIO $ getRecordFromServer fromCache tvar
     return tvar
     where
@@ -80,21 +80,21 @@
 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++"!")
+            `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
+            decode . BL.fromStrict <$> BS.hGetContents hdl
 
 knownServers :: IO [ServerAddr]
-knownServers = flip catchIO (const $ return []) $ do
+knownServers = ignoreIOErr $ do
     cachedir <- confFilePath "cache"
     saddrstrs <- getDirectoryContents cachedir >>= filterM (\dir ->
         doesFileExist $ cachedir++[pathSeparator]++dir++[pathSeparator]++"serverInfo")
-    return $ concat $ map (maybeToList . strToSaddr) saddrstrs
+    return $ mapMaybe strToSaddr saddrstrs
 
 withCache :: ServerAddr -> DBM a -> IO a
 withCache saddr m = do
-    cachedir <- (++[pathSeparator]++saddrPath saddr) `liftM` confFilePath "cache"
+    cachedir <- (++pathSeparator : saddrPath saddr) <$> confFilePath "cache"
     runReaderT m cachedir
diff --git a/Command.hs b/Command.hs
--- a/Command.hs
+++ b/Command.hs
@@ -9,9 +9,9 @@
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
 
 module Command where
-import Hex
-import GameStateTypes
-import Metagame
+import           GameStateTypes
+import           Hex
+import           Metagame
 
 data Command
     = CmdDir WrHoSel HexDir | CmdRotate WrHoSel TorqueDir | CmdWait
@@ -32,10 +32,11 @@
     | CmdInputCodename Codename
     | CmdInputSelUndecl Undeclared
     | CmdWriteState
-    | CmdTutorials
+    | CmdInitiation
     | CmdShowRetired | CmdPlayLockSpec (Maybe LockSpec)
     | CmdSetServer | CmdToggleCacheOnly
     | CmdSelCodename (Maybe Codename) | CmdBackCodename | CmdHome
+    | CmdSolveInit (Maybe HexVec)
     | CmdSolve (Maybe LockIndex) | CmdDeclare (Maybe Undeclared)
     | CmdViewSolution (Maybe NoteInfo)
     | CmdSelectLock | CmdNextLock | CmdPrevLock
@@ -73,7 +74,7 @@
 describeCommand (CmdReplayForward _) = "advance replay"
 describeCommand (CmdReplayBack _) = "rewind replay"
 describeCommand CmdWriteState = "write lock"
-describeCommand CmdTutorials = "play tutorial levels"
+describeCommand CmdInitiation = "revisit initiation"
 describeCommand CmdShowRetired = "toggle showing retired locks"
 describeCommand CmdSetServer = "set server"
 describeCommand CmdToggleCacheOnly = "toggle offline mode"
@@ -81,14 +82,15 @@
         ++ maybe "" (' ':) mname
 describeCommand CmdBackCodename = "select last player"
 describeCommand CmdHome = "select self"
+describeCommand (CmdSolveInit _) = "solve lock"
 describeCommand (CmdSolve mli) = "solve lock"
         ++ maybe "" ((' ':).(:"").lockIndexChar) mli
 describeCommand (CmdPlayLockSpec mls) = "find lock by number"
         ++ maybe "" ((' ':).show) mls
 describeCommand (CmdDeclare mundecl) = "declare solution"
-        ++ maybe "" (\_->" [specified solution]") mundecl
+        ++ maybe "" (const " [specified solution]") mundecl
 describeCommand (CmdViewSolution mnote) = "view lock solution"
-        ++ maybe "" (\_->" [specified solution]") mnote
+        ++ maybe "" (const " [specified solution]") mnote
 describeCommand CmdSelectLock = "choose lock by name"
 describeCommand CmdNextLock = "next lock"
 describeCommand CmdPrevLock = "previous lock"
@@ -106,15 +108,15 @@
 describeCommand CmdHelp = "help"
 describeCommand _ = ""
 
-tileStr HookTile = "hook"
-tileStr (WrenchTile _) = "wrench"
-tileStr (ArmTile _ _) = "arm"
-tileStr (PivotTile _) = "pivot"
+tileStr HookTile         = "hook"
+tileStr (WrenchTile _)   = "wrench"
+tileStr (ArmTile _ _)    = "arm"
+tileStr (PivotTile _)    = "pivot"
 tileStr (SpringTile _ _) = "spring"
-tileStr (BlockTile _) = "block"
-tileStr BallTile = "ball"
-whsStr WHSWrench = "wrench"
-whsStr WHSHook = "hook"
+tileStr (BlockTile _)    = "block"
+tileStr BallTile         = "ball"
+whsStr WHSWrench   = "wrench"
+whsStr WHSHook     = "hook"
 whsStr WHSSelected = "tool"
 dirStr v
     | v == hu = "right"
diff --git a/CursesRender.hs b/CursesRender.hs
--- a/CursesRender.hs
+++ b/CursesRender.hs
@@ -10,16 +10,16 @@
 
 module CursesRender where
 
+import           Data.Char          (ord)
+import           Data.Map           (Map)
+import qualified Data.Map           as Map
 import qualified UI.HSCurses.Curses as Curses
-import Data.Char (ord)
-import qualified Data.Map as Map
-import Data.Map (Map)
 
-import Hex
-import CVec
-import GameStateTypes
-import BoardColouring (PieceColouring)
-import AsciiLock
+import           AsciiLock
+import           BoardColouring     (PieceColouring)
+import           CVec
+import           GameStateTypes
+import           Hex
 
 -- From Curses.CursesHelper:
 -- | Converts a list of 'Curses.Color' pairs (foreground color and
@@ -66,7 +66,7 @@
         c | cdir == hu = '-'
           | cdir == hv = '\\'
           | cdir == hw = '/'
-          | otherwise = '?'
+          | otherwise = '-'
         a = if principal then bold else a0
     in (c,a)
 tileChar HookTile = ('@',bold)
@@ -79,12 +79,25 @@
 
 ownedTileGlyph :: Bool -> PieceColouring -> [PieceIdx] -> OwnedTile -> Glyph
 ownedTileGlyph mono@True colouring reversed ot =
-    Glyph (monochromeOTileChar colouring ot) white a0
+    Glyph (monochromeOTileChar' colouring ot) white a0
+    where
+    -- |add fifth colour, to differentiate from lock frame;
+    -- adding this to the asciilock format would break back-compatibility.
+    monochromeOTileChar' colouring (idx,BlockTile _) =
+        case Map.lookup idx colouring of
+            Just 0 -> ';'
+            Just 1 -> '%'
+            Just 2 -> '"'
+            Just 3 -> '&'
+            Just 4 -> '~'
+            _      -> '#'
+    monochromeOTileChar' colouring ot = monochromeOTileChar colouring ot
 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
+                    Just 3  -> cyan  -- replace blue with cyan for visibility
+                    Just n  -> n+1
         rev = owner `elem` reversed
     in Glyph ch pair (Curses.setReverse attr rev)
 
diff --git a/CursesUI.hs b/CursesUI.hs
--- a/CursesUI.hs
+++ b/CursesUI.hs
@@ -10,40 +10,41 @@
 
 module CursesUI where
 
-import qualified UI.HSCurses.Curses as Curses
-import Control.Concurrent.STM
-import Control.Applicative
-import qualified Data.Map as Map
-import Data.Map (Map)
-import Data.Semigroup as Sem
-import Data.Monoid
-import Data.Array
-import Data.Maybe
-import Data.List
-import Control.Monad.Trans.Maybe
-import Control.Monad.State
-import Data.Function (on)
+import           Control.Applicative
+import           Control.Concurrent.STM
+import           Control.Monad.State
+import           Control.Monad.Trans.Maybe
+import           Data.Array
+import           Data.Bifunctor            (second)
+import           Data.Function             (on)
+import           Data.List
+import           Data.Map                  (Map)
+import qualified Data.Map                  as Map
+import           Data.Maybe
+import           Data.Monoid
+import           Data.Semigroup            as Sem
+import qualified UI.HSCurses.Curses        as Curses
 
-import Hex
-import GameState (stateBoard)
-import GameStateTypes
-import BoardColouring
-import Frame
-import KeyBindings
-import Command
-import Mundanities
-import ServerAddr
-import InputMode
-import CursesRender
-import CVec
+import           BoardColouring
+import           CVec
+import           Command
+import           CursesRender
+import           Frame
+import           GameState                 (stateBoard)
+import           GameStateTypes
+import           Hex
+import           InputMode
+import           KeyBindings
+import           Mundanities
+import           ServerAddr
 
 data UIState = UIState
-    { dispCPairs::[Curses.Pair]
-    , dispCentre::HexPos
-    , dispLastCol::PieceColouring
+    { dispCPairs    :: [Curses.Pair]
+    , dispCentre    :: HexPos
+    , dispLastCol   :: PieceColouring
     , uiKeyBindings :: Map InputMode KeyBindings
-    , monochrome::Bool
-    , message::Maybe (Curses.Attr, ColPair, String)}
+    , monochrome    :: Bool
+    , message       :: Maybe (Curses.Attr, ColPair, String)}
 type UIM = StateT UIState IO
 nullUIState = UIState [] (PHS zero) Map.empty Map.empty False Nothing
 
@@ -61,14 +62,14 @@
 
 getBindings :: InputMode -> UIM KeyBindings
 getBindings mode = do
-    uibdgs <- Map.findWithDefault [] mode <$> gets uiKeyBindings
+    uibdgs <- gets (Map.findWithDefault [] mode . uiKeyBindings)
     return $ uibdgs ++ bindings mode
 
 bindingsStr :: InputMode -> [Command] -> UIM String
 bindingsStr mode cmds = do
     bdgs <- getBindings mode
     return $ (("["++).(++"]")) $ intercalate "," $
-        map (maybe "" showKey . findBinding bdgs) cmds
+        maybe "" showKey . findBinding bdgs <$> cmds
 
 
 data Gravity = GravUp | GravLeft | GravRight | GravDown | GravCentre
@@ -84,9 +85,9 @@
     d $ CVec y $ x + shift
     where
         shift = case gravity of
-            GravLeft -> 0
-            GravRight -> max 0 $ w - w'
-            _ -> max 0 . (`div` 2) $ w - w'
+            GravLeft   -> 0
+            GravRight  -> max 0 $ w - w'
+            GravCentre -> w - w' `div` 2
 
 instance Sem.Semigroup Draw where
     (Draw w d) <> (Draw w' d') =
@@ -106,27 +107,46 @@
 bindingsDraw = bindingsDrawColour white
 bindingsDrawColour :: ColPair -> KeyBindings -> [Command] -> Draw
 bindingsDrawColour col bdgs cmds =
-    mconcat . ((stringDraw a0 col "[") :) . (++ [stringDraw a0 col "]"]) .
+    mconcat . (stringDraw a0 col "[" :) . (++ [stringDraw a0 col "]"]) .
     intersperse (stringDraw a0 col ",") $
-        catMaybes $ ((keyDraw <$>) . findBinding bdgs) <$> cmds
+        catMaybes $ (keyDraw <$>) . findBinding bdgs <$> cmds
     where
         keyDraw = stringDraw bold col . showKeyFriendlyShort
 
+bindingDrawChar :: KeyBindings -> Curses.Attr -> Command -> Draw
+bindingDrawChar bdgs a cmd = mconcat . maybeToList $
+    stringDraw a white . (:[]) . showKeyChar <$> findBinding bdgs cmd
+
+drawDirBindings :: InputMode -> KeyBindings -> WrHoSel -> Draw
+drawDirBindings mode bdgs whs = Draw 5 $ \cpos -> do
+    let c | mode == IMEdit = '_'
+            | otherwise = case whs of
+                WHSHook     -> '@'
+                WHSWrench   -> '*'
+                WHSSelected -> '_'
+        gl = Glyph c white a0
+    drawAtCVec gl cpos
+    sequence_ [ doDrawAt (cpos +^ hexVec2CVec dir) .
+            bindingDrawChar bdgs bold $ CmdDir whs dir
+        | dir <- hexDirs ]
+
 data BindingsEntry = BindingsEntry String [Command]
 
-drawBindingsTables :: InputMode -> Frame -> UIM ()
-drawBindingsTables mode frame | mode `elem` [ IMEdit, IMPlay ] = do
+drawBindingsTables :: InputMode -> (Command -> Bool) -> Frame -> UIM ()
+drawBindingsTables mode censor frame | mode `elem` [ IMEdit, IMPlay ] = do
     bdgs <- getBindings mode
     (h,w) <- liftIO Curses.scrSize
     let startRight = frameWidth frame + 3
     let maxWidth = (w `div` 2) - startRight - 1
     let entryDraws (BindingsEntry desc cmds) =
             (greyDraw desc, bindingsDraw bdgs cmds)
-    forM_ [GravLeft, GravRight] $ \grav ->
-        let table = bindingsTable mode grav
-            drawsTable = map (\(line, entry) -> (line, entryDraws entry)) table
-            maxDesc = maximum $ map (drawWidth . fst . snd) drawsTable
-            maxBdgs = maximum $ map (drawWidth . snd . snd) drawsTable
+    forM_ [GravLeft, GravRight] $ \grav -> do
+        let table = filter (\(_,BindingsEntry _ cs) -> not $ null cs) $
+                second (\(BindingsEntry s cs) -> BindingsEntry s $ filter censor cs) <$>
+                bindingsTable mode grav
+            drawsTable = second entryDraws <$> table
+            maxDesc = maximum $ drawWidth . fst . snd <$> drawsTable
+            maxBdgs = maximum $ drawWidth . snd . snd <$> drawsTable
             descX = (w `div` 2) + if grav == GravRight
                 then startRight + maxBdgs + 2
                 else -(startRight + maxBdgs + 2 + maxDesc)
@@ -135,7 +155,7 @@
                 else -(startRight + maxBdgs)
             oppGrav = if grav == GravRight then GravLeft else GravRight
             useDescs = maxDesc + 1 + maxBdgs <= maxWidth
-        in sequence_
+        sequence_
             [ do
                 when (maxBdgs <= maxWidth) $
                     doDrawAt (CVec y bdgsX) $ alignDraw
@@ -146,18 +166,35 @@
             | (yoff, (descDraw, bdgsDraw)) <- drawsTable
             , let y = (h `div` 2) + yoff
             ]
+        when (mode `elem` [IMPlay,IMEdit] && grav == GravLeft && maxWidth >= 5) $
+            let (halfw,poss)
+                    | maxWidth < 15 = (3,[CVec (-5) 0])
+                    | maxWidth < 19 = (7,[CVec (-4) 0, CVec (-6) 5, CVec (-6) (-5)])
+                    | otherwise = (9,[CVec (-5) 0, CVec (-5) 7, CVec (-5) (-7)])
+            in sequence_ [ doDrawAt pos $ drawDirBindings mode bdgs whs
+                | (whs,pos) <- zip [WHSSelected, WHSWrench, WHSHook] $
+                    (CVec (h `div` 2) ((w `div` 2) - startRight -
+                        min (maxWidth - halfw) (max (maxBdgs+1) halfw)) +^) <$> poss ]
+        when (mode == IMEdit && grav == GravRight && maxWidth >= 9) $
+            let c = CVec ((h`div`2) - 4) ((w`div`2) + startRight +
+                        min (maxWidth - 5) (max (maxBdgs+1) 5))
+            in sequence_ [ do
+                    drawAtCVec gl (c +^ CVec 0 x)
+                    doDrawAt (c +^ CVec 1 x) . bindingDrawChar bdgs bold $ CmdTile tile
+                | (x,tile) <- zip [-4,-2,0,2,4]
+                        [ BlockTile []
+                        , SpringTile Relaxed zero
+                        , PivotTile zero
+                        , ArmTile zero False
+                        , BallTile ]
+                , let gl = Glyph (fst $ tileChar tile) white a0 ]
+
     where
         bindingsTable IMPlay GravLeft =
-            [ (-5, BindingsEntry "move tool" $
-                map (CmdDir WHSSelected) hexDirs)
-            , (-4, BindingsEntry "select tool"
+            [ (-2, BindingsEntry "select tool"
                 [CmdToggle, CmdTile $ WrenchTile zero, CmdTile HookTile])
-            , (-3, BindingsEntry "move hook" $
-                map (CmdDir WHSHook) hexDirs)
-            , (-2, BindingsEntry "move wrench" $
-                map (CmdDir WHSWrench) hexDirs)
-            , (-1, BindingsEntry "rotate hook"
-                [CmdRotate whs dir | whs <- [WHSSelected, WHSHook], dir <- [-1,1]])
+            , (-1, BindingsEntry "rotate hook" $
+                nub [CmdRotate whs dir | whs <- [WHSSelected, WHSHook], dir <- [-1,1]])
             , ( 0, BindingsEntry "wait" [CmdWait])
             , ( 2, BindingsEntry "open lock" [CmdOpen])
             , ( 4, BindingsEntry "undo, redo" [CmdUndo, CmdRedo])
@@ -179,25 +216,17 @@
             , (7, BindingsEntry "quit" [CmdQuit])
             ]
         bindingsTable IMEdit GravLeft =
-            [ (-4, BindingsEntry "move" $ map (CmdDir WHSSelected) hexDirs)
-            , (-3, BindingsEntry "rotate"
-                [CmdRotate whs dir | whs <- [WHSSelected], dir <- [-1,1]])
-            , (-1, BindingsEntry "select" [CmdSelect])
-            , ( 0, BindingsEntry "delete" [CmdDelete])
-            , ( 1, BindingsEntry "merge" [CmdMerge])
+            [ (-1, BindingsEntry "rotate" $
+                nub [CmdRotate whs dir | whs <- [WHSSelected, WHSHook], dir <- [-1,1]])
+            , ( 0, BindingsEntry "select" [CmdSelect])
+            , ( 1, BindingsEntry "delete" [CmdDelete])
+            , ( 2, BindingsEntry "merge" [CmdMerge])
             , ( 4, BindingsEntry "undo, redo" [CmdUndo, CmdRedo])
             , ( 5, BindingsEntry "marks" [CmdMark, CmdJumpMark, CmdReset])
             ]
         bindingsTable IMEdit GravRight =
             [ (-7, BindingsEntry "help" [CmdHelp])
             , (-6, BindingsEntry "bind" [CmdBind Nothing])
-            , (-4, BindingsEntry "place" $ map CmdTile
-                [ BlockTile []
-                , SpringTile Relaxed zero
-                , PivotTile zero
-                , ArmTile zero False
-                , BallTile
-                ])
             , (-1, BindingsEntry "test" [CmdTest])
             , ( 0, BindingsEntry "play" [CmdPlay])
             , ( 1, BindingsEntry "step" [CmdWait])
@@ -206,7 +235,7 @@
             ]
         bindingsTable _ _ = []
 
-drawBindingsTables _ _ = return ()
+drawBindingsTables _ _ _ = return ()
 
 -- |frameWidth = maximum . map (abs . cx . hexVec2CVec) .
 --      blockPattern . placedPiece . framePiece
@@ -232,7 +261,7 @@
 
 drawAtWithGeom :: Glyph -> HexPos -> Geom -> UIM ()
 drawAtWithGeom gl pos geom@(scrCentre,centre) =
-    drawAtCVec gl $ scrCentre +^ (hexVec2CVec $ pos -^ centre)
+    drawAtCVec gl $ scrCentre +^ hexVec2CVec (pos -^ centre)
 
 drawAtCVec :: Glyph -> CVec -> UIM ()
 drawAtCVec gl cpos = do
@@ -247,7 +276,7 @@
 drawStrGrey = drawStr a0 0
 drawStrCentred :: Curses.Attr -> ColPair -> CVec -> [Char] -> UIM ()
 drawStrCentred attr col v str =
-    drawStr attr col (truncateCVec $ (v +^ CVec 0 (-length str `div` 2))) str
+    drawStr attr col (truncateCVec (v +^ CVec 0 (-length str `div` 2))) str
 
 
 drawCursorAt :: Maybe HexPos -> UIM ()
@@ -256,7 +285,7 @@
 drawCursorAt (Just pos) = do
     geom@(scrCentre,centre) <- getGeom
     liftIO $ Curses.cursSet Curses.CursorVisible
-    liftIO $ move $ scrCentre +^ (hexVec2CVec $ pos -^ centre)
+    liftIO $ move $ scrCentre +^ hexVec2CVec (pos -^ centre)
 
 drawState :: [PieceIdx] -> Bool -> [Alert] -> GameState -> UIM ()
 drawState reversed colourFixed alerts st = do
@@ -269,7 +298,7 @@
     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 $ ownedTileGlyph mono colouring reversed <$> stateBoard st
         ]
     return colouring
 
diff --git a/CursesUIMInstance.hs b/CursesUIMInstance.hs
--- a/CursesUIMInstance.hs
+++ b/CursesUIMInstance.hs
@@ -8,50 +8,51 @@
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
 
-{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase        #-}
 module CursesUIMInstance () where
 
-import qualified UI.HSCurses.Curses as Curses
-import qualified UI.HSCurses.CursesHelper as CursesH
-import Control.Concurrent.STM
-import Control.Concurrent
-import Control.Applicative
-import Data.Char (ord)
-import Data.Monoid
-import qualified Data.Map as Map
-import Data.Map (Map)
-import Data.Array
-import Data.Maybe
-import Data.List
-import Data.Char (chr)
-import Control.Monad.Trans.Maybe
-import Control.Concurrent (threadDelay)
-import Control.Monad.State
-import Data.Function (on)
-import Data.Foldable (for_)
+import           Control.Applicative
+import           Control.Concurrent
+import           Control.Concurrent.STM
+import           Control.Monad.State
+import           Control.Monad.Trans.Maybe
+import           Data.Array
+import           Data.Char                 (chr, ord)
+import           Data.Foldable             (for_)
+import           Data.Function             (on)
+import           Data.List
+import           Data.Map                  (Map)
+import qualified Data.Map                  as Map
+import           Data.Maybe
+import           Data.Monoid
+import           Safe                      (maximumBound)
+import qualified UI.HSCurses.Curses        as Curses
+import qualified UI.HSCurses.CursesHelper  as CursesH
 
-import Hex
-import GameStateTypes
-import Physics
-import Frame
-import Command
-import KeyBindings
-import ServerAddr
-import Cache
-import Database
-import Metagame
-import Protocol
-import Util
-import InputMode
-import MainState
-import CursesUI
-import CursesRender
-import CVec
+import           CVec
+import           Cache
+import           Command
+import           CursesRender
+import           CursesUI
+import           Database
+import           Frame
+import           GameStateTypes
+import           Hex
+import           InputMode
+import           KeyBindings
+import           MainState
+import           Metagame
+import           Physics
+import           Protocol
+import           ServerAddr
+import           Util
 
 
 drawName :: Bool -> CVec -> Codename -> MainStateT UIM ()
 drawName showScore pos name = do
-    ourName <- (authUser <$>) <$> gets curAuth
+    ourName <- gets ((authUser <$>) . curAuth)
     relScore <- getRelScore name
     let (attr,col) = case relScore of
             Just 0 -> (a0,yellow)
@@ -88,6 +89,7 @@
 
 fillBox :: CVec -> CVec -> Int -> Gravity -> [CVec -> MainStateT UIM ()] -> MainStateT UIM Int
 fillBox (CVec t l) (CVec b r) width grav draws = do
+    offset <- gets listOffset
     let half = width`div`2
         starty = (if grav == GravDown then b else t)
         cv = (b+t)`div`2
@@ -99,26 +101,33 @@
             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)] ]
+            [ [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 ]
+            , let margin = if even (j-starty) 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
-    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 ]
+        na = length locs
+        nd = length draws
+        drawChar c = \cvec -> lift . drawStr bold white cvec $ ' ':c:" "
+        draws' = if offset > 0 && length draws > na
+            then drop (max 0 $ na-1 + (na-2)*(offset-1)) draws
+                ++ [drawChar '<']
+            else draws
+        (selDraws,allDrawn) = if length draws' > na
+            then (take (na-1) draws' ++ [drawChar '>'], False)
+            else (take na draws', True)
+        zipped = zip locs selDraws
+    unless allDrawn . modify $ \ms -> ms { listOffsetMax = False }
+    mapM_ (uncurry ($)) (zip selDraws locs)
+    return $ (if grav==GravDown then minimum.(b:) else maximum.(t:)) [ y | (CVec y x,_) <- zipped ]
 
 drawLockInfo al@(ActiveLock name i) lockinfo = do
     (h,w) <- liftIO Curses.scrSize
     let [left,vcentre,right] = [ (k+2*i)*w`div`6 + (1-k) | k <- [0,1,2] ]
-    let [top,bottom] = [6, h-1]
+    let [top,bottom] = [6, h-2]
     let hcentre = (top+bottom)`div`2 - 1
-    ourName <- (authUser <$>) <$> gets curAuth
+    ourName <- gets ((authUser <$>) . curAuth)
 
     (lockTop, lockBottom) <- (fromJust<$>)$ runMaybeT $ msum
         [ do
@@ -133,18 +142,16 @@
         ]
 
     startOn <-
-        if (public lockinfo)
-        then lift $ drawStrCentred bold white (CVec (lockTop-1) vcentre) "Everyone!"
+        if public lockinfo
+        then lift $ drawStrCentred bold magenta (CVec (lockTop-1) vcentre) "Public"
             >> return (lockTop-1)
         else if null $ accessedBy lockinfo
-            then lift $ drawStrCentred a0 white (CVec (lockTop-1) vcentre) "No-one"
+            then lift $ drawStrCentred a0 white (CVec (lockTop-1) vcentre) "None"
                 >> 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) ]
-    lift $ drawStrCentred a0 white (CVec (startOn-1) vcentre) "Accessed by:"
+        [ (`drawNote` note) | note <- lockSolutions lockinfo ]
+    lift $ drawStrCentred a0 white (CVec (startOn-1) vcentre) "Solutions:"
 
     undecls <- gets undeclareds
     if isJust $ guard . (|| public lockinfo) . (`elem` accessedBy lockinfo) =<< ourName
@@ -158,7 +165,7 @@
                 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 ]
+                [ \pos -> drawName False pos name | name <- noteAuthor <$> read ]
 
     lift $ drawStrCentred a0 white (CVec (lockBottom+2) vcentre) "Notes held:"
     if null $ notesSecured lockinfo
@@ -166,14 +173,14 @@
             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 ]
+                [ (`drawActiveLock` al) | al <- noteOn <$> notesSecured lockinfo ]
 
 
 data HelpReturn = HelpNone | HelpDone | HelpContinue Int
 
 showHelpPaged :: Int -> InputMode -> HelpPage -> UIM Bool
 showHelpPaged from mode page =
-    showHelpPaged' from mode page >>= \ret -> case ret of
+    showHelpPaged' from mode page >>= \case
         HelpNone -> return False
         HelpDone -> return True
         HelpContinue from' -> do
@@ -186,8 +193,8 @@
     erase
     (h,w) <- liftIO Curses.scrSize
     let bdgWidth = 39
-        showKeys chs = intercalate "/" (map showKey chs)
-        maxkeyslen = maximum $ map (length.showKeys.map fst) $ groupBy ((==) `on` snd) bdgs
+        showKeys chs = intercalate "/" (showKey <$> chs)
+        maxkeyslen = maximum $ length . showKeys . map fst <$> groupBy ((==) `on` snd) bdgs
     drawStrCentred a0 cyan (CVec 0 (w`div`2)) "Bindings:"
     let groups = filter (not . null . describeCommand . snd . head) $
             drop from $ groupBy ((==) `on` snd) $ sortBy (compare `on` snd) bdgs
@@ -199,22 +206,23 @@
                 | group <- groups
                 , let cmd = snd $ head group
                 , let desc = describeCommand cmd
-                , let chs = map fst group
+                , let chs = fst <$> group
                 , let keysStr = showKeys chs
                 , let pad = max 0 $ minimum [maxkeyslen + 1 - length keysStr,
                         bdgWidth - length desc - length keysStr - 1 - 1]
-                ]
-                (map (`divMod` (h-3)) [0..])
+                ] $ (`divMod` (h-3)) <$> [0..]
             , (x+1)*bdgWidth < w]
     sequence_ draws
     refresh
     return $ if length draws < length groups
         then HelpContinue $ from + length draws
         else HelpDone
+showHelpPaged' from IMInit HelpPageGame =
+    drawBasicHelpPage from ("INTRICACY",magenta) (initiationHelpText,magenta)
 showHelpPaged' from IMMeta HelpPageGame =
     drawBasicHelpPage from ("INTRICACY",magenta) (metagameHelpText,magenta)
 showHelpPaged' from IMMeta (HelpPageInitiated n) =
-    drawBasicHelpPage from ("Initiation complete",magenta) (initiationHelpText n,magenta)
+    drawBasicHelpPage from ("Initiation complete",magenta) (initiationCompleteText n,magenta)
 showHelpPaged' from IMEdit HelpPageFirstEdit =
     drawBasicHelpPage from ("Your first lock:",magenta) (firstEditHelpText,green)
 showHelpPaged' _ _ _ = return HelpNone
@@ -223,9 +231,8 @@
 drawBasicHelpPage from (title,titleCol) (body,bodyCol) = do
     erase
     (h,w) <- liftIO Curses.scrSize
-    drawStrCentred a0 titleCol (CVec 0 $ w`div`2) title
     let strs = drop from $
-            if w >= maximum (map length metagameHelpText)
+            if w >= maximum (length <$> metagameHelpText)
             then body
             else
                 let wrap max = wrap' max max
@@ -237,9 +244,11 @@
                             else '\n' : wrap' max max (w:ws)
                         else let prepend = if left == max then w else ' ':w
                             in prepend ++ wrap' max (left - length prepend) ws
-                in lines . wrap w . words $ intercalate " " body
+                in lines . wrap w . words $ unwords body
+        top = max 0 $ (h - length strs) `div` 2
+    drawStrCentred a0 titleCol (CVec top $ w`div`2) title
     let draws = [drawStrCentred a0 bodyCol (CVec y $ w`div`2) str |
-                (y,str) <- zip [2..h-2] $ strs ]
+                (y,str) <- zip [top+2..h-2] strs ]
     sequence_ draws
     return $ if length draws < length strs
         then HelpContinue $ from + length draws
@@ -248,17 +257,17 @@
 
 charify :: Curses.Key -> Maybe Char
 charify key = case key of
-    Curses.KeyChar ch -> Just ch
+    Curses.KeyChar ch   -> Just ch
     Curses.KeyBackspace -> Just '\b'
-    Curses.KeyLeft -> Just '4'
-    Curses.KeyRight -> Just '6'
-    Curses.KeyDown -> Just '2'
-    Curses.KeyUp -> Just '8'
-    Curses.KeyHome -> Just '7'
-    Curses.KeyNPage -> Just '3'
-    Curses.KeyPPage -> Just '9'
-    Curses.KeyEnd -> Just '1'
-    _ -> Nothing
+    Curses.KeyLeft      -> Just '4'
+    Curses.KeyRight     -> Just '6'
+    Curses.KeyDown      -> Just '2'
+    Curses.KeyUp        -> Just '8'
+    Curses.KeyHome      -> Just '7'
+    Curses.KeyNPage     -> Just '3'
+    Curses.KeyPPage     -> Just '9'
+    Curses.KeyEnd       -> Just '1'
+    _                   -> Nothing
 
 handleEsc k@(Curses.KeyChar '\ESC') = do
     Curses.timeout 100
@@ -279,26 +288,69 @@
         drawMainState' s
         lift refresh
         where
-        drawMainState' (PlayState { psCurrentState=st, psLastAlerts=alerts,
-                wrenchSelected=wsel, psFrame=frame }) = lift $ do
+        drawMainState' PlayState { psCurrentState=st, psLastAlerts=alerts,
+                wrenchSelected=wsel, psFrame=frame, psTutLevel=tutLevel } = lift $ do
             drawState [] False alerts st
-            drawBindingsTables IMPlay frame
+            drawBindingsTables IMPlay filterBindings frame
             drawCursorAt $ listToMaybe [ pos |
                 (_, PlacedPiece pos p) <- enumVec $ placedPieces st
-                , or [wsel && isWrench p, not wsel && isHook p] ]
-        drawMainState' (ReplayState {}) = do
+                , (wsel && isWrench p) || (not wsel && isHook p) ]
+            where
+            filterBindings (CmdRotate _ _) = not $ wrenchOnlyTutLevel tutLevel
+            filterBindings CmdUndo         = not $ noUndoTutLevel tutLevel
+            filterBindings CmdRedo         = not $ noUndoTutLevel tutLevel
+            filterBindings CmdMark         = not $ noUndoTutLevel tutLevel
+            filterBindings CmdJumpMark     = not $ noUndoTutLevel tutLevel
+            filterBindings CmdReset        = not $ noUndoTutLevel tutLevel
+            filterBindings _               = True
+        drawMainState' ReplayState {} = do
             lift . drawState [] False [] =<< gets rsCurrentState
             lift $ drawCursorAt Nothing
-        drawMainState' (EditState { esGameState=st, selectedPiece=selPiece,
-                selectedPos=selPos, esFrame=frame }) = lift $ do
+        drawMainState' EditState { esGameState=st, selectedPiece=selPiece,
+                selectedPos=selPos, esFrame=frame } = lift $ do
             drawState (maybeToList selPiece) True [] st
-            drawBindingsTables IMEdit frame
+            drawBindingsTables IMEdit (const True) frame
             drawCursorAt $ if isNothing selPiece then Just selPos else Nothing
-        drawMainState' (MetaState {curServer=saddr, undeclareds=undecls,
+        drawMainState' InitState {initLocks=initLocks, tutProgress=TutProgress{tutSolved=tutSolved}} = lift $ do
+            drawCursorAt Nothing
+            (h,w) <- liftIO Curses.scrSize
+            when (h<15 || w<30) $ liftIO CursesH.end >> error "Terminal too small!"
+            let centre = CVec (h`div`2) (w`div`2)
+            drawStrCentred bold white (centre +^ CVec (-5) 0) "I N T R I C A C Y"
+            bdgs <- getBindings IMInit
+            doDrawAt (centre +^ CVec 5 0) . alignDraw GravCentre 0 $ bindingsDraw bdgs [CmdSolveInit Nothing] <> greyDraw " solve lock"
+            doDrawAt (centre +^ CVec 6 0) . alignDraw GravCentre 0 $ bindingsDraw bdgs [CmdHelp] <> greyDraw " help"
+            doDrawAt (centre +^ CVec 7 0) . alignDraw GravCentre 0 $ bindingsDraw bdgs [CmdQuit] <> greyDraw " quit"
+            let cvec v = clampHoriz $ centre +^ CVec y (3*x-1) where
+                    CVec y x = hexVec2CVec v
+                    clampHoriz (CVec y x) = CVec y . max 0 $ min (w-4) x
+                drawInitLock v = do
+                    let pos = tutPos +^ 2 *^ v
+                    drawStr bold (if solved v then green else red) (cvec pos) (name v)
+                    sequence_
+                        [ drawStr a0 green (cvec $ pos +^ h) str
+                        | (h,str) <- [(hu,"---"), (neg hv," \\ "), (neg hw," / ")]
+                        , let v' = v +^ h
+                        , abs (hy v') < 2 && hx v' >= 0 && hz v' <= 0
+                        , v' `Map.member` accessible || (isLast v && h == hu)
+                        , solved v || solved v' ]
+            drawInitLock zero
+            mapM_ drawInitLock $ Map.keys accessible
+            where
+            accessible = accessibleInitLocks tutSolved initLocks
+            tutPos = maximumBound 0 (hx <$> Map.keys accessible) *^ neg hu
+            name v | v == zero = "TUT"
+                | otherwise = maybe "???" initLockName $ Map.lookup v accessible
+            solved v | v == zero = tutSolved
+                | otherwise = Just True == (initLockSolved <$> Map.lookup v accessible)
+            isLast v | v == zero = False
+                | otherwise = Just True == (isLastInitLock <$> Map.lookup v accessible)
+        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
+                curLock=lock} = do
+            modify $ \ms -> ms { listOffsetMax = True }
+            let ourName = authUser <$> auth
             let selName = listToMaybe names
             let home = isJust ourName && ourName == selName
             (h,w) <- liftIO Curses.scrSize
@@ -309,14 +361,14 @@
                 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  " <>
+                        CmdEdit : [CmdPlaceLock Nothing | path /= ""]
+                    leftBdgsWidth = (+3) . maximum $ drawWidth <$> [serverBdgsDraw, lockBdgsDraw]
+                    helpDraw = bindingsDraw bdgs [CmdInitiation] <> greyDraw " initiation  " <>
                         bindingsDraw bdgs [CmdHelp] <> greyDraw " help"
                     serverTextDraw = greyDraw . take (w - leftBdgsWidth - drawWidth helpDraw - 1) $
                         " Server: " ++ saddrStr saddr ++ (if cOnly then "  (offline mode) " else "")
                     lockBdgsDraw' = bindingsDraw bdgs $
-                        [CmdSelectLock] ++ if path == "" then [] else [CmdNextLock, CmdPrevLock]
+                        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
@@ -342,16 +394,15 @@
                             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]
+                                CmdShowRetired : [CmdPlayLockSpec Nothing | not (null retired)]
                         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 []
+                                CmdSolve Nothing : [CmdViewSolution Nothing | isJust ourName]
             when (isJust ourName && ourName == selName) $ do
-                rnames <- liftIO $ atomically $ readTVar rnamestvar
+                rnames <- liftIO $ readTVarIO rnamestvar
                 unless (null rnames) $
                     void $ fillBox (CVec 2 0) (CVec 5 (w`div`3)) 3 GravCentre
                         [ \pos -> drawName False pos name | name <- rnames ]
@@ -381,10 +432,10 @@
                 let accessed = [ ActiveLock us i
                         | i<-[0..2]
                         , Just lock <- [ userLocks ourUInfo ! i ]
-                        , public lock || selName `elem` map Just (accessedBy lock) ]
+                        , public lock || selName `elem` (Just <$> accessedBy lock) ]
                 guard $ not $ null accessed
                 let str = "has accessed:"
-                let s = (w-(4 + length str + 6*(length accessed)))`div`2
+                let s = (w-(4 + length str + 6*length accessed))`div`2
                 let y = 4
                 lift $ do
                     drawName False (CVec y (s+1)) sel
@@ -399,12 +450,13 @@
                  liftIO $ threadDelay $ 5*10^4
         where
             drawAlert (AlertCollision pos) = drawAt cGlyph pos
-            drawAlert _ = return ()
+            drawAlert _                    = return ()
             cGlyph = Glyph '!' 0 a0
 
+    clearMessage = say ""
     drawMessage = say
-    drawPrompt full s = say s >> (liftIO $ void $ Curses.cursSet Curses.CursorVisible)
-    endPrompt = say "" >> (liftIO $ void $ Curses.cursSet Curses.CursorInvisible)
+    drawPrompt full s = liftIO (void $ Curses.cursSet Curses.CursorVisible) >> say s
+    endPrompt = say "" >> liftIO (void $ Curses.cursSet Curses.CursorInvisible)
     drawError = sayError
 
     showHelp = showHelpPaged 0
@@ -412,7 +464,7 @@
     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)
+                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
@@ -468,5 +520,5 @@
                     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
+                    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
@@ -10,26 +10,27 @@
 
 module Database where
 
-import Data.Maybe
-import Data.Tuple (swap)
-import Data.Char (toUpper)
-import Control.Applicative
-import Control.Monad
-import System.IO
-import System.FilePath
-import System.Directory
-import Control.Monad.Trans.Reader
-import Control.Monad.IO.Class
+import           Control.Applicative
+import           Control.Monad
+import           Control.Monad.IO.Class
+import           Control.Monad.Trans.Reader
+import qualified Data.ByteString.Char8      as CS
 import qualified Data.ByteString.Lazy.Char8 as CL
-import qualified Data.ByteString.Char8 as CS
+import           Data.Char                  (toUpper)
+import           Data.Maybe
+import           Data.Tuple                 (swap)
+import           System.Directory
+import           System.FilePath
+import           System.IO
 
-import Crypto.Hash (hashlazy, Digest, SHA1, digestToHexByteString)
-import Crypto.Types.PubKey.RSA (PublicKey, PrivateKey)
+import           Crypto.Hash                (Digest, SHA1,
+                                             digestToHexByteString, hashlazy)
+import           Crypto.Types.PubKey.RSA    (PrivateKey, PublicKey)
 
-import Protocol
-import Metagame
-import Lock
-import Mundanities
+import           Lock
+import           Metagame
+import           Mundanities
+import           Protocol
 
 sha1 :: CL.ByteString -> Digest SHA1
 sha1 = hashlazy
@@ -67,29 +68,29 @@
     deriving (Eq, Show)
 
 rcOfServerResp (ServedServerInfo x) = RCServerInfo x
-rcOfServerResp (ServedLock x) = RCLock x
-rcOfServerResp (ServedSolution x) = RCSolution x
-rcOfServerResp (ServedUserInfo x) = RCUserInfo x
-rcOfServerResp (ServedRetired x) = RCLockSpecs x
-rcOfServerResp (ServedPublicKey x) = RCPublicKey x
-rcOfServerResp _ = error "no corresponding rc"
+rcOfServerResp (ServedLock x)       = RCLock x
+rcOfServerResp (ServedSolution x)   = RCSolution x
+rcOfServerResp (ServedUserInfo x)   = RCUserInfo x
+rcOfServerResp (ServedRetired x)    = RCLockSpecs x
+rcOfServerResp (ServedPublicKey x)  = RCPublicKey x
+rcOfServerResp _                    = error "no corresponding rc"
 
-invariantRecord (RecUserInfo _) = False
-invariantRecord (RecUserInfoLog _) = False
+invariantRecord (RecUserInfo _)       = False
+invariantRecord (RecUserInfoLog _)    = False
 invariantRecord (RecPasswordLegacy _) = False
 invariantRecord (RecPasswordArgon2 _) = False
-invariantRecord (RecRetiredLocks _) = False
-invariantRecord (RecNote _) = False
-invariantRecord (RecEmail _) = False
-invariantRecord _ = True
+invariantRecord (RecRetiredLocks _)   = False
+invariantRecord (RecNote _)           = False
+invariantRecord (RecEmail _)          = False
+invariantRecord _                     = True
 
-askForRecord RecServerInfo = GetServerInfo
-askForRecord (RecUserInfo name) = GetUserInfo name Nothing
-askForRecord (RecLock ls) = GetLock ls
-askForRecord (RecNote note) = GetSolution note
+askForRecord RecServerInfo          = GetServerInfo
+askForRecord (RecUserInfo name)     = GetUserInfo name Nothing
+askForRecord (RecLock ls)           = GetLock ls
+askForRecord (RecNote note)         = GetSolution note
 askForRecord (RecRetiredLocks name) = GetRetired name
-askForRecord RecPublicKey = GetPublicKey
-askForRecord _ = error "no corresponding request"
+askForRecord RecPublicKey           = GetPublicKey
+askForRecord _                      = error "no corresponding request"
 
 type DBM = ReaderT FilePath IO
 withDB :: FilePath -> DBM a -> IO a
@@ -101,22 +102,22 @@
 getRecord :: Record -> DBM (Maybe RecordContents)
 getRecord rec = do
     path <- recordPath rec
-    liftIO $ flip catchIO (const $ return Nothing) $ do
+    liftIO . ignoreIOErrAlt $ do
         h <- openFile path ReadMode
         getRecordh rec h <* hClose h
-getRecordh (RecPasswordLegacy _) h = ((RCPasswordLegacy <$>) . tryRead) <$> hGetStrict h
-getRecordh (RecPasswordArgon2 _) h = ((RCPasswordArgon2 <$>) . tryRead) <$> hGetStrict h
-getRecordh (RecEmail _) h = ((RCEmail <$>) . tryRead) <$> hGetStrict h
-getRecordh (RecUserInfo _) h = ((RCUserInfo <$>) . tryRead) <$> hGetStrict h
-getRecordh (RecUserInfoLog _) h = ((RCUserInfoDeltas <$>) . tryRead) <$> hGetStrict h
-getRecordh (RecLock _) h = ((RCLock <$>) . tryRead) <$> hGetStrict h
-getRecordh (RecNote _) h = ((RCSolution <$>) . tryRead) <$> hGetStrict h
-getRecordh RecLockHashes h = ((RCLockHashes <$>) . tryRead) <$> hGetStrict h
-getRecordh (RecRetiredLocks name) h = ((RCLockSpecs <$>) . tryRead) <$> hGetStrict h
-getRecordh RecServerInfo h = ((RCServerInfo <$>) . tryRead) <$> hGetStrict h
-getRecordh RecServerEmail h = ((RCEmail <$>) . tryRead) <$> hGetStrict h
-getRecordh RecPublicKey h = ((RCPublicKey <$>) . tryRead) <$> hGetStrict h
-getRecordh RecSecretKey h = ((RCSecretKey <$>) . tryRead) <$> hGetStrict h
+getRecordh (RecPasswordLegacy _) h = (RCPasswordLegacy <$>) . tryRead <$> hGetStrict h
+getRecordh (RecPasswordArgon2 _) h = (RCPasswordArgon2 <$>) . tryRead <$> hGetStrict h
+getRecordh (RecEmail _) h = (RCEmail <$>) . tryRead <$> hGetStrict h
+getRecordh (RecUserInfo _) h = (RCUserInfo <$>) . tryRead <$> hGetStrict h
+getRecordh (RecUserInfoLog _) h = (RCUserInfoDeltas <$>) . tryRead <$> hGetStrict h
+getRecordh (RecLock _) h = (RCLock <$>) . tryRead <$> hGetStrict h
+getRecordh (RecNote _) h = (RCSolution <$>) . tryRead <$> hGetStrict h
+getRecordh RecLockHashes h = (RCLockHashes <$>) . tryRead <$> hGetStrict h
+getRecordh (RecRetiredLocks name) h = (RCLockSpecs <$>) . tryRead <$> hGetStrict h
+getRecordh RecServerInfo h = (RCServerInfo <$>) . tryRead <$> hGetStrict h
+getRecordh RecServerEmail h = (RCEmail <$>) . tryRead <$> hGetStrict h
+getRecordh RecPublicKey h = (RCPublicKey <$>) . tryRead <$> hGetStrict h
+getRecordh RecSecretKey h = (RCSecretKey <$>) . tryRead <$> hGetStrict h
 
 hGetStrict h = CS.unpack <$> concatMWhileNonempty (repeat $ CS.hGet h 1024)
     where concatMWhileNonempty (m:ms) = do
@@ -133,18 +134,18 @@
         h <- openFile path WriteMode
         putRecordh rc h
         hClose h
-putRecordh (RCPasswordLegacy hpw) h = hPutStr h $ show hpw
-putRecordh (RCPasswordArgon2 hpw) h = hPutStr h $ show hpw
-putRecordh (RCEmail addr) h = hPutStr h $ show addr
-putRecordh (RCUserInfo info) h = hPutStr h $ show info
+putRecordh (RCPasswordLegacy hpw) h    = hPutStr h $ show hpw
+putRecordh (RCPasswordArgon2 hpw) h    = hPutStr h $ show hpw
+putRecordh (RCEmail addr) h            = hPutStr h $ show addr
+putRecordh (RCUserInfo info) h         = hPutStr h $ show info
 putRecordh (RCUserInfoDeltas deltas) h = hPutStr h $ show deltas
-putRecordh (RCLock lock) h = hPutStr h $ show lock
-putRecordh (RCSolution solution) h = hPutStr h $ show solution
-putRecordh (RCLockHashes hashes) h = hPutStr h $ show hashes
-putRecordh (RCLockSpecs lss) h = hPutStr h $ show lss
-putRecordh (RCServerInfo sinfo) h = hPutStr h $ show sinfo
-putRecordh (RCPublicKey publicKey) h = hPutStr h $ show publicKey
-putRecordh (RCSecretKey secretKey) h = hPutStr h $ show secretKey
+putRecordh (RCLock lock) h             = hPutStr h $ show lock
+putRecordh (RCSolution solution) h     = hPutStr h $ show solution
+putRecordh (RCLockHashes hashes) h     = hPutStr h $ show hashes
+putRecordh (RCLockSpecs lss) h         = hPutStr h $ show lss
+putRecordh (RCServerInfo sinfo) h      = hPutStr h $ show sinfo
+putRecordh (RCPublicKey publicKey) h   = hPutStr h $ show publicKey
+putRecordh (RCSecretKey secretKey) h   = hPutStr h $ show secretKey
 
 modifyRecord :: Record -> (RecordContents -> RecordContents) -> DBM ()
 modifyRecord rec f = do
@@ -175,12 +176,12 @@
 listUsers :: DBM [Codename]
 listUsers = do
     dbpath <- ask
-    liftIO $ (map unpathifyName . filter ((==3).length)) <$>
+    liftIO $ (unpathifyName <$>) . filter ((==3).length) <$>
         getDirectoryContents (dbpath++[pathSeparator]++"users")
 
 recordPath :: Record -> DBM FilePath
 recordPath rec =
-    (++ ([pathSeparator] ++ recordPath' rec)) <$> ask
+    (++ (pathSeparator : recordPath' rec)) <$> ask
     where
         recordPath' (RecPasswordLegacy name) = userDir name ++ "passwd"
         recordPath' (RecPasswordArgon2 name) = userDir name ++ "passwd_argon2"
@@ -205,7 +206,7 @@
 
 -- | 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"]
+winSux name = if (toUpper <$> name) `elem` ["CON","PRN", "AUX","NUL"]
     then '_':name
     else name
 
@@ -214,10 +215,10 @@
 -- To avoid collisions on case-insensitive filesystems, we use '_' as an
 -- escape character.
 dummyPunctuation = concatMap $ \c ->
-    fromMaybe [c] (('_':) . pure <$> lookup c pathifyAssocs)
+    maybe [c] (('_':) . pure) (lookup c pathifyAssocs)
 unpathifyName = concatMap $ \c -> case c of
         '_' -> ""
-        _ -> pure $ fromMaybe c (lookup c $ map swap pathifyAssocs)
+        _   -> pure $ fromMaybe c (lookup c $ swap <$> pathifyAssocs)
 pathifyAssocs =
     [ ('/','s')
     , ('.','d')
diff --git a/EditGameState.hs b/EditGameState.hs
--- a/EditGameState.hs
+++ b/EditGameState.hs
@@ -10,17 +10,17 @@
 
 module EditGameState (modTile, mergeTiles) where
 
-import Control.Applicative
-import Data.Function (on)
-import qualified Data.Map as Map
-import Data.Map (Map)
-import Data.Maybe
-import Control.Monad
-import Data.List
+import           Control.Applicative
+import           Control.Monad
+import           Data.Function       (on)
+import           Data.List
+import           Data.Map            (Map)
+import qualified Data.Map            as Map
+import           Data.Maybe
 
-import Hex
-import GameState
-import GameStateTypes
+import           GameState
+import           GameStateTypes
+import           Hex
 --import Debug
 
 modTile :: Maybe Tile -> HexPos -> HexPos -> Bool -> GameState -> GameState
@@ -28,9 +28,9 @@
     let board = stateBoard st
         curOwnedTile = Map.lookup pos board
         (st',mowner) = case curOwnedTile of
-            Nothing -> (st,Nothing)
+            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
+            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
@@ -54,12 +54,12 @@
         validSpringRootTile ot = case snd ot of
             BlockTile _ -> True
             PivotTile _ -> True
-            _ -> False
+            _           -> 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) ++
+                return $ dropWhile (== owner) (drop i adjs) ++
                     if loop && i > 0 then adjs else []
     in case mowner of
          Just o | protectedPiece o -> st
@@ -75,7 +75,7 @@
                        else nextOfAdjacents adjacentBlocks False
                in case addToIdx of
                   Nothing -> addPiece $ Block [zero]
-                  Just b -> addBlockPos b pos
+                  Just b  -> addBlockPos b pos
            Just (ArmTile armdir _) ->
                let adjacentPivots = [ idx |
                        dir <- if armdir == zero then hexDirs else [armdir, neg armdir]
@@ -85,7 +85,7 @@
                        else nextOfAdjacents adjacentPivots True
                in case addToIdx of
                       Nothing -> id
-                      Just p -> addPivotArm p pos
+                      Just p  -> addPivotArm p pos
            Just (SpringTile _ _) ->
                let possibleSprings = [ Connection root end $ Spring sdir natLen |
                        sdir <- hexDirs
@@ -93,7 +93,7 @@
                        , 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')
+                       , Just True == (validSpringRootTile <$> Map.lookup rpos board')
                        , let natLen = hexLen (rpos -^ epos) - 1
                        , natLen > 0
                        {-
@@ -103,16 +103,14 @@
                            , 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))
+                       , 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
+               in maybe id addConn nextSpring
            Just (PivotTile _) -> addPiece $ Pivot []
            Just (WrenchTile _) -> addPiece $ Wrench zero
            Just HookTile -> let arm = listToMaybe [ dir |
@@ -120,7 +118,7 @@
                                     , isNothing $ Map.lookup (dir +^ pos) board' ]
                             in case arm of Just armdir -> addPiece $ Hook armdir NullHF
                                            _ -> id
-           Just (BallTile) -> addPiece Ball
+           Just BallTile -> addPiece Ball
            _ -> id
            ) st'
 
@@ -133,7 +131,7 @@
     (idx,tile) <- Map.lookup pos board
     (idx',tile') <- Map.lookup (dir+^pos) board
     guard $ idx /= idx'
-    guard $ all (not . protectedPiece) [idx,idx']
+    guard $ not (any protectedPiece [idx,idx'])
     case tile of
         BlockTile _ -> do
             BlockTile _ <- Just tile'
diff --git a/Frame.hs b/Frame.hs
--- a/Frame.hs
+++ b/Frame.hs
@@ -10,14 +10,14 @@
 
 module Frame where
 
-import Data.List ((\\))
-import qualified Data.Vector as Vector
+import           Data.List      ((\\))
+import qualified Data.Vector    as Vector
 
-import GameState
-import GameStateTypes
-import Hex
+import           GameState
+import           GameStateTypes
+import           Hex
 
-data Frame = BasicFrame Int
+newtype Frame = BasicFrame Int
     deriving (Eq, Ord, Show, Read)
 
 frameSize :: Frame -> Int
@@ -33,7 +33,7 @@
 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 $
@@ -41,14 +41,14 @@
 
 framePiece :: Frame -> PlacedPiece
 framePiece f@(BasicFrame size) =
-    PlacedPiece origin $ Block $
+    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])
+        ++ 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] ] \\
+                [rotate r ((n *^ hu) +^ (size *^ hw)) | n <- [0 .. size - 1]] | r <- [0..5] ] \\
             [bolthole f, entrance f])
     where bw = boltWidth f
 
@@ -62,8 +62,8 @@
 
 
 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] ]
+boltArea f = [PHS (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 ] ]
 
diff --git a/GameState.hs b/GameState.hs
--- a/GameState.hs
+++ b/GameState.hs
@@ -9,41 +9,42 @@
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
 
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TupleSections    #-}
 module GameState where
 
-import Control.Applicative
-import Data.Function (on)
-import qualified Data.Map as Map
-import Data.Map (Map)
-import qualified Data.Set as Set
-import Data.Set (Set)
-import qualified Data.Vector as Vector
-import Data.Maybe
-import Control.Monad
-import Control.Monad.State
-import Data.List
-import Data.Vector (Vector, (!), (//))
+import           Control.Applicative
+import           Control.Monad
+import           Control.Monad.State
+import           Data.Function       (on)
+import           Data.List
+import           Data.Map            (Map)
+import qualified Data.Map            as Map
+import           Data.Maybe
+import           Data.Set            (Set)
+import qualified Data.Set            as Set
+import           Data.Vector         (Vector, (!), (//))
+import qualified Data.Vector         as Vector
 
-import Hex
-import Util
-import GameStateTypes
+import           GameStateTypes
+import           Hex
+import           Util
 --import Debug
 
 ppidxs :: GameState -> [PieceIdx]
-ppidxs = Vector.toList . (Vector.findIndices $ const True) . placedPieces
+ppidxs = Vector.toList . Vector.findIndices (const True) . placedPieces
 
 getpp :: GameState -> PieceIdx -> PlacedPiece
-getpp st idx = (placedPieces st) ! idx
+getpp st idx = placedPieces st ! idx
 
 setpp :: PieceIdx -> PlacedPiece -> GameState -> GameState
 setpp idx pp st@(GameState pps _) =
-    let displacement = (placedPos $ getpp st idx) -^ placedPos pp
+    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
     in st {placedPieces = pps // [(idx, pp)]
-        , connections = map updateConn $ connections st }
+        , connections = updateConn <$> connections st }
 
 addpp :: PlacedPiece -> GameState -> GameState
 addpp pp st@(GameState pps _) = st {placedPieces = Vector.snoc pps pp}
@@ -83,9 +84,9 @@
 
 delPieceIn :: HexPos -> GameState -> GameState
 delPieceIn pos st =
-    case liftM fst $ Map.lookup pos $ stateBoard st of
+    case fst <$> Map.lookup pos (stateBoard st) of
         Just idx -> delPiece idx st
-        _ -> st
+        _        -> st
 
 setPiece :: PieceIdx -> Piece -> GameState -> GameState
 setPiece idx p st =
@@ -93,9 +94,8 @@
 
 adjustPieces :: (Piece -> Piece) -> GameState -> GameState
 adjustPieces f st =
-    st { placedPieces = fmap
-        (\pp -> pp { placedPiece = f $ placedPiece pp })
-       $ placedPieces st }
+    st { placedPieces =
+        (\pp -> pp { placedPiece = f $ placedPiece pp }) <$> placedPieces st }
 
 addBlockPos :: PieceIdx -> HexPos -> GameState -> GameState
 addBlockPos b pos st =
@@ -108,7 +108,7 @@
     in setPiece p (Pivot (pos -^ ppos:arms)) st
 
 locusPos :: GameState -> Locus -> HexPos
-locusPos s (idx,v) = v +^ (placedPos $ getpp s idx)
+locusPos s (idx,v) = v +^ placedPos (getpp s idx)
 
 posLocus :: GameState -> HexPos -> Maybe Locus
 posLocus st pos = listToMaybe [ (idx,pos-^ppos) |
@@ -149,19 +149,19 @@
 
 connGraphHeight :: GameState -> PieceIdx -> Int
 connGraphHeight st idx =
-    maximum (0 : map ((+1) . connGraphHeight st . fst . connectionRoot) (springsEndAtIdx st idx))
+    maximum . (0:) $ (+1) . connGraphHeight st . fst . connectionRoot <$> springsEndAtIdx st idx
 
 type Digraph a = Map a (Set a)
 checkConnGraphAcyclic :: GameState -> Bool
 checkConnGraphAcyclic st =
     let idxs = ppidxs st
-        leaves dg = map fst $ filter (Set.null . snd) $ Map.toList dg
+        leaves dg = (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
+            Just leaf -> checkDigraphAcyclic $ Map.delete leaf $ Set.delete leaf <$> dg
     in checkDigraphAcyclic $ Map.fromList
-        [ (idx, Set.fromList $ map (fst.connectionRoot) $ springsEndAtIdx st idx) | idx <- idxs ]
+        [ (idx, Set.fromList $ fst . connectionRoot <$> springsEndAtIdx st idx) | idx <- idxs ]
 
 repossessConns :: GameState -> GameState -> GameState
 repossessConns st st' =
@@ -225,8 +225,8 @@
 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 (plPieceBoard <$> enumVec plPieces) `Map.union`
+        Map.unions (connectionBoard st <$> conns)
 
 addConnAdjs :: GameState -> [Connection] -> GameBoard -> GameBoard
 addConnAdjs st = flip $ foldr addConnAdj
@@ -238,21 +238,21 @@
         addAdj pos d =
             Map.adjust (\(o,tile) -> (o,case tile of
                     BlockTile adjs -> BlockTile (d:adjs)
-                    _ -> tile))
+                    _              -> tile))
                 pos
 
 plPieceBoard :: (PieceIdx,PlacedPiece) -> GameBoard
-plPieceBoard (idx,pp) = fmap (\x -> (idx,x)) $ plPieceMap pp
+plPieceBoard (idx,pp) = (idx,) <$> plPieceMap pp
 
 plPieceMap :: PlacedPiece -> Map HexPos Tile
-plPieceMap (PlacedPiece pos (Block pattern)) =
-    let pattSet = Set.fromList pattern
+plPieceMap (PlacedPiece pos (Block patt)) =
+    let pattSet = Set.fromList patt
     in Map.fromList [ (rel +^ pos, BlockTile adjs)
-        | rel <- pattern
+        | rel <- patt
         , 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 ) :
+    Map.fromList $ (pos, PivotTile $ if overarmed then head arms else zero ) :
         [ (rel +^ pos, ArmTile rel main)
         | (rel,main) <- zip arms $ repeat False ]
 plPieceMap (PlacedPiece pos (Hook arm _)) =
@@ -266,24 +266,24 @@
 fullFootprint :: GameState -> PieceIdx -> [HexPos]
 -- ^footprint of piece and connections ending at it
 fullFootprint st idx = plPieceFootprint (getpp st idx) ++
-    (concat $ map (connectionFootPrint st) $ springsEndAtIdx st idx)
+    concatMap (connectionFootPrint st) (springsEndAtIdx st idx)
 
 footprintAt :: GameState -> PieceIdx -> [HexPos]
 -- ^footprint of piece and any connections at it
 footprintAt st idx = plPieceFootprint (getpp st idx) ++
-    (concat $ map (connectionFootPrint st) $ springsAtIdx st idx)
+    concatMap (connectionFootPrint st) (springsAtIdx st idx)
 
 footprintAtIgnoring :: GameState -> PieceIdx -> PieceIdx -> [HexPos]
 -- ^footprint of piece and any connections at it, except those with idx'
 footprintAtIgnoring st idx idx' = plPieceFootprint (getpp st idx) ++
-    (concat $ map (connectionFootPrint st) $ springsAtIdxIgnoring st idx idx')
+    concatMap (connectionFootPrint st) (springsAtIdxIgnoring st idx idx')
 
 collisions :: GameState -> PieceIdx -> PieceIdx -> [HexPos]
 -- ^intersections of two pieces and their connections, disregarding
 -- 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')
+        concatMap (connectionFootPrint st) (connectionsBetween st idx idx')
 
 connectionBoard :: GameState -> Connection -> GameBoard
 connectionBoard st (Connection root end@(eidx,_) (Spring dir natLen)) =
@@ -307,7 +307,7 @@
     where castRay' 0 _ = Nothing
           castRay' n pos =
               case Map.lookup pos board of
-                  Nothing -> castRay' (n-1) (dir+^pos)
+                  Nothing      -> castRay' (n-1) (dir+^pos)
                   Just (idx,_) -> Just (idx,pos)
 
 validGameState :: GameState -> Bool
@@ -322,25 +322,23 @@
                 (stateBoard $ GameState pps (conns \\ [c]))
                 == Just (eidx, epos)
             && springExtensionValid st c
-            && (validRoot st root)
-            && (validEnd st end)
+            && validRoot st root
+            && validEnd st end
             | c@(Connection root@(ridx,_) end@(eidx,_) (Spring dir _)) <- conns
-            , let [rpos,epos] = map (locusPos st) [root,end] ]
+            , let [rpos,epos] = locusPos st <$> [root,end] ]
     , and [ 1 == length (components $ Set.fromList patt)
-            | Block patt <- map placedPiece $ Vector.toList pps ]
+            | Block patt <- placedPiece <$> Vector.toList pps ]
     ]
 
 validRoot st (idx,v) = case placedPiece $ getpp st idx of
     (Block _) -> True
     (Pivot _) -> v==zero
-    _ -> False
+    _         -> False
 validEnd st (idx,_) = case placedPiece $ getpp st idx of
     (Block _) -> True
-    _ -> False
+    _         -> False
 
-checkValidHex (GameState pps conns) = and
-    [ all validPP $ Vector.toList pps
-    , all validConn conns ]
+checkValidHex (GameState pps conns) = all validPP (Vector.toList pps) && all validConn conns
     where
         validVec (HexVec x y z) = x+y+z==0
         validPos (PHS v) = validVec v
@@ -349,9 +347,9 @@
         validPiece (Block patt) = all validVec patt
         validPiece (Pivot arms) = all validDir arms
         validPiece (Hook dir _) = validDir dir
-        validPiece _ = True
+        validPiece _            = True
         validConn (Connection (_,rv) (_,ev) link) = all validVec [rv,ev] && validLink link
-        validLink (Free v) = validVec v
+        validLink (Free v)       = validVec v
         validLink (Spring dir _) = validDir dir
 
 protectedPiece :: PieceIdx -> Bool
diff --git a/GameStateTypes.hs b/GameStateTypes.hs
--- a/GameStateTypes.hs
+++ b/GameStateTypes.hs
@@ -10,12 +10,12 @@
 
 module GameStateTypes where
 
-import Data.Map (Map)
-import Data.Vector (Vector)
-import Hex
+import           Data.Map    (Map)
+import           Data.Vector (Vector)
+import           Hex
 
 data GameState = GameState { placedPieces :: Vector PlacedPiece,
-        connections :: [Connection] }
+        connections                       :: [Connection] }
     deriving (Eq, Ord, Show, Read)
 
 data PlacedPiece = PlacedPiece { placedPos :: HexPos, placedPiece :: Piece }
@@ -59,13 +59,13 @@
     deriving (Eq, Ord, Show, Read)
 
 tileType :: Tile -> Tile
-tileType (BlockTile _) = BlockTile []
-tileType (PivotTile _) = PivotTile zero
-tileType (ArmTile _ _) = ArmTile zero False
-tileType (WrenchTile _) = WrenchTile zero
-tileType (BallTile) = BallTile
+tileType (BlockTile _)    = BlockTile []
+tileType (PivotTile _)    = PivotTile zero
+tileType (ArmTile _ _)    = ArmTile zero False
+tileType (WrenchTile _)   = WrenchTile zero
+tileType BallTile         = BallTile
 tileType (SpringTile _ _) = SpringTile Relaxed zero
-tileType t = t
+tileType t                = t
 
 type OwnedTile = (PieceIdx, Tile)
 type GameBoard = Map HexPos OwnedTile
diff --git a/GraphColouring.hs b/GraphColouring.hs
--- a/GraphColouring.hs
+++ b/GraphColouring.hs
@@ -10,13 +10,13 @@
 
 module GraphColouring (fiveColour) where
 
-import qualified Data.Map as Map
-import Data.Map (Map)
-import qualified Data.Set as Set
-import Data.Set (Set)
+import           Data.List
+import           Data.Map    (Map)
+import qualified Data.Map    as Map
+import           Data.Maybe
+import           Data.Set    (Set)
+import qualified Data.Set    as Set
 import qualified Data.Vector as Vector
-import Data.List
-import Data.Maybe
 
 type Colouring a = Map a Int
 type Graph a = (Set a, Set (Set a))
@@ -44,7 +44,7 @@
 fiveColour' :: Ord a => Colouring a -> PlanarGraph a -> Colouring a
 fiveColour' pref g | g == Map.empty = Map.empty
 fiveColour' pref g =
-    let adjsOf v = (nub $ g Map.! v) \\ [v]
+    let adjsOf v = nub (g Map.! v) \\ [v]
         v0 = head $ filter ((<=5) . length . adjsOf) $ Map.keys g
         adjs = adjsOf v0
         addTo c =
@@ -52,9 +52,9 @@
             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))
+       else let (v',v'') = if adjs!!2 `elem` (g Map.! head adjs)
                     then (adjs!!1,adjs!!3)
-                    else (adjs!!0,adjs!!2)
+                    else (head adjs,adjs!!2)
             in addTo $ demerge v' v'' $ fiveColour' pref $ merge v0 v' v'' g
 
 possCols :: Ord a => Colouring a -> a -> [Int]
diff --git a/Hex.lhs b/Hex.lhs
--- a/Hex.lhs
+++ b/Hex.lhs
@@ -67,7 +67,7 @@
 tupxy2hv (x,y) = HexVec x y (-(x+y))
 
 hexLen :: HexVec -> Int
-hexLen (HexVec x y z) = maximum $ map abs [x,y,z]
+hexLen (HexVec x y z) = maximum $ abs <$> [x,y,z]
 
 hexDot :: HexVec -> HexVec -> Int
 hexDot (HexVec x y z) (HexVec x' y' z') = x*x'+y*y'+z*z'
@@ -90,7 +90,7 @@
     | -x > 0 && -y >= 0 = 3
     | z > 0 && x >= 0 = 4
     | -y > 0 && -z >= 0 = 5
-    | otherwise = error $ "Tried to take hextant of zero"
+    | otherwise = error "Tried to take hextant of zero"
 
 -- hextant (rotate n hu) == n
 rotate :: Int -> HexVec -> HexVec
@@ -108,7 +108,7 @@
 cmpAngles v@(HexVec x y _) v'@(HexVec x' y' _)
     | v == zero && v' == zero = EQ
     | v == zero = LT
-    | compare (hextant v) (hextant v') /= EQ = 
+    | hextant v /= hextant v' =
         compare (hextant v) (hextant v')
     | hextant v /= 0 =
         cmpAngles (rotate (-(hextant v)) v) (rotate (-(hextant v)) v')
@@ -132,7 +132,7 @@
 isHexDirOrZero v = hexLen v <= 1
 
 hexDirs :: [HexDir]
-hexDirs = map (`rotate` hu) [0..5]
+hexDirs = (`rotate` hu) <$> [0..5]
 
 hexVec2HexDirOrZero :: HexVec -> HexDirOrZero
 hexVec2HexDirOrZero v
@@ -153,9 +153,9 @@
 scaleToLength n v@(HexVec x y z) =
     let
         l = hexLen v
-        lv' = map ((`div`l).(n*)) [x,y,z]
+        lv' = (`div`l) . (n*) <$> [x,y,z]
         minI = fst $ minimumBy (compare `on` snd) $
-            zip [0..] $ map abs lv'
+            zip [0..] $ abs <$> lv'
         [x'',y'',z''] = zipWith (-) lv' [ d
                 | i <- [0..2]
                 , let d = if i == minI then sum lv' else 0 ]
@@ -186,7 +186,7 @@
 class Differable a b c where
     (-^) :: a -> b -> c
 instance Grp g => Differable g g g where
-    x -^ y = x +^ (neg y)
+    x -^ y = x +^ neg y
 
 newtype PHS g = PHS { getPHS :: g }
     deriving (Eq, Ord, Show, Read)
@@ -204,7 +204,7 @@
     0 *^ _              = zero
     1 *^ x              = x
     n *^ x
-        | n < 0     = (-n) *^ (neg x)
+        | n < 0     = (-n) *^ neg x
         | even n    = (n `div` 2) *^ (x +^ x)
         | otherwise = x +^ ((n `div` 2) *^ (x +^ x))
 
diff --git a/Init.hs b/Init.hs
--- a/Init.hs
+++ b/Init.hs
@@ -11,23 +11,24 @@
 module Init where
 
 
-import Control.Applicative
-import Control.Monad
-import Control.Monad.Trans
-import Control.Monad.Trans.Maybe
-import Control.Monad.Trans.State
-import Data.Maybe
-import System.Exit
-import System.Environment
-import System.Directory
-import System.FilePath
-import System.Console.GetOpt
+import           Control.Applicative
+import           Control.Monad
+import           Control.Monad.Trans
+import           Control.Monad.Trans.Maybe
+import           Control.Monad.Trans.State
+import           Data.Maybe
+import           System.Console.GetOpt
+import           System.Directory
+import           System.Environment
+import           System.Exit
+import           System.FilePath
 
-import Lock
-import MainState
-import Interact
-import Util
-import Version
+import           Interact
+import           Lock
+import           MainState
+import           Mundanities
+import           Util
+import           Version
 
 data Opt = LockSize Int | ForceCurses | Help | Version
     deriving (Eq, Ord, Show)
@@ -45,7 +46,7 @@
 parseArgs :: [String] -> IO ([Opt],[String])
 parseArgs argv =
     case getOpt Permute options argv of
-        (o,n,[]) -> return (o,n)
+        (o,n,[])   -> return (o,n)
         (_,_,errs) -> ioError (userError (concat errs ++ usage))
 
 setup :: IO (Maybe Lock,[Opt],Maybe String)
@@ -71,18 +72,18 @@
 main' msdlUI mcursesUI = do
     (mlock,opts,mpath) <- setup
     initMState <- case mlock of
-            Nothing -> initMetaState
             Just lock -> return $ newEditState lock Nothing mpath
+            Nothing   -> initMetaState
     void $ runMaybeT $ msum [ do
             finalState <- msum
                 [ do
                     guard $ ForceCurses `notElem` opts
-                    sdlUI <- liftMaybe $ msdlUI
+                    sdlUI <- liftMaybe msdlUI
                     MaybeT $ sdlUI $ interactUI `execStateT` initMState
                 , do
-                    cursesUI <- liftMaybe $ mcursesUI
+                    cursesUI <- liftMaybe mcursesUI
                     MaybeT $ cursesUI $ interactUI `execStateT` initMState
                 ]
-            when (isNothing mlock) $ lift $ writeMetaState finalState
-            lift $ exitSuccess
+            lift $ writeMetaState finalState
+            lift exitSuccess
         , lift exitFailure ]
diff --git a/InputMode.hs b/InputMode.hs
--- a/InputMode.hs
+++ b/InputMode.hs
@@ -10,5 +10,5 @@
 
 module InputMode where
 
-data InputMode = IMEdit | IMPlay | IMReplay | IMMeta | IMTextInput | IMImpatience
+data InputMode = IMEdit | IMPlay | IMReplay | IMInit | IMMeta | IMTextInput | IMImpatience
     deriving (Eq, Ord, Show, Read)
diff --git a/Interact.hs b/Interact.hs
--- a/Interact.hs
+++ b/Interact.hs
@@ -8,82 +8,83 @@
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
 
+{-# LANGUAGE LambdaCase          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Interact (interactUI) where
 
-import Control.Monad.State
-import Control.Applicative
-import qualified Data.Vector as Vector
-import qualified Data.Map as Map
-import Data.Map (Map)
-import Control.Monad.Writer
-import Control.Monad.Trans.Except
-import Control.Monad.Trans.Maybe
-import Control.Exception
-import Data.Maybe
-import Data.Char
-import Data.List
-import Control.Concurrent.STM
-import Control.Concurrent
-import System.Directory
-import System.FilePath
-import Data.Array
-import Data.Function (on)
-import Safe (readMay)
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.ByteString.Char8 as CS
+import           Control.Applicative
+import           Control.Concurrent
+import           Control.Concurrent.STM
+import           Control.Monad.Catch
+import           Control.Monad.State
+import           Control.Monad.Trans.Except
+import           Control.Monad.Trans.Maybe
+import           Control.Monad.Writer
+import           Data.Array
+import qualified Data.ByteString.Char8      as CS
+import qualified Data.ByteString.Lazy       as BL
+import           Data.Char
+import           Data.Function              (on)
+import           Data.List
+import           Data.Map                   (Map)
+import qualified Data.Map                   as Map
+import           Data.Maybe
+import qualified Data.Vector                as Vector
+import           Safe                       (readMay)
+import           System.Directory
+import           System.FilePath
 
-import Crypto.Types.PubKey.RSA (PublicKey)
-import Codec.Crypto.RSA (encrypt)
-import Crypto.Random (newGenIO, SystemRandom)
+import           Codec.Crypto.RSA           (encrypt)
+import           Crypto.Random              (SystemRandom, newGenIO)
+import           Crypto.Types.PubKey.RSA    (PublicKey)
 
-import Hex
-import Command
-import Physics
-import Mundanities
-import AsciiLock
-import GameState
-import GameStateTypes
-import EditGameState
-import Frame
-import Lock
-import Cache
-import Database
-import Protocol
-import Metagame
-import ServerAddr
-import MainState
-import InputMode
-import Maxlocksize
-import InteractUtil
-import Util
+import           AsciiLock
+import           Cache
+import           Command
+import           Database
+import           EditGameState
+import           Frame
+import           GameState
+import           GameStateTypes
+import           Hex
+import           InputMode
+import           InteractUtil
+import           Lock
+import           MainState
+import           Maxlocksize
+import           Metagame
+import           Mundanities
+import           Physics
+import           Protocol
+import           ServerAddr
+import           Util
 
 newtype InteractSuccess = InteractSuccess Bool
 
 interactUI :: UIMonad uiM => MainStateT uiM InteractSuccess
-interactUI = do
-    im <- gets ms2im
-    lift $ onNewMode im
-    when (im == IMEdit) setSelectedPosFromMouse
-    when (im == IMMeta) $ do
-        spawnUnblockerThread
+interactUI = (fromMaybe (InteractSuccess False) <$>) . runMaybeT $ do
+    gets initiationRequired >>? lift doInitiation
+    gets initiationRequired >>? mzero
+    lift $ do
+        im <- gets ms2im
+        lift $ onNewMode im
+        when (im == IMEdit) setSelectedPosFromMouse
+        when (im == IMMeta) $ do
+            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++"'."
-    setMark False startMark
-    interactLoop
+            testAuth
+            refreshUInfoUI
+        setMark False startMark
+        interactLoop
 
     where
+        initiationRequired s = ms2im s == IMMeta && not (initiated s)
         interactLoop = do
-            mainSt <- get
-            let im = ms2im mainSt
+            im <- gets ms2im
             when (im == IMPlay) checkWon
             when (im == IMMeta) $ (checkAsync >>) $ void.runMaybeT $
                 mourNameSelected >>? lift purgeInvalidUndecls
@@ -91,7 +92,7 @@
             cmds <- lift $ getSomeInput im
             runExceptT (mapM_ (processCommand im) cmds) >>=
                 either
-                    ((lift (drawMessage "") >>) . return)
+                    ((lift clearMessage >>) . return)
                     (const interactLoop)
 
         -- | unblock input whenever the newAsync TVar is set to True
@@ -112,6 +113,25 @@
 execSubMainState :: UIMonad uiM => MainState -> MainStateT uiM MainState
 execSubMainState = (snd <$>) . runSubMainState
 
+doInitiation :: UIMonad uiM => MainStateT uiM ()
+doInitiation = do
+    (InteractSuccess complete, s) <- runSubMainState =<< liftIO initInitState
+    liftIO $ writeInitState s
+    when complete $ do
+        modify $ \s -> s {initiated = True}
+        mauth <- gets curAuth
+        when (isNothing mauth) $ do
+            cbdg <- lift $ getUIBinding IMMeta $ CmdSelCodename Nothing
+            rbdg <- lift $ getUIBinding IMMeta (CmdRegister False)
+            let showPage p prompt = lift $ withNoBG $ showHelp IMMeta p >>? do
+                    void $ textInput prompt 1 False True Nothing Nothing
+            showPage (HelpPageInitiated 1) "[Initiation 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]"
+            lift $ drawMessage $
+                "To join the game: pick a codename ('"++cbdg++
+                "') and register it ('"++rbdg++"')."
+
 getSomeInput im = do
     cmds <- getInput im
     if null cmds then getSomeInput im else return cmds
@@ -119,12 +139,11 @@
 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])
+        IMPlay -> lift (or <$> sequence [gets psIsSub, gets psSaved, gets (null . psGameStateMoveStack)])
             >>? throwE $ InteractSuccess False
         IMEdit -> lift editStateUnsaved >>! throwE $ InteractSuccess True
-        _ -> return ()
-    title <- lift $ getTitle
+        _ -> throwE $ InteractSuccess False
+    title <- lift getTitle
     (lift . lift . confirm) ("Really quit"
             ++ (if im == IMEdit then " without saving" else "")
             ++ maybe "" (" from "++) title ++ "?")
@@ -136,19 +155,67 @@
     if checkSolved (frame,st)
         then throwE $ InteractSuccess True
         else lift.lift $ drawError "Locked!"
+
+processCommand IMInit (CmdSolveInit Nothing) = void.runMaybeT $ do
+    tutSolved <- lift . gets $ tutSolved . tutProgress
+    accessible <- lift . gets $ accessibleInitLocks tutSolved . initLocks
+    v <- if Map.null accessible then return zero else do
+        let nameMap = Map.fromList $ ("TUT",zero) :
+                [(initLockName l, v) | (v,l) <- Map.toList accessible]
+            names = Map.keys nameMap
+        name <- (map toUpper <$>) . MaybeT . lift . lift $
+            textInput ("Solve which? ["
+                ++ intercalate "," (take 3 names)
+                ++ if length names > 3 then ",...]" else "]")
+            3 False True (Just names) Nothing
+        MaybeT . return $ Map.lookup name nameMap
+    lift . processCommand IMInit . CmdSolveInit $ Just v
+processCommand IMInit (CmdSolveInit (Just v)) | v == zero = lift.void.runMaybeT $ do
+    tutdir <- liftIO $ getDataPath "tutorial"
+    tuts <- liftIO . ignoreIOErr $
+        sort . map (takeWhile (/='.')) . filter (isSuffixOf ".lock") <$>
+            getDirectoryContents tutdir
+    when (null tuts) $ do
+        lift.lift $ drawError "No tutorial levels found"
+        mzero
+    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")
+            solveLockSaving i msps (Just i) lock $ Just $ "Tutorial " ++ show i ++ ": " ++ text
+            if i+1 <= length tuts
+                then dotut (i+1) Nothing
+                else lift $ do
+                    modify $ \is -> is {tutProgress = TutProgress True 1 Nothing}
+                    lift $ drawMessage "Tutorial complete!"
+    TutProgress _ onLevel msps <- lift $ gets tutProgress
+    dotut onLevel msps
+processCommand IMInit (CmdSolveInit (Just v)) = void.runMaybeT $ do
+    l@InitLock { initLockDesc=desc, initLockLock=lock, initLockPartial=partial } <-
+        MaybeT . lift $ gets (Map.lookup v . initLocks)
+    lift $ do
+        (InteractSuccess solved, ps) <- lift . runSubMainState $
+            maybe newPlayState restorePlayState partial (reframe lock) (Just desc) Nothing False True
+        let updateLock initLock = initLock { initLockSolved = initLockSolved initLock || solved
+                , initLockPartial = Just $ savePlayState ps }
+        lift . modify $ \is -> is { initLocks = Map.adjust updateLock v $ initLocks is }
+        when (solved && isLastInitLock l) . throwE $ InteractSuccess True
+
 processCommand im cmd = lift $ processCommand' im cmd
 
 processCommand' :: UIMonad uiM => InputMode -> Command -> MainStateT uiM ()
 processCommand' im CmdHelp = lift $ do
     helpPages <- case im of
+        IMInit -> return [HelpPageGame]
         IMMeta -> return [HelpPageInput, HelpPageGame]
         IMEdit -> do
             first <- not <$> liftIO hasLocks
-            return $ [HelpPageInput] ++ if first then [HelpPageFirstEdit] else []
+            return $ HelpPageInput : [HelpPageFirstEdit | first]
         _ -> return [HelpPageInput]
     let showPage p = withNoBG $ showHelp im p >>? do
             void $ textInput "[press a key or RMB]" 1 False True Nothing Nothing
-    sequence_ $ map showPage helpPages
+    mapM_ showPage helpPages
 processCommand' im (CmdBind mcmd)= lift $ (>> endPrompt) $ runMaybeT $ do
     cmd <- liftMaybe mcmd `mplus` do
         lift $ drawPrompt False "Command to bind: "
@@ -164,7 +231,7 @@
 processCommand' _ CmdSuspend = lift suspend
 processCommand' _ CmdRedraw = lift redraw
 processCommand' im CmdClear = do
-    lift $ drawMessage ""
+    lift clearMessage
     when (im == IMMeta) $ modify $ \ms -> ms { retiredLocks = Nothing }
 processCommand' im CmdMark = void.runMaybeT $ do
     guard $ im `elem` [IMEdit, IMPlay, IMReplay]
@@ -178,13 +245,15 @@
     marks <- lift marksSet
     str <- MaybeT $ lift $ textInput
         ("Jump to mark [" ++ intersperse ',' marks ++ "]: ")
-            1 False True (Just $ map (:[]) marks) Nothing
+            1 False True (Just $ (:[]) <$> marks) Nothing
     ch <- liftMaybe $ listToMaybe str
     lift $ jumpMark ch
 processCommand' im CmdReset = jumpMark startMark
+
+processCommand' IMMeta CmdInitiation = doInitiation
 processCommand' IMMeta (CmdSelCodename mname) = void.runMaybeT $ do
     mauth <- gets curAuth
-    name <- msum [ liftMaybe $ mname
+    name <- msum [ liftMaybe mname
         , do
             newCodename <- (map toUpper <$>) $ MaybeT $ lift $
                 textInput "Select codename:"
@@ -194,13 +263,13 @@
         ]
     guard $ validCodeName name
     lift $ do
-        modify $ \ms -> ms { codenameStack = (name:codenameStack ms) }
+        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) }
+        modify $ \ms -> ms { codenameStack = ourName:codenameStack ms }
         refreshUInfoUI
 processCommand' IMMeta CmdBackCodename = do
     stack <- gets codenameStack
@@ -209,10 +278,10 @@
         refreshUInfoUI
 processCommand' IMMeta CmdSetServer = void.runMaybeT $ do
     saddr <- gets curServer
-    saddrs <- liftIO $ knownServers
+    saddrs <- liftIO knownServers
     newSaddr' <- MaybeT $ ((>>= strToSaddr) <$>) $
         lift $ textInput "Set server:" 256 False False
-            (Just $ map saddrStr saddrs) (Just $ saddrStr saddr)
+            (Just $ saddrStr <$> saddrs) (Just $ saddrStr saddr)
     let newSaddr = if nullSaddr newSaddr' then defaultServerAddr else newSaddr'
     modify $ \ms -> ms { curServer = newSaddr }
     msum [ void.MaybeT $ getFreshRecBlocking RecServerInfo
@@ -220,7 +289,7 @@
     lift $ do
         modify $ \ms -> ms {curAuth = Nothing}
         get >>= liftIO . writeServerSolns saddr
-        (undecls,partials,_) <- liftIO (readServerSolns newSaddr)
+        (undecls,partials) <- liftIO (readServerSolns newSaddr)
         modify $ \ms -> ms { undeclareds=undecls, partialSolutions=partials }
         rnamestvar <- gets randomCodenames
         liftIO $ atomically $ writeTVar rnamestvar []
@@ -286,7 +355,7 @@
                     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
@@ -297,7 +366,7 @@
         passwd <- inputPassword name False $ "Enter password for "++name++":"
         lift $ do
             modify $ \ms -> ms {curAuth = Just $ Auth name passwd}
-            resp <- curServerAction $ Authenticate
+            resp <- curServerAction Authenticate
             case resp of
                 ServerAck -> lift $ drawMessage "Authenticated."
                 ServerMessage msg -> lift $ drawMessage $ "Server: " ++ msg
@@ -321,10 +390,10 @@
                 declare undecl
         , do
             RCLock lock <- MaybeT $ getFreshRecBlocking $ RecLock ls
-            mpartial <- Map.lookup ls <$> gets partialSolutions
-            soln <- solveLockSaving ls mpartial False lock $ Just $
+            mpartial <- gets (Map.lookup ls . partialSolutions)
+            soln <- solveLockSaving ls mpartial Nothing lock $ Just $
                 "solving " ++ name ++ ":" ++ [lockIndexChar idx] ++ "  (#" ++ show ls ++")"
-            mourName <- lift $ (authUser <$>) <$> gets curAuth
+            mourName <- lift $ gets ((authUser <$>) . curAuth)
             guard $ mourName /= Just name
             let undecl = Undeclared soln ls (ActiveLock name idx)
             msum [ do
@@ -332,7 +401,7 @@
                     confirmOrBail "Declare solution?"
                     declare undecl
                 , unless (any (\(Undeclared _ ls' _) -> ls == ls') undecls) $
-                    modify $ \ms -> ms { undeclareds = (undecl : undeclareds ms) }
+                    modify $ \ms -> ms { undeclareds = undecl : undeclareds ms }
                 ]
         ]
 processCommand' IMMeta (CmdPlayLockSpec mls) = void.runMaybeT $ do
@@ -354,7 +423,7 @@
         then return $ head undecls
         else do
             which <- MaybeT $ lift $ textInput
-                ("Declare which solution?")
+                "Declare which solution?"
                 5 False True Nothing Nothing
             liftMaybe $ msum
                 [ do
@@ -364,11 +433,8 @@
                 , listToMaybe $
                     [ undecl
                     | undecl@(Undeclared _ _ (ActiveLock name' i)) <- undecls
-                    , or
-                        [ take (length which) (name' ++ ":" ++ [lockIndexChar i]) ==
-                            map toUpper which
-                        , name'==name && [lockIndexChar i] == which
-                        ]
+                    , (take (length which) (name' ++ ":" ++ [lockIndexChar i]) ==
+                            map toUpper which) || (name'==name && [lockIndexChar i] == which)
                     ]
                 ]
         ]
@@ -386,14 +452,14 @@
             | 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
+            authors = 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
+                3 False True (Just authors) Nothing
         liftMaybe $ find ((==author).noteAuthor) notes
     let ActiveLock name idx = noteOn note
     uinfo <- mgetUInfo name
@@ -416,7 +482,7 @@
         askLockIndex ("Place " ++ show lockpath ++ " in which slot?") "bug" $ const True
     when (isJust $ userLocks ourUInfo ! idx) $
         confirmOrBail "Really retire existing lock?"
-    soln <- (liftMaybe msoln `mplus`) $ solveLock lock $ Just $ "testing lock"
+    soln <- (liftMaybe msoln `mplus`) $ solveLock lock $ Just "testing lock"
     lift $ curServerActionAsyncThenInvalidate
         (SetLock lock idx soln)
         (Just (SomeCodenames [ourName]))
@@ -431,11 +497,12 @@
 processCommand' IMMeta CmdPrevLock =
     gets curLockPath >>= liftIO . nextLock False >>= setLockPath
 processCommand' IMMeta CmdNextPage =
-    modify $ \ms -> ms { listOffset = listOffset ms + 1 }
+    gets listOffsetMax >>!
+        modify $ \ms -> ms { listOffset = listOffset ms + 1 }
 processCommand' IMMeta CmdPrevPage =
     modify $ \ms -> ms { listOffset = max 0 $ listOffset ms - 1 }
 processCommand' IMMeta CmdEdit = void.runMaybeT $ do
-    (lock, msoln) <- (MaybeT $ gets curLock) `mplus` do
+    (lock, msoln) <- MaybeT (gets curLock) `mplus` do
         size <- msum
             [ do
                 gets curServer
@@ -458,49 +525,9 @@
     newPath <- MaybeT $ (esPath <$>) $ execSubMainState $
         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 [])
-    when (null tuts) $ do
-        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
-    -- 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!"
-        
-    (onLevel,msps) <- lift $ gets tutProgress
-    dotut onLevel msps
 processCommand' IMMeta CmdShowRetired = void.runMaybeT $ do
     name <- mgetCurName
-    newRL <- lift (gets retiredLocks) >>= \rl -> case rl of
+    newRL <- lift (gets retiredLocks) >>= \case
         Nothing -> do
             RCLockSpecs lss <- MaybeT $ getFreshRecBlocking $ RecRetiredLocks name
             if null lss
@@ -529,26 +556,25 @@
             pushPState (st',pm)
             modify $ \ps -> ps {psLastAlerts = alerts, psUndoneStack = ustms'}
 processCommand' IMPlay (CmdManipulateToolAt pos) = do
-    board <- stateBoard <$> gets psCurrentState
+    board <- gets (stateBoard . psCurrentState)
     wsel <- gets wrenchSelected
-    void.runMaybeT $ msum $ [ do
+    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
+            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
+    board <- gets (stateBoard . psCurrentState)
     wsel <- gets wrenchSelected
     void.runMaybeT $ do
         tp <- liftMaybe $ tileType . snd <$> Map.lookup pos board
         msum [ guard $ tp == HookTile
             , do
                 guard $ tp == WrenchTile zero
-                board' <- lift $ stateBoard . fst . runWriter . physicsTick (WrenchPush dir) <$> gets psCurrentState
+                board' <- lift $ gets ((stateBoard . fst . runWriter . physicsTick (WrenchPush dir)) . psCurrentState)
                 msum $ [ do
                         tp' <- liftMaybe $ tileType . snd <$> Map.lookup pos' board'
                         guard $ tp' == WrenchTile zero
@@ -556,13 +582,13 @@
                     , let pos' = d *^ dir +^ pos ]
                     ++ [ (lift.lift $ warpPointer pos) >> mzero ]
             ]
-        lift $ processCommand' IMPlay $ CmdDir WHSSelected $ dir
-        board' <- stateBoard <$> gets psCurrentState
+        lift $ processCommand' IMPlay $ CmdDir WHSSelected dir
+        board' <- gets (stateBoard . 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 ]
+            | pos' <- (+^pos) <$> hexDisc 2 ]
 
 processCommand' IMPlay cmd = do
     wsel <- gets wrenchSelected
@@ -579,14 +605,14 @@
         (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)
+                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 ()
@@ -596,7 +622,7 @@
             pushPState (st',pm')
 
 processCommand' IMReplay (CmdReplayBack 1) = void.runMaybeT $ do
-    (st',pm) <- MaybeT $ listToMaybe <$> gets rsGameStateMoveStack
+    (st',pm) <- MaybeT $ gets (listToMaybe . rsGameStateMoveStack)
     lift $ modify $ \rs -> rs {rsCurrentState=st'
         , rsLastAlerts = []
         , rsGameStateMoveStack = tail $ rsGameStateMoveStack rs
@@ -604,7 +630,7 @@
 processCommand' IMReplay (CmdReplayBack n) = replicateM_ n $
     processCommand' IMReplay (CmdReplayBack 1)
 processCommand' IMReplay (CmdReplayForward 1) = void.runMaybeT $ do
-    pm <- MaybeT $ listToMaybe <$> gets rsMoveStack
+    pm <- MaybeT $ gets (listToMaybe . rsMoveStack)
     lift $ do
         st <- gets rsCurrentState
         (st',alerts) <- lift $ doPhysicsTick pm st
@@ -652,7 +678,7 @@
     let selPiece' =
             if isJust selPiece
                 then Nothing
-                else liftM fst $ Map.lookup selPos $ stateBoard st
+                else fmap fst . Map.lookup selPos $ stateBoard st
     modify $ \es -> es {selectedPiece = selPiece'}
 processCommand' IMEdit (CmdDir _ dir) = do
     selPos <- gets selectedPos
@@ -664,23 +690,23 @@
 processCommand' IMEdit (CmdMoveTo newPos) =
     setSelectedPos newPos
 processCommand' IMEdit (CmdDrag pos dir) = do
-    board <- stateBoard <$> gets esGameState
+    board <- gets (stateBoard . esGameState)
     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 <$> gets esGameState
+        lift $ processCommand' IMEdit $ CmdDir WHSSelected dir
+        board' <- gets (stateBoard . esGameState)
         msum [ do
                 idx' <- liftMaybe $ fst <$> Map.lookup pos' board'
                 guard $ idx' == selIdx
-                lift.lift $ warpPointer $ pos'
+                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
+        Just p  -> doForce $ Torque p dir
 processCommand' IMEdit (CmdTile tile) = do
     selPos <- gets selectedPos
     drawTile selPos (Just tile) False
@@ -697,17 +723,17 @@
     let getDir = do
             cmd <- lift $ head <$> getSomeInput IMEdit
             case cmd of
-                CmdDir _ mergeDir -> return $ Just mergeDir
+                CmdDir _ mergeDir  -> return $ Just mergeDir
                 CmdDrag _ mergeDir -> return $ Just mergeDir
-                CmdMoveTo _ -> getDir
-                _ -> return $ Nothing
+                CmdMoveTo _        -> getDir
+                _                  -> return Nothing
     mergeDir <- getDir
     case mergeDir of
         Just mergeDir -> modifyEState $ mergeTiles selPos mergeDir True
-        _ -> return ()
+        _             -> return ()
     -- XXX: merging might invalidate selectedPiece
     modify $ \es -> es {selectedPiece = Nothing}
-    lift $ drawMessage ""
+    lift clearMessage
 processCommand' IMEdit CmdWait = do
     st <- gets esGameState
     (st',_) <- lift $ doPhysicsTick NullPM st
@@ -726,17 +752,17 @@
     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)) >>?
+    liftIO (fileExists fullPath) >>?
         confirmOrBail $ "Really overwrite '"++fullPath++"'?"
     lift $ do
         st <- gets esGameState
         frame <- gets esFrame
         msoln <- getCurTestSoln
-        merr <- liftIO $ ((writeAsciiLockFile fullPath msoln $ canonify (frame, st)) >> return Nothing)
+        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}
+            Nothing  -> modify $ \es -> es {esPath = Just newPath}
             Just err -> lift $ drawError $ "Write failed: "++err
 processCommand' _ _ = return ()
 
@@ -782,25 +808,27 @@
 
 subPlay :: UIMonad uiM => Lock -> MainStateT uiM ()
 subPlay lock =
-    pushEState =<< psCurrentState <$> (execSubMainState $ newPlayState lock Nothing False True False)
+    pushEState . psCurrentState =<< execSubMainState (newPlayState lock Nothing Nothing True False)
 
-solveLock,solveLockTut :: UIMonad uiM => Lock -> Maybe String -> MaybeT (MainStateT uiM) Solution
-solveLock = solveLock' False
-solveLockTut = solveLock' True
-solveLock' isTut lock title = do
-    (InteractSuccess solved, ps) <- lift $ runSubMainState $ newPlayState (reframe lock) title isTut False False
-    guard $ solved
-    return $ reverse $ (map snd) $ psGameStateMoveStack ps
+solveLock :: UIMonad uiM => Lock -> Maybe String -> MaybeT (MainStateT uiM) Solution
+solveLock = solveLock' Nothing
+solveLock' tutLevel lock title = do
+    (InteractSuccess solved, ps) <- lift $ runSubMainState $ newPlayState (reframe lock) title tutLevel False False
+    guard solved
+    return . reverse $ snd <$> psGameStateMoveStack ps
 
-solveLockSaving :: UIMonad uiM => LockSpec -> Maybe SavedPlayState -> Bool -> Lock -> Maybe String -> MaybeT (MainStateT uiM) Solution
-solveLockSaving ls msps isTut lock title = do
+solveLockSaving :: UIMonad uiM => LockSpec -> Maybe SavedPlayState -> Maybe Int -> Lock -> Maybe String -> MaybeT (MainStateT uiM) Solution
+solveLockSaving ls msps tutLevel lock title = do
+    let isTut = isJust tutLevel
     (InteractSuccess solved, ps) <- lift $ runSubMainState $
-        ((maybe newPlayState restorePlayState) msps) (reframe lock) title isTut False True
+        maybe newPlayState restorePlayState msps (reframe lock) title tutLevel False True
     if solved
         then do
-            unless isTut $ lift $ modify $ \ms -> ms { partialSolutions = Map.delete ls $ partialSolutions ms }
-            return $ reverse $ (map snd) $ psGameStateMoveStack ps
+            unless isTut . lift . modify $ \ms -> ms { partialSolutions = Map.delete ls $ partialSolutions ms }
+            return . reverse $ snd <$> psGameStateMoveStack ps
         else do
-            lift $ modify $ \ms -> if isTut then ms { tutProgress = (ls,Just $ savePlayState ps) }
+            lift $ modify $ \ms -> if isTut
+                then ms { tutProgress = (tutProgress ms)
+                    { tutLevel = ls, tutPartial = 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
@@ -10,32 +10,32 @@
 
 module InteractUtil where
 
-import Control.Monad.State
-import Control.Applicative
-import qualified Data.Map as Map
-import Data.Map (Map)
-import Control.Monad.Writer
-import Control.Monad.Trans.Maybe
-import Data.Maybe
-import Data.Char
-import Data.List
-import System.Directory
-import Data.Array
-import Data.Function (on)
+import           Control.Applicative
+import           Control.Monad.State
+import           Control.Monad.Trans.Maybe
+import           Control.Monad.Writer
+import           Data.Array
+import           Data.Char
+import           Data.Function             (on)
+import           Data.List
+import           Data.Map                  (Map)
+import qualified Data.Map                  as Map
+import           Data.Maybe
+import           System.Directory
 
-import Hex
-import Command
-import Physics
-import Mundanities
-import GameStateTypes
-import EditGameState
-import Frame
-import Lock
-import Protocol
-import Metagame
-import MainState
-import InputMode
-import Util
+import           Command
+import           EditGameState
+import           Frame
+import           GameStateTypes
+import           Hex
+import           InputMode
+import           Lock
+import           MainState
+import           Metagame
+import           Mundanities
+import           Physics
+import           Protocol
+import           Util
 
 checkWon :: UIMonad uiM => MainStateT uiM ()
 checkWon = do
@@ -49,7 +49,7 @@
         lift $ if solved then do
                 drawMessage $ "Unlocked! '"++obdg++"' to open."
                 reportAlerts st [AlertUnlocked]
-            else drawMessage ""
+            else clearMessage
 
 doForce force = do
     st <- gets esGameState
@@ -63,7 +63,7 @@
 paintTilePath frame tile from to = if from == to
     then modify $ \es -> es {lastModPos = to}
     else do
-        let from' = (hexVec2HexDirOrZero $ to-^from) +^ from
+        let from' = hexVec2HexDirOrZero (to-^from) +^ from
         when (inEditable frame from') $ drawTile from' tile True
         paintTilePath frame tile from' to
 
@@ -115,7 +115,7 @@
     ourUInfo <- mgetUInfo ourName
     [pbdg,ebdg,hbdg] <- mapM (lift.lift . getUIBinding IMMeta)
         [ CmdPlaceLock Nothing, CmdEdit, CmdHome ]
-    haveLock <- isJust <$> gets curLock
+    haveLock <- gets (isJust . curLock)
     idx <- askLockIndex "Secure behind which lock?"
         (if haveLock
             then "First you must place ('"++pbdg++"') a lock to secure your solution behind, while at home ('"++hbdg++"')."
@@ -135,10 +135,10 @@
 marksSet = do
     mst <- get
     return $ case ms2im mst of
-        IMEdit -> Map.keys $ esMarks mst
-        IMPlay -> Map.keys $ psMarks mst
+        IMEdit   -> Map.keys $ esMarks mst
+        IMPlay   -> Map.keys $ psMarks mst
         IMReplay -> Map.keys $ rsMarks mst
-        _ -> []
+        _        -> []
 
 jumpMark :: UIMonad uiM => Char -> MainStateT uiM ()
 jumpMark ch = do
@@ -174,8 +174,8 @@
         _ -> ask ok
     where
         ask ok = do
-            let prompt' = prompt ++ " [" ++ intersperse ',' (map lockIndexChar ok) ++ "]"
-            idx <- MaybeT $ lift $ join . (((charLockIndex<$>).listToMaybe)<$>) <$>
+            let prompt' = prompt ++ " [" ++ intersperse ',' (lockIndexChar <$> ok) ++ "]"
+            idx <- MaybeT $ lift $ (((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) ()
@@ -188,16 +188,14 @@
     where
         waitConfirm = do
             cmds <- getInput IMTextInput
-            case msum $ map ansOfCmd cmds of
-                Just answer -> return answer
-                Nothing -> waitConfirm
+            maybe waitConfirm return (msum $ ansOfCmd <$> cmds)
         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
+        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)
@@ -211,8 +209,8 @@
             else do
                 cmds <- getInput IMTextInput
                 case foldM applyCmd (s,mstem) cmds of
-                    Left False -> return Nothing
-                    Left True -> return $ Just s
+                    Left False        -> return Nothing
+                    Left True         -> return $ Just s
                     Right (s',mstem') -> getText (s',mstem')
             where
                 applyCmd (s,mstem) (CmdInputChar c) = case c of
@@ -222,8 +220,8 @@
                     '\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)
+                    '\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
@@ -245,11 +243,11 @@
                             then ((if length s >= maxlen then id else (++[c])) s, Nothing)
                             else (s,mstem)
                 applyCmd x (CmdInputSelLock idx) =
-                    setTextOrSubmit x $ [lockIndexChar idx]
+                    setTextOrSubmit x [lockIndexChar idx]
                 applyCmd x (CmdInputSelUndecl (Undeclared _ _ (ActiveLock name idx))) =
                     setTextOrSubmit x $ name++[':',lockIndexChar idx]
                 applyCmd x (CmdInputCodename name) =
-                    setTextOrSubmit x $ name
+                    setTextOrSubmit x name
                 applyCmd x CmdRefresh = Right x
                 applyCmd x CmdUnselect = Right x
                 applyCmd _ _ = Left False
diff --git a/Intricacy.hs b/Intricacy.hs
--- a/Intricacy.hs
+++ b/Intricacy.hs
@@ -8,24 +8,24 @@
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
 
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP                      #-}
 #ifdef APPLE
 {-# LANGUAGE ForeignFunctionInterface #-}
 #endif
 module Main where
 
 #ifdef MAIN_SDL
-import qualified SDLUI (UIM)
-import SDLUIMInstance ()
+import qualified SDLUI             (UIM)
+import           SDLUIMInstance    ()
 #endif
 
 #ifdef MAIN_CURSES
-import qualified CursesUI (UIM)
-import CursesUIMInstance ()
+import qualified CursesUI          (UIM)
+import           CursesUIMInstance ()
 #endif
 
-import Init
-import MainState
+import           Init
+import           MainState
 
 #ifdef APPLE
 foreign export ccall hs_MAIN :: IO ()
diff --git a/KeyBindings.hs b/KeyBindings.hs
--- a/KeyBindings.hs
+++ b/KeyBindings.hs
@@ -9,17 +9,17 @@
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
 
 module KeyBindings (KeyBindings, bindings, findBindings, findBinding, showKey,
-    showKeyFriendly, showKeyFriendlyShort) where
+    showKeyChar, showKeyFriendly, showKeyFriendlyShort) where
 
-import Data.Maybe
-import Data.Char
-import Data.List
-import Data.Bits (xor)
+import           Data.Bits      (xor)
+import           Data.Char
+import           Data.List
+import           Data.Maybe
 
-import Command
-import Hex
-import GameStateTypes
-import InputMode
+import           Command
+import           GameStateTypes
+import           Hex
+import           InputMode
 
 type KeyBindings = [ (Char,Command) ]
 
@@ -30,7 +30,7 @@
 unmeta = meta
 
 lowerToo :: KeyBindings -> KeyBindings
-lowerToo = concat . map addLower
+lowerToo = concatMap addLower
     where addLower b@(c, cmd) = [ b, (toLower c, cmd) ]
 
 qwertyViHex =
@@ -167,6 +167,8 @@
 playBindings = playOnly ++ lockGlobal
 replayBindings = replayOnly ++ lockGlobal
 editBindings = editOnly ++ lockGlobal
+initBindings = lowerToo
+    [ ('S', CmdSolveInit Nothing) ] ++ miscGlobal
 metaBindings = lowerToo
     [ ('C', CmdSelCodename Nothing)
     , ('H', CmdHome)
@@ -182,7 +184,7 @@
     , ('O', CmdPrevLock)
     , ('N', CmdNextLock)
     , ('A', CmdAuth)
-    , ('T', CmdTutorials)
+    , ('I', CmdInitiation)
     , ('+', CmdShowRetired)
     , ('#', CmdPlayLockSpec Nothing)
     , ('$', CmdSetServer)
@@ -191,17 +193,18 @@
     , ('<', CmdPrevPage)
     ] ++ miscGlobal
 
-impatienceBindings = lowerToo $
+impatienceBindings = lowerToo
     [ ('Q', CmdQuit)
     , (ctrl 'C', CmdQuit) ]
 
 bindings :: InputMode -> KeyBindings
-bindings IMEdit = editBindings
-bindings IMPlay = playBindings
-bindings IMMeta = metaBindings
-bindings IMReplay = replayBindings
+bindings IMEdit       = editBindings
+bindings IMPlay       = playBindings
+bindings IMInit       = initBindings
+bindings IMMeta       = metaBindings
+bindings IMReplay     = replayBindings
 bindings IMImpatience = impatienceBindings
-bindings _ = []
+bindings _            = []
 
 findBindings :: KeyBindings -> Command -> [Char]
 findBindings bdgs cmd = nub
@@ -211,20 +214,28 @@
 findBinding :: KeyBindings -> Command -> Maybe Char
 findBinding = (listToMaybe.) . findBindings
 
+showKey :: Char -> String
 showKey ch
     | isAscii (unmeta ch) = 'M':'-':showKey (unmeta ch)
     | isPrint ch = [ch]
-    | isPrint (unctrl ch) = ('^':[unctrl ch])
+    | isPrint (unctrl ch) = '^':[unctrl ch]
     | otherwise = "[?]"
 
-showKeyFriendly ' ' = "space"
+showKeyFriendly ' '  = "space"
 showKeyFriendly '\r' = "return"
 showKeyFriendly '\n' = "newline"
 showKeyFriendly '\t' = "tab"
 showKeyFriendly '\b' = "bksp"
-showKeyFriendly ch = showKey ch
+showKeyFriendly ch   = showKey ch
 
 showKeyFriendlyShort '\r' = "ret"
 showKeyFriendlyShort '\t' = "tab"
 showKeyFriendlyShort '\b' = "bksp"
-showKeyFriendlyShort ch = showKey ch
+showKeyFriendlyShort ch   = showKey ch
+
+showKeyChar :: Char -> Char
+showKeyChar ch
+    | isAscii (unmeta ch) = '['
+    | isPrint ch = ch
+    | isPrint (unctrl ch) = '^'
+    | otherwise = '?'
diff --git a/Lock.hs b/Lock.hs
--- a/Lock.hs
+++ b/Lock.hs
@@ -9,16 +9,16 @@
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
 
 module Lock where
-import Control.Monad.Writer
-import Data.Maybe
-import qualified Data.Map as Map
+import           Control.Monad.Writer
+import qualified Data.Map             as Map
+import           Data.Maybe
 
-import Frame
-import GameState
-import GameStateTypes
-import Hex
-import Util
-import Physics
+import           Frame
+import           GameState
+import           GameStateTypes
+import           Hex
+import           Physics
+import           Util
 
 type Lock = (Frame, GameState)
 liftLock :: (GameState -> GameState) -> (Lock -> Lock)
@@ -39,11 +39,7 @@
 reframe l@(f, st) = addTools $ delTools $ liftLock (setpp 0 (framePiece f)) l
 
 validLock :: Lock -> Bool
-validLock lock@(f,st) = and
-    [ st == stepPhysics st
-    , lock == reframe lock
-    , validGameState st
-    ]
+validLock lock@(f,st) = (st == stepPhysics st) && (lock == reframe lock) && validGameState st
 
 type Solution = [PlayerMove]
 
@@ -65,7 +61,7 @@
 delTools = liftLock delTools' where
         delTools' :: GameState -> GameState
         delTools' st =
-            fromMaybe st $ listToMaybe 
+            fromMaybe st $ listToMaybe
                 [ delTools' $ delPiece idx st
                 | (idx,pp) <- enumVec $ placedPieces st
                 , isTool $ placedPiece pp ]
@@ -90,5 +86,5 @@
         [ delOOB $ liftLock (delPiece idx) l
         | (idx,_) <- enumVec $ placedPieces st
         , not $ isFrame idx
-        , all (not.inBounds f) $ fullFootprint st idx
+        , not (any (inBounds f) (fullFootprint st idx))
         , null $ springsEndAtIdx st idx]
diff --git a/MainState.hs b/MainState.hs
--- a/MainState.hs
+++ b/MainState.hs
@@ -8,42 +8,44 @@
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
 
+{-# LANGUAGE TupleSections #-}
+
 module MainState where
 
-import Control.Monad.State
-import Control.Applicative
-import qualified Data.Vector as Vector
-import qualified Data.Map as Map
-import Data.Map (Map)
-import Control.Monad.Writer
-import Control.Monad.Trans.Maybe
-import Data.Maybe
-import Data.Char
-import Data.List
-import Control.Concurrent.STM
-import Control.Concurrent
-import System.Directory
-import System.FilePath
-import Data.Time.Clock
-import Data.Array
-import Data.Function (on)
-import Safe
+import           Control.Applicative
+import           Control.Concurrent
+import           Control.Concurrent.STM
+import           Control.Monad.State
+import           Control.Monad.Trans.Maybe
+import           Control.Monad.Writer
+import           Data.Array
+import           Data.Char
+import           Data.Function             (on)
+import           Data.List
+import           Data.Map                  (Map)
+import qualified Data.Map                  as Map
+import           Data.Maybe
+import           Data.Time.Clock
+import qualified Data.Vector               as Vector
+import           Safe
+import           System.Directory
+import           System.FilePath
 
-import Hex
-import Mundanities
-import AsciiLock
-import GameStateTypes
-import Physics
-import Command
-import Frame
-import Lock
-import Cache
-import Database
-import Protocol
-import Metagame
-import ServerAddr
-import InputMode
-import Util
+import           AsciiLock
+import           Cache
+import           Command
+import           Database
+import           Frame
+import           GameStateTypes
+import           Hex
+import           InputMode
+import           Lock
+import           Metagame
+import           Mundanities
+import           Physics
+import           Protocol
+import           ServerAddr
+import           Util
 
 class (Applicative m, MonadIO m) => UIMonad m where
     runUI :: m a -> IO a
@@ -51,6 +53,7 @@
     endUI :: m ()
     drawMainState :: MainStateT m ()
     reportAlerts :: GameState -> [Alert] -> m ()
+    clearMessage :: m ()
     drawMessage :: String -> m ()
     drawPrompt :: Bool -> String -> m ()
     endPrompt :: m ()
@@ -78,59 +81,64 @@
 -- | 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
+        , psTutLevel           :: Maybe Int
+        , 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
-        { esGameState::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
+        { esGameState      :: 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
         }
+    | InitState
+        { tutProgress :: TutProgress
+        , initLocks   :: InitLocks
+        }
     | MetaState
-        { curServer :: ServerAddr
-        , undeclareds :: [Undeclared]
+        { 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
+        , 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
+        , listOffsetMax    :: Bool
+        , initiated        :: Bool
         }
 
 type MainStateT = StateT MainState
@@ -140,95 +148,164 @@
 
 ms2im :: MainState -> InputMode
 ms2im mainSt = case mainSt of
-    PlayState {} -> IMPlay
+    PlayState {}   -> IMPlay
     ReplayState {} -> IMReplay
-    EditState {} -> IMEdit
-    MetaState {} -> IMMeta
+    EditState {}   -> IMEdit
+    InitState {}   -> IMInit
+    MetaState {}   -> IMMeta
 
-newPlayState (frame,st) title isTut sub saved = PlayState st frame [] False False [] [] title isTut sub saved Map.empty
+newPlayState (frame,st) title tutLevel sub saved = PlayState st frame [] False False [] [] title tutLevel sub saved Map.empty
 newReplayState st soln title = ReplayState st [] soln [] title Map.empty
 newEditState (frame,st) msoln mpath = EditState st [] [] frame mpath
-    ((\s->(st,s))<$>msoln) (Just (st, isJust msoln)) Nothing (PHS zero) (PHS zero) Map.empty
+    ((st,)<$>msoln) (Just (st, isJust msoln)) Nothing (PHS zero) (PHS zero) Map.empty
+initInitState = do
+    (tut,initLocks) <- readInitProgress
+    return $ InitState tut initLocks
 initMetaState = do
-    flag <- atomically $ newTVar False
-    errtvar <- atomically $ newTVar Nothing
-    invaltvar <- atomically $ newTVar Nothing
-    rnamestvar <- atomically $ newTVar []
-    counttvar <- atomically $ newTVar 0
-    (saddr', auth, path) <- confFilePath "metagame.conf" >>=
-        liftM (fromMaybe (defaultServerAddr, Nothing, "")) . readReadFile
+    flag <- newTVarIO False
+    errtvar <- newTVarIO Nothing
+    invaltvar <- newTVarIO Nothing
+    rnamestvar <- newTVarIO []
+    counttvar <- newTVarIO 0
+    (initiated, saddr', auth, path) <- confFilePath "metagame.conf" >>=
+        fmap (fromMaybe (False, defaultServerAddr, Nothing, "")) . readReadFile
     let saddr = updateDefaultSAddr saddr'
     let names = maybeToList $ authUser <$> auth
-    (undecls,partials,tut) <- readServerSolns saddr
+    (undecls,partials) <- readServerSolns saddr
     mlock <- fullLockPath path >>= readLock
-    return $ MetaState saddr undecls partials tut False auth names flag counttvar errtvar invaltvar rnamestvar Map.empty Map.empty Nothing path mlock 0
+    return $ MetaState saddr undecls partials False auth names flag counttvar errtvar invaltvar rnamestvar Map.empty Map.empty Nothing path mlock 0 True initiated
 
 type PartialSolutions = Map LockSpec SavedPlayState
-type TutProgress = (Int,Maybe SavedPlayState)
 data SavedPlayState = SavedPlayState [PlayerMove] (Map Char [PlayerMove])
     deriving (Eq, Ord, Show, Read)
 
+data TutProgress = TutProgress
+    { tutSolved  :: Bool
+    , tutLevel   :: Int
+    , tutPartial :: Maybe SavedPlayState
+    } deriving (Eq, Ord, Show, Read)
+initTutProgress = TutProgress False 1 Nothing
+
+wrenchOnlyTutLevel, noUndoTutLevel :: Maybe Int -> Bool
+wrenchOnlyTutLevel = (`elem` (Just <$> [1..3]))
+noUndoTutLevel = (`elem` (Just <$> [1..6]))
+
+data InitLock = InitLock
+    { initLockName    :: String
+    , initLockDesc    :: String
+    , initLockLock    :: Lock
+    , initLockSolved  :: Bool
+    , initLockPartial :: Maybe SavedPlayState
+    } deriving (Eq, Ord, Show, Read)
+type InitLocks = Map HexVec InitLock
+
+accessibleInitLocks :: Bool -> InitLocks -> InitLocks
+accessibleInitLocks tutSolved initLocks =
+    Map.filterWithKey (\v _ -> initLockAccessible v) initLocks
+    where
+    initLockAccessible :: HexVec -> Bool
+    initLockAccessible v = or
+        [ (v' == zero && tutSolved) ||
+            (Just True == (initLockSolved <$> Map.lookup v' initLocks))
+        | v' <- (v +^) <$> hexDirs ]
+
+isLastInitLock :: InitLock -> Bool
+isLastInitLock = (== "END") . initLockName
+
 savePlayState :: MainState -> SavedPlayState
 savePlayState ps = SavedPlayState (getMoves ps) $ Map.map getMoves $ psMarks ps
     where getMoves = reverse . map snd . psGameStateMoveStack
 
-restorePlayState :: SavedPlayState -> Lock -> (Maybe String) -> Bool -> Bool -> Bool -> MainState
-restorePlayState (SavedPlayState pms markPMs) (frame,st) title isTut sub saved =
+restorePlayState :: SavedPlayState -> Lock -> Maybe String -> Maybe Int -> Bool -> Bool -> MainState
+restorePlayState (SavedPlayState pms markPMs) (frame,st) title tutLevel 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 }
+            in (newPlayState (frame, st') title tutLevel 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
+readServerSolns :: ServerAddr -> IO ([Undeclared],PartialSolutions)
+readServerSolns saddr = if nullSaddr saddr then return ([],Map.empty) else do
     undecls <- confFilePath ("undeclared" ++ [pathSeparator] ++ saddrPath saddr) >>=
-        liftM (fromMaybe []) . readReadFile
+        fmap (fromMaybe []) . readReadFile
     partials <- confFilePath ("partialSolutions" ++ [pathSeparator] ++ saddrPath saddr) >>=
-        liftM (fromMaybe Map.empty) . readReadFile
-    tut <- confFilePath "tutProgress" >>=
-        liftM (fromMaybe (1,Nothing)) . readReadFile
-    return (undecls,partials,tut)
+        fmap (fromMaybe Map.empty) . readReadFile
+    return (undecls,partials)
 
-writeServerSolns saddr ms@(MetaState { undeclareds=undecls,
-partialSolutions=partials, tutProgress=tut }) = unless (nullSaddr saddr) $ do
+readInitProgress :: IO (TutProgress,InitLocks)
+readInitProgress = do
+    initConfDir <- confFilePath "initiation"
+    initDataDir <- getDataPath "initiation"
+    tut <- fromMaybe initTutProgress <$> readReadFile (initConfDir </> "tutProgress")
+    locknames <- fromMaybe [] <$> readReadFile (initDataDir </> "initiation.map")
+    let namesMap :: Map HexVec Codename
+        namesMap = Map.fromList $
+            [ (rotate (-j) (neg hw) +^ i *^ hu, name)
+            | (j,line) <- zip [0..] locknames
+            , (i,name) <- zip [0..] line ]
+        readInitLock :: String -> IO (Maybe InitLock)
+        readInitLock name = runMaybeT $ do
+            desc <- MaybeT $ listToMaybe <$> readStrings (initDataDir </> name ++ ".text")
+            lock <- (fst <$>) . MaybeT $ readLock (initDataDir </> name ++ ".lock")
+            solved <- lift . (fromMaybe False <$>) . readReadFile $ initConfDir </> name ++ ".solved"
+            partial <- lift . readReadFile $ initConfDir </> name ++ ".partial"
+            return $ InitLock name desc lock solved partial
+    initLocks <- Map.mapMaybe id <$> mapM readInitLock namesMap
+    return (tut,initLocks)
+
+writeServerSolns :: ServerAddr -> MainState -> IO ()
+writeServerSolns saddr MetaState { undeclareds=undecls,
+        partialSolutions=partials } = unless (nullSaddr saddr) $ do
     confFilePath ("undeclared" ++ [pathSeparator] ++ saddrPath saddr) >>= flip writeReadFile undecls
     confFilePath ("partialSolutions" ++ [pathSeparator] ++ saddrPath saddr) >>= flip writeReadFile partials
-    confFilePath ("tutProgress") >>= flip writeReadFile tut
 
 readLock :: FilePath -> IO (Maybe (Lock, Maybe Solution))
 readLock path = runMaybeT $ msum
-        [ (\l->(l,Nothing)) <$> (MaybeT $ readReadFile path)
+        [ (,Nothing) <$> MaybeT (readReadFile path)
         , do
             (mlock,msoln) <- lift $ readAsciiLockFile path
             lock <- liftMaybe mlock
-            return $ (lock,msoln) ]
+            return (lock,msoln) ]
 -- writeLock :: FilePath -> Lock -> IO ()
 -- writeLock path lock = fullLockPath path >>= flip writeReadFile lock
 
-writeMetaState ms@(MetaState { curServer=saddr, curAuth=auth, curLockPath=path }) = do
-    confFilePath "metagame.conf" >>= flip writeReadFile (saddr, auth, path)
+writeInitState :: MainState -> IO ()
+writeInitState InitState { tutProgress = tut, initLocks = initLocks } = do
+    initConfDir <- confFilePath "initiation"
+    writeReadFile (initConfDir </> "tutProgress") tut
+    let writeInitLockInfo :: InitLock -> IO ()
+        writeInitLockInfo (InitLock name _ _ solved partial) = do
+            writeReadFile (initConfDir </> name ++ ".solved") solved
+            writeReadFile (initConfDir </> name ++ ".partial") partial
+    mapM_ writeInitLockInfo initLocks
+writeInitState _ = return ()
+
+writeMetaState :: MainState -> IO ()
+writeMetaState ms@MetaState { curServer=saddr, curAuth=auth, curLockPath=path, initiated=initiated } = do
+    confFilePath "metagame.conf" >>= flip writeReadFile (initiated, saddr, auth, path)
     writeServerSolns saddr ms
+writeMetaState _ = return ()
 
 getTitle :: UIMonad uiM => MainStateT uiM (Maybe String)
-getTitle = ms2im <$> get >>= \im -> case im of
-    IMEdit -> do
+getTitle = get >>= title . ms2im
+    where
+    title 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 "    ")
-    IMPlay -> gets psTitle
-    IMReplay -> gets rsTitle
-    _ -> return Nothing
+    title IMPlay = gets psTitle
+    title IMReplay = gets rsTitle
+    title _ = return Nothing
 
 editStateUnsaved :: UIMonad uiM => MainStateT uiM Bool
 editStateUnsaved = (isNothing <$>) $ runMaybeT $ do
     (sst,tested) <- MaybeT $ gets lastSavedState
-    st <- gets $ esGameState
+    st <- gets esGameState
     guard $ sst == st
     nowTested <- isJust <$> lift getCurTestSoln
     guard $ tested == nowTested
@@ -236,14 +313,14 @@
 getCurTestSoln :: UIMonad uiM => MainStateT uiM (Maybe Solution)
 getCurTestSoln = runMaybeT $ do
     (st',soln) <- MaybeT $ gets esTested
-    st <- gets $ esGameState
+    st <- gets esGameState
     guard $ st == st'
     return soln
 
 mgetOurName :: (UIMonad uiM) => MaybeT (MainStateT uiM) Codename
-mgetOurName = MaybeT $ (authUser <$>) <$> gets curAuth
+mgetOurName = MaybeT $ gets ((authUser <$>) . curAuth)
 mgetCurName :: (UIMonad uiM) => MaybeT (MainStateT uiM) Codename
-mgetCurName = MaybeT $ listToMaybe <$> gets codenameStack
+mgetCurName = MaybeT $ gets (listToMaybe . codenameStack)
 
 getUInfoFetched :: UIMonad uiM => Integer -> Codename -> MainStateT uiM FetchedRecord
 getUInfoFetched staleTime name = do
@@ -252,13 +329,13 @@
         now <- liftIO getCurrentTime
         if floor (diffUTCTime now time) > staleTime
             then set
-            else liftIO $ atomically $ readTVar tvar
+            else liftIO $ readTVarIO 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
+            liftIO $ readTVarIO tvar
 
 mgetUInfo :: UIMonad uiM => Codename -> MaybeT (MainStateT uiM) UserInfo
 mgetUInfo name = do
@@ -278,18 +355,18 @@
 data Codenames = AllCodenames | SomeCodenames [Codename]
 
 invalidateUInfos :: UIMonad uiM => Codenames -> MainStateT uiM ()
-invalidateUInfos AllCodenames = invalidateAllUInfo
+invalidateUInfos AllCodenames          = invalidateAllUInfo
 invalidateUInfos (SomeCodenames names) = mapM_ invalidateUInfo names
 
 
 mgetLock :: UIMonad uiM => LockSpec -> MaybeT (MainStateT uiM) Lock
 mgetLock ls = do
-    tvar <- msum [ MaybeT $ (Map.lookup ls) <$> gets indexedLocks
+    tvar <- msum [ MaybeT $ gets (Map.lookup ls . indexedLocks)
         , 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
+    RCLock lock <- MaybeT $ (fetchedRC<$>) $ liftIO $ readTVarIO tvar
     return $ reframe lock
 
 invalidateAllIndexedLocks :: UIMonad uiM => MainStateT uiM ()
@@ -360,7 +437,7 @@
                 else makeRequest saddr $ ClientRequest protocolVersion auth act
         case resp of
             ServerError err -> atomically $ writeTVar errtvar $ Just err
-            _ -> atomically $ writeTVar invaltvar names
+            _               -> atomically $ writeTVar invaltvar names
         atomically $ writeTVar flag True
         atomically $ modifyTVar count (+(-1))
 
@@ -398,16 +475,16 @@
         Nothing -> lift (drawError "Request aborted") >> return Nothing
         Just fetched ->
             case fetchError fetched of
-                Nothing -> return $ fetchedRC fetched
+                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)
 withImpatience m = do
-    finishedTV <- liftIO $ atomically $ newTVar Nothing
+    finishedTV <- liftIO $ newTVarIO Nothing
     id <- liftIO $ forkIO $ m >>= atomically . writeTVar finishedTV . Just
     let waitImpatiently ticks = do
-            finished <- liftIO $ atomically $ readTVar finishedTV
+            finished <- liftIO $ readTVarIO finishedTV
             if isJust finished
                 then return finished
                 else do
@@ -426,7 +503,7 @@
     uinfo <- mgetUInfo name
     ourUInfo <- mgetUInfo ourName
     let (neg,pos) = (countPoints ourUInfo uinfo, countPoints uinfo ourUInfo)
-    return $ (pos-neg,(pos,neg))
+    return (pos-neg,(pos,neg))
     where
         countPoints mugu masta = length $ filter (maybe False winsPoint) $ getAccessInfo mugu masta
 
@@ -447,14 +524,26 @@
 
 testAuth :: UIMonad uiM => MainStateT uiM ()
 testAuth = isJust <$> gets curAuth >>? do
-    resp <- curServerAction $ Authenticate
+    resp <- curServerAction Authenticate
     case resp of
-        ServerMessage msg -> (lift $ drawMessage $ "Server: " ++ msg)
+        ServerMessage msg -> lift $ drawMessage $ "Server: " ++ msg
         ServerError err -> do
             lift $ drawMessage err
             modify $ \ms -> ms {curAuth = Nothing}
         _ -> return ()
 
+initiationHelpText :: [String]
+initiationHelpText =
+    [ "Suddenly surrounded by hooded figures in your locked room."
+    , "Gently abducted, now wordlessly released into this dingy hole."
+    , ""
+    , "Some disused dungeon, a honeycomb of cells separated by sturdy gates."
+    , "From the far end, light filters through the sequential barriers."
+    , "Freedom?"
+    , "The gate mechanisms are foolishly accessible, merely locked."
+    , "Lucky that they neglected to strip you of your lockpicks."
+    , "Lucky, and odd..." ]
+
 metagameHelpText :: [String]
 metagameHelpText =
     [ "By ruthlessly guarded secret arrangement, the council's agents can pick any lock in the city."
@@ -466,69 +555,70 @@
     , "You may put forward up to three prototype locks. They will guard the secrets you discover."
     , "If you pick a colleague's lock, the rules require that a note is written on your solution."
     , "A note proves that a solution was found, while revealing no more details than necessary."
-    --, "Composing notes is a tricky and ritual-bound art of its own, performed by independent experts."
     , "To declare your solution, you must secure your note behind a lock of your own."
     , "If you are able to unlock a lock, you automatically read all the notes it secures."
-    , "If you read three notes on a lock, you will piece together the secrets of unlocking that lock."
+    , "Reading three notes on a lock suffices to piece together the secrets of unlocking it."
     , ""
     , "The game judges players relative to each of their peers. There are no absolute rankings."
-    , "You win a point of esteem against another player for each of their locks for which either:"
-    , "you have solved the lock and declared a note which the lock's owner has not read, or"
-    , "you have read three notes on the lock."
+    , "You win a point of esteem against another player for one of their locks"
+    , "if you have solved the lock and declared a note which remains unread by the lock's owner,"
+    , "or if you have read three notes by other players on the lock."
     , "You also win a point for each empty lock slot if you can unlock all full slots."
     , "Relative esteem is the points you win minus the points they win; +3 is best, -3 is worst."
     , ""
     , "If the secrets to one of your locks become widely disseminated, you may wish to replace it."
-    , "However: once replaced, a lock is \"retired\", and the notes it secured are read by everyone."
+    , "Once replaced, a lock is \"retired\", and the notes it secured are read by everyone."
     ]
 
-initiationHelpText :: Int -> [String]
-initiationHelpText 1 =
-    [ ""
-    , "So."
+initiationCompleteText :: Int -> [String]
+initiationCompleteText 1 =
+    [ "Emerging from the last of the cells to what you imagined might be freedom,"
+    , "you find yourself in a lamplit room with a hooded figure."
     , ""
-    , "This confirms that you have sufficient manual and mental dexterity to pick simple locks."
-    , "But have you the supple cunning required to improve on their designs? That remains to be seen."
+    , "\"So. You did acquire some skills in your former life. Enough for these toys, at least."
+    , "Whether you have the devious creativity to improve on their designs... remains to be seen."
     , ""
-    , "Nonetheless, we welcome you to our number. As for what it is exactly that you are joining..."
-    , "probably you think you have it all worked out already. Still, allow me to explain."
+    , "\"Nonetheless, we welcome you to our number. As for what exactly it is that you are joining..."
+    , "no doubt you believe you have it all worked out already. Still, allow me to explain.\""
     , ""
-    , "But first: for reasons that will become clear,"
-    , "our members are known exclusively by pseudonyms - by tradition, a triplet of letters or symbols."
-    , "I am eager to hear what codename you will choose for yourself; do be thinking about it."
+    , "After a pause to examine your face, and a soft chuckle, the figure continues."
+    , "\"Ah, you thought this would be the end? No, no, this is very much the beginning.\""
     ]
-initiationHelpText 2 =
-    [ ""
-    , "Now."
-    , ""
-    , "As you fatefully determined, every lock permitted in the city has a fatal hidden flaw."
+initiationCompleteText 2 =
+    [ "\"As you fatefully determined, every lock permitted in the city has a fatal hidden flaw."
     , "Those whose duties require it are entrusted with the secrets required to pick these locks."
-    , "Those who unauthorisedly discover said secrets... come to us."
+    , "As for those who unauthorisedly discover, and even try to profit from, said secrets..."
+    , "you come to us."
     , ""
-    , "Our task is to produce the superficially secure locks necessary for this system:"
+    , "\"Our task, you see, is to produce the superficially secure locks necessary for this system:"
     , "locks pickable with minimal tools, but with this fact obscured by their mechanical complexity."
     , ""
-    , "To push the designs to ever new extremes of intricacy, we run a ritual game."
-    , "You are to be its newest player."
+    , "\"To push the designs to ever new extremes of intricacy, we run a ritual game."
+    , "Today, we welcome you as its newest player."
     ]
-initiationHelpText 3 =
-    [ ""
+initiationCompleteText 3 =
+    [ "\"The idea is simple."
     , "We each design locks, and we each attempt to solve the locks designed by the others."
     , ""
-    , "You may put forward up to three prototype locks."
+    , "\"You may put forward up to three prototype locks."
     , "They will guard the secrets you discover: when you pick a colleague's lock,"
     , "you may declare the fact by placing a note on its solution behind one of your locks."
     , "As long as the owner of the lock you picked is unable to read your note,"
     , "you score a point against them. This is now your aim in life."
     , ""
-    , "If you find a lock too difficult or trivial to pick yourself,"
+    , "\"If you find a lock too difficult or trivial to pick yourself,"
     , "you may find that reading other players' notes on it will lead you to a solution."
     , ""
-    , "The finer details of the rules can wait."
-    , "Go now; choose a codename, explore the locks we have set,"
-    , "and begin your own experiments in the subtle art of lock design."
+    , "\"The finer details of the rules can wait. Your first task is to name yourself."
+    , "For reasons which should be clear, our members are known exclusively by pseudonyms;"
+    , "by tradition, these codenames are triplets of letters or symbols."
+    , ""
+    , "\"Go, choose your codename, have it entered in the registry."
+    , "Then, you should begin work on your first lock."
+    , "With a new initiate always comes the hope of some genuinely new challenge..."
+    , "Perhaps you already have ideas?\""
     ]
-initiationHelpText _ = []
+initiationCompleteText _ = []
 
 
 firstEditHelpText :: [String]
@@ -541,7 +631,7 @@
     , "Place pieces with keyboard or mouse. Springs must be set next to blocks, and arms next to pivots."
     , "Repeatedly placing a piece in the same hex cycles through ways it can relate to its neighbours."
     , ""
-    , "Use Test to prove your lock is solvable, or Play to alternate between testing and editing."
+    , "Use Test to prove that your lock is solvable, or Play to alternate between testing and editing."
     , "When you are done, Write your lock, then Quit from editing and Place your lock in a slot."
     , "You will then be able to Declare locks you solve, and others will attempt to solve your lock."
     , ""
diff --git a/Metagame.hs b/Metagame.hs
--- a/Metagame.hs
+++ b/Metagame.hs
@@ -10,16 +10,16 @@
 
 module Metagame where
 
-import Control.Applicative
-import Data.Array
-import Data.Binary
-import Control.Monad
-import Data.List (delete)
-import Data.Char
-import Data.Maybe
+import           Control.Applicative
+import           Control.Monad
+import           Data.Array
+import           Data.Binary
+import           Data.Char
+import           Data.List           (delete)
+import           Data.Maybe
 
-import GameStateTypes
-import Lock
+import           GameStateTypes
+import           Lock
 
 notesNeeded = 3
 maxLocks = 3
@@ -49,7 +49,7 @@
     deriving (Eq, Ord, Show, Read)
 winsPoint :: AccessedReason -> Bool
 winsPoint (AccessedPrivySolved True) = False
-winsPoint _ = True
+winsPoint _                          = True
 
 getAccessInfo :: UserInfo -> UserInfo -> [Maybe AccessedReason]
 getAccessInfo accessedUInfo accessorUInfo =
@@ -65,9 +65,9 @@
                     if countRead accessorUInfo linfo >= notesNeeded then AccessedPrivyRead
                         else AccessedPrivySolved $ not.null $
                             [ n
-                            | n <- lockSolutions linfo 
+                            | n <- lockSolutions linfo
                             , noteAuthor n == accessor
-                            , noteBehind n == Nothing || n `elem` notesRead accessedUInfo ]))
+                            , isNothing (noteBehind n) || n `elem` notesRead accessedUInfo ]))
         mlinfos
 
 countRead :: UserInfo -> LockInfo -> Int
@@ -115,17 +115,17 @@
 applyDeltas = foldr applyDelta
 
 applyDelta :: UserInfoDelta -> UserInfo -> UserInfo
-applyDelta (AddRead n) info = info { notesRead = n:(notesRead info) }
+applyDelta (AddRead n) info = info { notesRead = n:notesRead info }
 applyDelta (DelRead n) info = info { notesRead = delete n (notesRead info) }
 applyDelta (PutLock ls li) info = info { userLocks = userLocks info // [(li, Just $ initLockInfo ls)] }
 applyDelta (LockDelta li ld) info =
-    info { userLocks = userLocks info // [(li, liftM (applyLockDelta ld) (userLocks info ! li))] }
+    info { userLocks = userLocks info // [(li, fmap (applyLockDelta ld) (userLocks info ! li))] }
 applyLockDelta (SetPubNote n) lockinfo = lockinfo { lockSolutions = map
     (\n' -> if n' == n then n {noteBehind=Nothing} else n') (lockSolutions lockinfo) }
-applyLockDelta (AddSecured n) lockinfo = lockinfo { notesSecured = n:(notesSecured lockinfo) }
+applyLockDelta (AddSecured n) lockinfo = lockinfo { notesSecured = n:notesSecured lockinfo }
 applyLockDelta (DelSecured n) lockinfo = lockinfo { notesSecured = delete n $ notesSecured lockinfo }
-applyLockDelta (AddSolution n) lockinfo = lockinfo { lockSolutions = n:(lockSolutions lockinfo) }
-applyLockDelta (AddAccessed name) lockinfo = lockinfo { accessedBy = name:(delete name $ accessedBy lockinfo) }
+applyLockDelta (AddSolution n) lockinfo = lockinfo { lockSolutions = n:lockSolutions lockinfo }
+applyLockDelta (AddAccessed name) lockinfo = lockinfo { accessedBy = name:delete name (accessedBy lockinfo) }
 applyLockDelta SetPublic lockinfo = lockinfo { public = True, lockSolutions = [], accessedBy = [], notesSecured = []}
 
 instance Binary UserInfo where
@@ -133,9 +133,9 @@
     get = liftM3 UserInfo get get get
 
 instance Binary UserInfoDelta where
-    put (AddRead note) = put (0::Word8) >> put note
-    put (DelRead note) = put (1::Word8) >> put note
-    put (PutLock ls li) = put (2::Word8) >> put ls >> put li
+    put (AddRead note)    = put (0::Word8) >> put note
+    put (DelRead note)    = put (1::Word8) >> put note
+    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
@@ -146,12 +146,12 @@
             3 -> LockDelta <$> get <*> get
 
 instance Binary LockDelta where
-    put (SetPubNote note) = put (0::Word8) >> put note
-    put (AddSecured note) = put (1::Word8) >> put note
-    put (DelSecured note) = put (2::Word8) >> put note
+    put (SetPubNote note)  = put (0::Word8) >> put note
+    put (AddSecured note)  = put (1::Word8) >> put note
+    put (DelSecured note)  = put (2::Word8) >> put note
     put (AddSolution note) = put (3::Word8) >> put note
     put (AddAccessed name) = put (4::Word8) >> put name
-    put SetPublic = put (5::Word8)
+    put SetPublic          = put (5::Word8)
     get = do
         tag <- get :: Get Word8
         case tag of
diff --git a/Mundanities.hs b/Mundanities.hs
--- a/Mundanities.hs
+++ b/Mundanities.hs
@@ -9,36 +9,40 @@
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
 
 module Mundanities where
-import Control.Applicative
-import Control.Arrow
-import Control.Monad
-import qualified Control.Exception as E
-import System.Directory
-import System.Environment (getEnv)
-import System.FilePath
-import Data.Maybe
-import Data.List
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Char8 as BSC
-import Paths_intricacy
+import           Control.Applicative
+import           Control.Arrow
+import           Control.Monad
+import           Control.Monad.Catch    (MonadMask, catch, handle)
+import           Control.Monad.IO.Class (MonadIO)
+import qualified Data.ByteString        as BS
+import qualified Data.ByteString.Char8  as BSC
+import           Data.List
+import           Data.Maybe
+import           Paths_intricacy
+import           System.Directory
+import           System.Environment     (getEnv)
+import           System.FilePath
 
--- | This is "catchIOError" in >=base-4.4, but we reimplement it to support
--- older bases.
 catchIO :: IO a -> (IOError -> IO a) -> IO a
-catchIO = E.catch
+catchIO = catch
 
-catchAll :: IO a -> (E.SomeException -> IO a) -> IO a
-catchAll = E.catch
+ignoreIOErr :: (MonadIO m, MonadMask m, Monoid a) => m a -> m a
+ignoreIOErr = handle ((\_ -> return mempty) :: (Monad m, Monoid a) => IOError -> m a)
 
+ignoreIOErrAlt :: (MonadIO m, MonadMask m, Alternative f) => m (f a) -> m (f a)
+ignoreIOErrAlt = handle ((\_ -> return empty) :: (Monad m, Alternative f) => IOError -> m (f a))
+
+unlessIOErr :: (MonadIO m, MonadMask m) => m Bool -> m Bool
+unlessIOErr = (fromMaybe False <$>) . ignoreIOErrAlt . (Just <$>)
+
 readReadFile :: (Read a) => FilePath -> IO (Maybe a)
-readReadFile file =
-    (tryRead . BSC.unpack <$> BS.readFile file)
-        `catchIO` (const $ return Nothing)
+readReadFile file = ignoreIOErrAlt $ tryRead . BSC.unpack <$> BS.readFile file
+
 tryRead :: (Read a) => String -> Maybe a
 tryRead = (fst <$>) . listToMaybe . reads
 
 readStrings :: FilePath -> IO [String]
-readStrings file = (lines . BSC.unpack) <$> BS.readFile file
+readStrings file = ignoreIOErr $ lines . BSC.unpack <$> BS.readFile file
 
 writeReadFile :: (Show a) => FilePath -> a -> IO ()
 writeReadFile file x = do
@@ -61,21 +65,27 @@
 makeConfDir :: IO ()
 makeConfDir = confFilePath "" >>= createDirectoryIfMissing False
 
+fileExists :: FilePath -> IO Bool
+fileExists = unlessIOErr . doesFileExist
+
 mkdirhierto :: FilePath -> IO ()
 mkdirhierto = mkdirhier . takeDirectory
 
 mkdirhier :: FilePath -> IO ()
-mkdirhier path = do
-    exists <- doesDirectoryExist path
-    unless exists $ mkdirhierto path >> createDirectory path
+mkdirhier = createDirectoryIfMissing True
 
 getDirContentsRec :: FilePath -> IO [FilePath]
-getDirContentsRec path = flip catchIO (const $ return []) $ do
-    contents <- map ((path++[pathSeparator])++) <$> filter ((/='.').head) <$> getDirectoryContents path
+getDirContentsRec path = ignoreIOErr $ do
+    contents <- map ((path++[pathSeparator])++) . filter ((/='.').head) <$> getDirectoryContents path
     annotated <- (\p -> (,) p <$> doesDirectoryExist p) `mapM` contents
     let (dirs,files) = join (***) (map fst) $ partition snd annotated
     (files++) . concat <$> getDirContentsRec `mapM` dirs
 
 fullLockPath path = if isAbsolute path
     then return path
-    else (++(pathSeparator:path)) <$> confFilePath "locks"
+    else do
+        homePath <- getHomeDirectory
+        locksPath <- confFilePath "locks"
+        return $ if take 2 path == "~/"
+            then homePath </> drop 2 path
+            else locksPath </> path
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.8:
+    Add single-player introductory subgame ("initiation").
+    Improve UI variously.
 0.7.2.3:
     Hopefully work around curses build failures
 0.7.2.1:
diff --git a/Physics.hs b/Physics.hs
--- a/Physics.hs
+++ b/Physics.hs
@@ -10,19 +10,19 @@
 
 module Physics where
 
-import qualified Data.Set as Set
-import Data.Set (Set)
-import qualified Data.Vector as Vector
-import Control.Monad.State
-import Control.Monad.Writer
-import Data.Foldable (foldrM)
-import Data.List
-import Data.Vector (Vector, (!), (//))
+import           Control.Monad.State
+import           Control.Monad.Writer
+import           Data.Foldable        (foldrM)
+import           Data.List
+import           Data.Set             (Set)
+import qualified Data.Set             as Set
+import           Data.Vector          (Vector, (!), (//))
+import qualified Data.Vector          as Vector
 
-import Hex
-import Util
-import GameState
-import GameStateTypes
+import           GameState
+import           GameStateTypes
+import           Hex
+import           Util
 
 -- | a list of forces to try in order:
 newtype ForceChoice = ForceChoice {getForceChoice :: [Force]}
@@ -30,14 +30,14 @@
 type ForceChoices = Vector.Vector ForceChoice
 
 forceIdx :: Force -> PieceIdx
-forceIdx force = case force of (Push idx _) -> idx
+forceIdx force = case force of (Push idx _)   -> idx
                                (Torque idx _) -> idx
 
 isPush,isTorque,forceIsNull :: Force -> Bool
 isPush (Push _ _) = True
-isPush _ = False
+isPush _          = False
 isTorque = not . isPush
-forceIsNull (Push _ dir) = dir == zero
+forceIsNull (Push _ dir)   = dir == zero
 forceIsNull (Torque _ dir) = dir == 0
 
 getForcedpp :: GameState -> Force -> PlacedPiece
@@ -51,13 +51,13 @@
 toolForces st pm = Vector.fromList $
     [ ForceChoice (wmom++wmove)
     | (widx, PlacedPiece _ (Wrench mom)) <- epps
-    , let wmom = if mom == zero then [] else [Push widx mom]
+    , let wmom = [Push widx mom | mom /= zero]
     , 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 ]
-        _ -> []
+        HookPush hp   -> [ ForceChoice [Push hidx hp] | hidx <- hidxs ]
+        _             -> []
     where
         epps = enumVec $ placedPieces st
         hidxs = [ hidx | (hidx, PlacedPiece _ (Hook _ _)) <- epps ]
@@ -89,11 +89,11 @@
 setTools pm st =
     let hf = case pm of
             HookTorque dir -> TorqueHF dir
-            HookPush v -> PushHF v
-            _ -> NullHF
+            HookPush v     -> PushHF v
+            _              -> NullHF
     in adjustPieces (\p -> case p of
                 Hook arm _ -> Hook arm hf
-                _ -> p) st
+                _          -> p) st
 
 physicsTick :: PlayerMove -> GameState -> Writer [Alert] GameState
 physicsTick pm st =
@@ -101,7 +101,7 @@
         (efs, dominates) = envForces st
     in do
         st' <- resolveForces tfs Vector.empty (\_ _->False) $ setTools pm st
-        tell $ [AlertIntermediateState st']
+        tell [AlertIntermediateState st']
         resolveForces Vector.empty efs dominates $ setTools NullPM st'
 
 stepPhysics :: GameState -> GameState
@@ -114,11 +114,11 @@
 resolveForces plForces eForces eDominates st =
     let pln = Vector.length plForces
         dominates i j = case map (< pln) [i,j] of
-                [True,False] -> True
+                [True,False]  -> True
                 [False,False] -> eDominates (i-pln) (j-pln)
-                _ -> False
-        initGrps = fmap (propagate st True) plForces Vector.++
-                fmap (propagate st False) eForces
+                _             -> False
+        initGrps = (propagate st True <$> plForces) Vector.++
+                (propagate st False <$> eForces)
         blockInconsistent :: Int -> Int -> StateT (Vector (Writer Any [Force])) (Writer [Alert]) ()
         blockInconsistent i j = do
             grps <- mapM gets [(!i),(!j)]
@@ -154,7 +154,7 @@
             , 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 $ runWriter <$> initGrps ]
 
         -- check for inconsistencies within, and between pairs of, forcegroups
         grps <- sequence [ blockInconsistent i j
@@ -162,7 +162,7 @@
                         , i <= j ]
                     `execStateT` initGrps
 
-        let [blocked, unblocked] = map (nub.concat.(map (fst.runWriter)).Vector.toList) $
+        let [blocked, unblocked] = map (nub.concatMap (fst.runWriter) . Vector.toList) $
                 (\(x,y) -> [x,y]) $ Vector.partition (getAny.snd.runWriter) grps
         tell $ map AlertBlockedForce blocked
         tell $ map AlertAppliedForce unblocked
@@ -170,9 +170,9 @@
         return $ stopBlockedWrenches blocked unblocked $ foldr applyForce st unblocked
 
 resolveSinglePlForce :: Force -> GameState -> Writer [Alert] GameState
-resolveSinglePlForce force st = resolveForces
+resolveSinglePlForce force = resolveForces
     (Vector.singleton (ForceChoice [force])) Vector.empty
-    (\_ _->False) st
+    (\_ _->False)
 
 applyForce :: Force -> GameState -> GameState
 applyForce f s =
@@ -180,13 +180,13 @@
         pp' = applyForceTo (getpp s idx) f
         pp'' = case (placedPiece pp',f) of
                    ( Wrench _ , Push _ dir ) -> pp' {placedPiece = Wrench dir}
-                   _ -> pp'
+                   _                         -> pp'
         in
-        s { placedPieces = (placedPieces s) // [(idx, pp'')] }
+        s { placedPieces = placedPieces s // [(idx, pp'')] }
 
 collisionsWithForce :: GameState -> Force -> PieceIdx -> [HexPos]
 collisionsWithForce st (Push idx dir) idx' =
-    intersect (map (dir+^) $ footprintAtIgnoring st idx idx') (footprintAtIgnoring st idx' idx)
+    map (dir+^) (footprintAtIgnoring st idx idx') `intersect` footprintAtIgnoring st idx' idx
 collisionsWithForce st force idx' =
     collisions (applyForce force st) (forceIdx force) idx'
 
@@ -210,9 +210,9 @@
                      (Block _) -> null springs
                      (Wrench mom) -> case force of
                             Push _ v -> v /= mom
-                            _ -> True
+                            _        -> True
                      (Hook _ hf) -> case force of
-                            Push _ v -> hf /= PushHF v
+                            Push _ v     -> hf /= PushHF v
                             Torque _ dir -> hf /= TorqueHF dir
                      _ -> False
     in fixed
@@ -223,15 +223,15 @@
     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
+                (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
+            Pivot _             -> armPush
             Hook _ (TorqueHF _) -> armPush
-            _ -> (Push idx dir)
+            _                   -> Push idx dir
 
 -- |propagateForce: return forces a force causes via bumps and fully
 -- compressed/extended springs
@@ -270,11 +270,11 @@
 -- forcechoice and the first results in a block due to resistance, try the
 -- next instead.
 propagate :: GameState -> Bool -> ForceChoice -> Writer Any [Force]
-propagate st isPlSource fch = Set.toList `liftM` propagate' isPlSource Set.empty fch where
+propagate st isPlSource fch = Set.toList <$> 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)
+            let (ps', failed) = if pieceResists st f && not isPlForce
                     then (ps, Any True)
                     else runWriter $ foldrM
                             (flip $ propagate' False)
diff --git a/Protocol.hs b/Protocol.hs
--- a/Protocol.hs
+++ b/Protocol.hs
@@ -10,14 +10,14 @@
 
 module Protocol where
 
-import Data.Binary
-import Control.Monad
+import           Control.Monad
+import           Data.Binary
 
-import Crypto.Types.PubKey.RSA (PublicKey)
+import           Crypto.Types.PubKey.RSA (PublicKey)
 
-import BinaryInstances
-import Metagame
-import Lock
+import           BinaryInstances
+import           Lock
+import           Metagame
 
 type ProtocolVersion = Int
 protocolVersion = 1 :: ProtocolVersion
@@ -50,13 +50,13 @@
 type Password = String
 
 needsAuth :: Action -> Bool
-needsAuth GetServerInfo = False
-needsAuth GetPublicKey = False
-needsAuth (GetLock _) = False
-needsAuth (GetUserInfo _ _) = False
-needsAuth (GetRetired _) = False
+needsAuth GetServerInfo      = False
+needsAuth GetPublicKey       = False
+needsAuth (GetLock _)        = False
+needsAuth (GetUserInfo _ _)  = False
+needsAuth (GetRetired _)     = False
 needsAuth (GetRandomNames _) = False
-needsAuth _ = True
+needsAuth _                  = True
 
 data ServerResponse
     = ServerAck
@@ -102,59 +102,59 @@
     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
+            0  -> return Authenticate
+            1  -> return Register
+            2  -> return GetServerInfo
+            3  -> GetLock <$> get
+            4  -> liftM2 GetUserInfo get get
+            5  -> GetHint <$> get
+            6  -> GetSolution <$> get
+            7  -> liftM4 DeclareSolution get get get get
+            8  -> liftM3 SetLock get get get
+            9  -> GetRandomNames <$> get
+            10 -> ResetPassword <$> get
+            11 -> GetRetired <$> get
+            12 -> SetEmail <$> get
             13 -> return GetPublicKey
-            _ -> return UndefinedAction
+            _  -> return UndefinedAction
 
 instance Binary Auth where
     put (Auth name pw) = put name >> put pw
     get = liftM2 Auth get get
 
 instance Binary ServerResponse where
-    put ServerAck = put (0::Word8)
-    put (ServerMessage mesg) = put (1::Word8) >> put mesg
-    put (ServerError err) = put (2::Word8) >> put err
-    put (ServedServerInfo sinfo) = put (3::Word8) >> put sinfo
-    put (ServedLock lock) = put (4::Word8) >> put lock
-    put (ServedUserInfo info) = put (5::Word8) >> put info
+    put ServerAck                   = put (0::Word8)
+    put (ServerMessage mesg)        = put (1::Word8) >> put mesg
+    put (ServerError err)           = put (2::Word8) >> put err
+    put (ServedServerInfo sinfo)    = put (3::Word8) >> put sinfo
+    put (ServedLock lock)           = put (4::Word8) >> put lock
+    put (ServedUserInfo info)       = put (5::Word8) >> put info
     put (ServedUserInfoDeltas info) = put (6::Word8) >> put info
-    put (ServedSolution soln) = put (7::Word8) >> put soln
-    put (ServedHint hint) = put (8::Word8) >> put hint
-    put (ServedRandomNames names) = put (9::Word8) >> put names
-    put (ServerCodenameFree) = put (10::Word8)
-    put (ServerFresh) = put (11::Word8)
-    put (ServedRetired lss) = put (12::Word8) >> put lss
+    put (ServedSolution soln)       = put (7::Word8) >> put soln
+    put (ServedHint hint)           = put (8::Word8) >> put hint
+    put (ServedRandomNames names)   = put (9::Word8) >> put names
+    put ServerCodenameFree          = put (10::Word8)
+    put ServerFresh                 = put (11::Word8)
+    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
+            0  -> return ServerAck
+            1  -> ServerMessage <$> get
+            2  -> ServerError <$> get
+            3  -> ServedServerInfo <$> get
+            4  -> ServedLock <$> get
+            5  -> ServedUserInfo <$> get
+            6  -> ServedUserInfoDeltas <$> get
+            7  -> ServedSolution <$> get
+            8  -> ServedHint <$> get
+            9  -> ServedRandomNames <$> get
             10 -> return ServerCodenameFree
             11 -> return ServerFresh
-            12 -> liftM ServedRetired get
-            13 -> liftM (ServedPublicKey . read) get
-            _ -> return ServerUndefinedResponse
+            12 -> ServedRetired <$> get
+            13 -> ServedPublicKey . read <$> get
+            _  -> return ServerUndefinedResponse
 instance Binary ServerInfo where
     put (ServerInfo sz str) = put sz >> put str
     get = liftM2 ServerInfo get get
diff --git a/README b/README
--- a/README
+++ b/README
@@ -1,48 +1,23 @@
-Intricacy
-=========
+# Intricacy
 A game of competitive puzzle-design.
 
-http://mbays.freeshell.org/intricacy/
-
-
-Playing
-=======
-Press 'T' on the starting screen to play the tutorials, which should lead you
-to discover the main game mechanics. When you've finished or had enough of the
-tutorials, select a codename with 'C' and register it with 'R'. The rest you
-can hopefully figure out, but see below if you'd rather read about it.
-
+https://mbays.sdf.org/intricacy/
 
-Configuration
-=============
+## Configuration
 You can change keybindings in SDL mode by right-clicking on the corresponding
 button and pressing a key.
 
-The buttons in the top right when solving/editing locks in SDL mode are as
-follows:
-    * The three hexes toggles between two modes for colouring pieces; in one
-	mode (three yellow hexes), the colours are determined by the nature of
-	the pieces; in the other mode, adjacent pieces always get different
-	colours.
-    * The lone hex with optional arrow toggles "blockage annotations". These
-	are there to help you figure out what's going on when you can't
-	understand why a piece refuses to move. An orange arrow indicates a
-	blocked force, a purple arrow indicates a force which blocked another
-	force.
-    * The soundwave icon toggles sound.
-    * The narrow hex enscribed within a wide hex toggles between fullscreen
-	and windowed mode. The resolution used when switching to fullscreen 
-	is that of the window prior to fullscreening.
-
-Config files are saved in ~/.intricacy/ on unixoids, or something like
-"...\Application Data\intricacy\" on windows. In particular, the locks you
+Config files are saved in `~/.intricacy/` on unixoids, or something like
+`...\Application Data\intricacy\` on windows. In particular, the locks you
 create in the lock editor are saved in there (and you can organise them into
 directories by including (back)slashs in the lock name). You can edit them in
 a text editor if you want - see AsciiLock.hs for what the characters mean.
 
+If you want to cheat your way past initiation, change "False" to "True" in
+`metagame.conf`.
 
-Rough description of the game mechanics
-=======================================
+
+## Rough description of the game mechanics
 * Locks consist of blocks, pivots and balls. Blocks can be connected to other
     blocks by springs. Pivots have arms. When picking a lock, you control two
     tools - a hook, which acts as a mobile one-armed pivot, and a wrench,
@@ -62,11 +37,10 @@
     against a fixed piece such as a tool, it won't block the other force.
 
 
-Full details of the metagame mechanics
-======================================
+## Full details of the metagame mechanics
 (Where by the 'game' I mean the lock-picking bit, and by the 'metagame' I mean
 the bit with the 3-letter codenames and the three lock slots and notes and so
-on.)
+on. If you haven't seen anything of the kind... keep solving those locks!)
 
 A player accesses a lock slot when one of the following holds
     (i) the player has read three notes on the lock in the slot;
@@ -92,8 +66,7 @@
 in one of your three lock slots. Once the note is placed, it can't be moved.
 
 
-Full details of the game mechanics
-==================================
+## Full details of the game mechanics
 Springs are directed; one of the blocks it is connected to is the 'root', the
 other the 'end'. A block is stationary if it is not the end of any spring. The
 directed graph whose nodes are the blocks and whose edges are the springs is
diff --git a/SDLGlyph.hs b/SDLGlyph.hs
--- a/SDLGlyph.hs
+++ b/SDLGlyph.hs
@@ -10,27 +10,27 @@
 
 module SDLGlyph where
 
-import Graphics.UI.SDL
-import Control.Monad
-import Control.Monad.IO.Class
-import Control.Monad.Trans.State
-import Control.Monad.Trans.Reader
-import Control.Monad.Trans.Maybe
-import Control.Monad.Trans.Class
-import Data.Map (Map)
-import qualified Data.Map as Map
-import qualified Data.List as List
-import Control.Applicative
-import System.Random (randomRIO)
+import           Control.Applicative
+import           Control.Monad
+import           Control.Monad.IO.Class
+import           Control.Monad.Trans.Class
+import           Control.Monad.Trans.Maybe
+import           Control.Monad.Trans.Reader
+import           Control.Monad.Trans.State
+import qualified Data.List                  as List
+import           Data.Map                   (Map)
+import qualified Data.Map                   as Map
+import           Graphics.UI.SDL
+import           System.Random              (randomRIO)
 
-import Hex
-import SDLRender
-import GameState
-import GameStateTypes
-import BoardColouring
-import Physics
-import Command
-import Util
+import           BoardColouring
+import           Command
+import           GameState
+import           GameStateTypes
+import           Hex
+import           Physics
+import           SDLRender
+import           Util
 
 
 data ShowBlocks = ShowBlocksBlocking | ShowBlocksAll | ShowBlocksNone
@@ -50,6 +50,8 @@
     | HollowInnerGlyph Pixel
     | FilledHexGlyph Pixel
     | ButtonGlyph Pixel
+    | PathGlyph HexDir Pixel
+    | GateGlyph HexDir Pixel
     | UseFiveColourButton Bool
     | ShowBlocksButton ShowBlocks
     | ShowButtonTextButton Bool
@@ -137,27 +139,25 @@
             -- 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 (BlockTile adjs) _      -> null adjs
             TileGlyph (SpringTile extn dir) _ -> False
-            SpringGlyph _ _ _ _ _ -> False
-            FilledHexGlyph _ -> False
-            HollowGlyph _ -> False
-            BlockedBlock _ _ _ -> False
-            BlockedPush _ _ -> False
-            CollisionMarker -> False
-            DisplacedGlyph _ _ -> False
-            _ -> True
+            SpringGlyph {}                    -> False
+            FilledHexGlyph _                  -> False
+            HollowGlyph _                     -> False
+            BlockedBlock {}                   -> False
+            BlockedPush _ _                   -> False
+            CollisionMarker                   -> False
+            DisplacedGlyph _ _                -> False
+            _                                 -> True
 
 renderGlyph :: Glyph -> RenderM ()
 renderGlyph (TileGlyph (BlockTile adjs) col) =
     rimmedPolygonR corners col $ bright col
         where
             corners = concat [
-                if or $ map adjAt [0,1]
+                if any adjAt [0,1]
                 then [corner $ hextant dir]
-                else if adjAt $ -1
-                    then []
-                    else [innerCorner dir]
+                else [innerCorner dir | not (adjAt $ -1)]
                 | dir <- hexDirs
                 , let adjAt r = rotate r dir `elem` adjs
                 ]
@@ -180,13 +180,12 @@
         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
-                ]
+            shifts = [(1 / 2) **^ (b -^ a) |
+               let a = innerCorner $ neg mom,
+               rot <- [- 1, 0, 1],
+               let b = innerCorner $ rotate rot $ neg mom]
         in sequence_
-            [ aaLineR (from+^shift) (to+^shift) $ col
+            [ aaLineR (from+^shift) (to+^shift) col
             | shift <- shifts ]
 
 renderGlyph (TileGlyph BallTile col) =
@@ -197,8 +196,8 @@
         where
             n :: Int
             n = 3*case extn of
-                Stretched -> 1
-                Relaxed -> 2
+                Stretched  -> 1
+                Relaxed    -> 2
                 Compressed -> 4
             brightness = dim
             dir' = if dir == zero then hu else dir
@@ -214,7 +213,6 @@
     rimmedCircleR zero (7/8) col $ bright col
     when (dir /= zero)
         $ aaLineR from to $ bright col
-    return ()
         where
             from = rotFVec th c $ (7/8) **^ edge (neg dir)
             to = rotFVec th c $ (7/8) **^ edge dir
@@ -222,12 +220,12 @@
             th = - fi rot * pi / 12
 
 renderGlyph (ArmGlyph rot dir col) =
-    thickLineR from to 1 col
+    thickLineR from to 1 $ bright col
         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'))
+            c = 2 **^ edge (neg dir')
             th = - fi rot * pi / 12
 
 renderGlyph (BlockedArm armdir tdir col) =
@@ -252,7 +250,7 @@
 
 renderGlyph (BlockedPush dir col) = do
     thickLineR zero tip 1 col
-    thickLineR tip (arms!!0) 1 col
+    thickLineR tip (head arms) 1 col
     thickLineR tip (arms!!1) 1 col
     where
         tip@(FVec tx ty) = edge dir
@@ -260,7 +258,7 @@
 
 renderGlyph CollisionMarker = do
     -- rimmedCircle surf centre (size`div`3) (bright purple) $ bright purple
-    aaLineR start end $ col
+    aaLineR start end col
     aaCircleR zero rad col
     where
         [start,end] = map (((1/2)**^) . corner) [0,3]
@@ -281,6 +279,18 @@
 renderGlyph (ButtonGlyph col) =
     renderGlyph (TileGlyph (BlockTile []) col)
 
+renderGlyph (PathGlyph dir col) = do
+    aaLineR from to col
+    where
+    from = edge $ neg dir
+    to = edge dir
+
+renderGlyph (GateGlyph dir col) = do
+    aaLineR from to col
+    where
+    from = corner $ 1 + hextant dir
+    to = corner $ 4 + hextant dir
+
 renderGlyph (UseFiveColourButton using) =
     rescaleRender (1/2) $ sequence_ [
         displaceRender (corner h) $ renderGlyph
@@ -302,10 +312,10 @@
         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
+    sequence_ [ arcR (FVec (-2/3) 0) r (-20) 20
             (if use then bright green else dim red)
         | r <- [1/3,2/3,1] ]
-    when (not use) $
+    unless use $
         aaLineR (innerCorner hw) (innerCorner $ neg hw) $ dim red
 
 renderGlyph (WhsButtonsButton Nothing) = rescaleRender (1/3) $ do
@@ -313,7 +323,7 @@
     sequence_ [ displaceRender ((3/2) **^ edge dir) $
             renderGlyph (ButtonGlyph (dim purple))
         | dir <- hexDirs ]
-renderGlyph (WhsButtonsButton (Just whs)) = rescaleRender (1/2) $ do
+renderGlyph (WhsButtonsButton (Just whs)) = rescaleRender (1/3) $ do
     when (whs /= WHSHook) $
         displaceRender (corner 0) $ renderGlyph (TileGlyph (WrenchTile zero) col)
     when (whs /= WHSWrench) $ do
@@ -326,7 +336,7 @@
     thickPolygonR corners 1 $ activeCol (not fs)
     thickPolygonR corners' 1 $ activeCol fs
     where
-        activeCol True = opaquify $ dim green
+        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 ]
@@ -335,13 +345,13 @@
 renderGlyph (DisplacedGlyph dir glyph) =
     displaceRender (innerCorner dir) $ renderGlyph glyph
 
-renderGlyph (UnfreshGlyph) = do
+renderGlyph UnfreshGlyph = do
     let col = bright red
     renderGlyph (HollowInnerGlyph col)
     sequence_ [pixelR (FVec (i/4) 0) col
         | i <- [-1..1] ]
 
-playerGlyph col = FilledHexGlyph col
+playerGlyph = FilledHexGlyph
 
 cursorGlyph = HollowGlyph $ bright white
 
@@ -351,13 +361,13 @@
 
 drawCursorAt :: Maybe HexPos -> RenderM ()
 drawCursorAt (Just pos) = drawAt cursorGlyph pos
-drawCursorAt _ = return ()
+drawCursorAt _          = return ()
 
 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]
+                [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)
 
@@ -366,8 +376,8 @@
     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
+            _                            -> (pos,[])
+        col = if blocking then bright purple else dim $ colourOf colouring idx
     sequence_ [ drawAt (BlockedArm arm dir col) (arm +^ pos) |
         arm <- arms ]
 drawBlocked st colouring blocking (Push idx dir) = do
@@ -384,7 +394,7 @@
     let (pos,arms) = case getpp st idx of
             PlacedPiece pos (Pivot arms) -> (pos,arms)
             PlacedPiece pos (Hook arm _) -> (pos,[arm])
-            _ -> (pos,[])
+            _                            -> (pos,[])
         col = dim $ colourOf colouring idx
     sequence_ [ drawAt (TurnedArm arm dir col) (arm +^ pos) |
             arm <- arms ]
diff --git a/SDLRender.hs b/SDLRender.hs
--- a/SDLRender.hs
+++ b/SDLRender.hs
@@ -11,25 +11,25 @@
 -- |SDLRender: generic wrapper around sdl-gfx for drawing on hex grids
 module SDLRender where
 
-import Graphics.UI.SDL
-import Graphics.UI.SDL.Primitives
-import qualified Graphics.UI.SDL.TTF as TTF
-import Data.Semigroup as Sem
-import Data.Monoid
-import Control.Monad
-import Control.Monad.IO.Class
-import Control.Monad.Trans.Reader
-import Control.Monad.Trans.Maybe
-import Control.Monad.Trans.Class
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.List (maximumBy)
-import Data.Function (on)
-import GHC.Int (Int16)
-import Control.Applicative
+import           Control.Applicative
+import           Control.Monad
+import           Control.Monad.IO.Class
+import           Control.Monad.Trans.Class
+import           Control.Monad.Trans.Maybe
+import           Control.Monad.Trans.Reader
+import           Data.Function              (on)
+import           Data.List                  (maximumBy)
+import           Data.Map                   (Map)
+import qualified Data.Map                   as Map
+import           Data.Monoid
+import           Data.Semigroup             as Sem
+import           GHC.Int                    (Int16)
+import           Graphics.UI.SDL
+import           Graphics.UI.SDL.Primitives
+import qualified Graphics.UI.SDL.TTF        as TTF
 
-import Hex
-import Util
+import           Hex
+import           Util
 
 -- |SVec: screen vectors, in pixels
 data SVec = SVec { cx, cy :: Int }
@@ -60,15 +60,15 @@
 -- So instead, we define a new operator:
 (**^) :: Float -> FVec -> FVec
 r **^ FVec x y = FVec (r*x) (r*y)
-    
 
+
 hexVec2SVec :: Int -> HexVec -> SVec
 hexVec2SVec size (HexVec x y z) =
     SVec ((x-z) * size) (-y * 3 * ysize size)
 
 hexVec2FVec :: HexVec -> FVec
 hexVec2FVec (HexVec x y z) =
-    FVec (fi $ x-z) (-(fi y) * 3 * ylen)
+    FVec (fi $ x-z) (-fi y * 3 * ylen)
 
 fVec2SVec :: Int -> FVec -> SVec
 fVec2SVec size (FVec x y) = SVec
@@ -93,18 +93,18 @@
             [ (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
+            Map.adjust (\x -> x - sum (Map.elems rounded)) maxdiff rounded
     in HexVec x y z
 
 
 data RenderContext = RenderContext
-    { renderSurf :: Surface
-    , renderBGSurf :: Maybe Surface
+    { renderSurf    :: Surface
+    , renderBGSurf  :: Maybe Surface
     , renderHCentre :: HexPos
     , renderSCentre :: SVec
-    , renderOffset :: FVec
-    , renderSize :: Int
-    , renderFont :: Maybe TTF.Font
+    , renderOffset  :: FVec
+    , renderSize    :: Int
+    , renderFont    :: Maybe TTF.Font
     }
 type RenderT = ReaderT RenderContext
 
@@ -121,11 +121,11 @@
     local $ \rc -> rc { renderOffset = renderOffset rc +^ d }
 
 recentreAt :: Monad m => HexVec -> RenderT m a -> RenderT m a
-recentreAt v m = displaceRender (hexVec2FVec v) m
+recentreAt v = displaceRender (hexVec2FVec v)
 
 rescaleRender :: Monad m => Float -> RenderT m a -> RenderT m a
 rescaleRender r = local $ (\rc -> rc
-        { renderSize = round $ r * (fi $ renderSize rc) } ) . applyOffset
+        { renderSize = round $ r * fi (renderSize rc) } ) . applyOffset
 
 withFont :: Monad m => Maybe TTF.Font -> RenderT m a -> RenderT m a
 withFont font = local $ \rc -> rc { renderFont = font }
@@ -136,7 +136,7 @@
     c <- asks renderSCentre
     off <- asks renderOffset
     let SVec x y = c +^ fVec2SVec size (v +^ off)
-    return $ (fi x, fi y)
+    return (fi x, fi y)
 renderLen :: Monad m => Integral i => Float -> RenderT m i
 renderLen l = do
     size <- asks renderSize
@@ -173,15 +173,14 @@
     void.liftIO $ filledCircle surf x y r col
 
 -- aaPolygon seems to be a bit buggy in sdl-gfx-0.6.0
-aaPolygonR verts col =
-    aaLinesR (verts ++ take 1 verts) col
+aaPolygonR verts = aaLinesR (verts ++ take 1 verts)
 
 -- aaCircle too
 aaCircleR v rad col = do
     (x,y) <- renderPos v
     r <- renderLen rad
     surf <- asks renderSurf
-    if (r <= 1) then void.liftIO $ pixel surf x y col
+    if r <= 1 then void.liftIO $ pixel surf x y col
     else void.liftIO $ aaCircle surf x y r col
 
 
@@ -202,7 +201,7 @@
 thickLineR from to thickness col =
     let FVec dx dy = to -^ from
         baseThickness = (1/16)
-        s = baseThickness * thickness / (sqrt $ dx^2 + dy^2)
+        s = baseThickness * thickness / sqrt (dx^2 + dy^2)
         perp = (s/2) **^ FVec dy (-dx)
     in rimmedPolygonR
         [ from +^ perp, to +^ perp
@@ -213,8 +212,7 @@
     sequence_ [ thickLineR v v' thickness col |
         (v,v') <- zip (take (length verts - 1) verts) (drop 1 verts) ]
 
-thickPolygonR verts thickness col =
-    thickLinesR (verts ++ take 1 verts) thickness col
+thickPolygonR verts = thickLinesR (verts ++ take 1 verts)
 
 
 ylen = 1 / sqrt 3
@@ -286,9 +284,7 @@
 
 colourOf :: Ord i => Map i Int -> i -> Pixel
 colourOf colouring idx =
-    case Map.lookup idx colouring of
-            Nothing -> white
-            Just n -> colourWheel n
+    maybe white colourWheel (Map.lookup idx colouring)
 
 setPixelAlpha alpha (Pixel v) = Pixel $ v `div` 0x100 * 0x100 + alpha
 bright = setPixelAlpha 0xff
@@ -319,20 +315,26 @@
     let (r,g,b,_) = pixelToRGBA p
     in Color (fi r) (fi g) (fi b)
 
-renderStrColAt,renderStrColAtLeft :: (Functor m, MonadIO m) => Pixel -> String -> HexVec -> RenderT m ()
-renderStrColAt = renderStrColAt' True
-renderStrColAtLeft = renderStrColAt' False
-renderStrColAt' :: (Functor m, MonadIO m) => Bool -> Pixel -> String -> HexVec -> RenderT m ()
-renderStrColAt' centred c str v = void $ runMaybeT $ do
+data Alignment = Centred | LeftAligned | ScreenCentred
+renderStrColAt,renderStrColAtLeft,renderStrColAtCentre ::
+    (Functor m, MonadIO m) => Pixel -> String -> HexVec -> RenderT m ()
+renderStrColAt = renderStrColAt' Centred
+renderStrColAtLeft = renderStrColAt' LeftAligned
+renderStrColAtCentre = renderStrColAt' ScreenCentred
+renderStrColAt' :: (Functor m, MonadIO m) => Alignment -> Pixel -> String -> HexVec -> RenderT m ()
+renderStrColAt' align c str v = void $ runMaybeT $ do
     font <- MaybeT $ asks renderFont
     fsurf <- MaybeT $ liftIO $ TTF.tryRenderTextBlended font str $ pixelToColor c
     (surf, scrCentre, off, size) <- lift $ asks $ liftM4 (,,,) renderSurf renderSCentre renderOffset renderSize
     let SVec x y = scrCentre +^ fVec2SVec size (off +^ hexVec2FVec v)
             +^ 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)
+                case align of
+                    Centred -> SVec (surfaceGetWidth fsurf`div`2) 0
+                    _       -> SVec 0 0)
+        x' = case align of
+            ScreenCentred -> cx scrCentre - (surfaceGetWidth fsurf `div` 2)
+            _             -> x
+    void $ liftIO $ blitSurface fsurf Nothing surf (Just $ Rect x' y 0 0)
 
 renderStrColAbove,renderStrColBelow :: (Functor m, MonadIO m) => Pixel -> String -> HexVec -> RenderT m ()
 renderStrColAbove = renderStrColVShifted True
diff --git a/SDLUI.hs b/SDLUI.hs
--- a/SDLUI.hs
+++ b/SDLUI.hs
@@ -8,101 +8,106 @@
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
 
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP           #-}
+{-# LANGUAGE LambdaCase    #-}
+{-# LANGUAGE TupleSections #-}
 
 module SDLUI where
 
-import Graphics.UI.SDL hiding (flip)
-import qualified Graphics.UI.SDL as SDL
-import qualified Graphics.UI.SDL.TTF as TTF
-import Control.Concurrent.STM
-import Control.Applicative
-import qualified Data.Map as Map
-import Data.Map (Map)
-import Data.Maybe
-import Control.Monad.State
-import Control.Monad.Trans.Maybe
-import Control.Monad.Trans.Reader
-import Control.Arrow
-import Data.Word
-import Data.Array
-import Data.List
-import Data.Ratio
-import Data.Function (on)
-import Data.Time.Clock (getCurrentTime)
-import System.FilePath
+import           Control.Applicative
+import           Control.Arrow
+import           Control.Concurrent.STM
+import           Control.Monad              ((<=<))
+import           Control.Monad.State
+import           Control.Monad.Trans.Maybe
+import           Control.Monad.Trans.Reader
+import           Data.Array
+import           Data.Function              (on)
+import           Data.List
+import           Data.Map                   (Map)
+import qualified Data.Map                   as Map
+import           Data.Maybe
+import           Data.Ratio
+import           Data.Time.Clock            (getCurrentTime)
+import           Data.Word
+import           Graphics.UI.SDL            hiding (flip)
+import qualified Graphics.UI.SDL            as SDL
+import qualified Graphics.UI.SDL.TTF        as TTF
+import           System.FilePath
 --import Debug.Trace (traceShow)
 
 #ifdef SOUND
-import Graphics.UI.SDL.Mixer
-import System.Random (randomRIO)
+import           Graphics.UI.SDL.Mixer
+import           System.Random              (randomRIO)
 #endif
 
-import Hex
-import Command
-import GameState (stateBoard)
-import GameStateTypes
-import BoardColouring
-import Lock
-import Physics
-import GameState
-import KeyBindings
-import Mundanities
-import Metagame
-import SDLRender
-import SDLGlyph
-import InputMode
-import Maxlocksize
-import Util
+import           BoardColouring
+import           Command
+import           GameState
+import           GameStateTypes
+import           Hex
+import           InputMode
+import           KeyBindings
+import           Lock
+import           Maxlocksize
+import           Metagame
+import           Mundanities
+import           Physics
+import           SDLGlyph
+import           SDLRender
+import           Util
 
-data UIState = UIState { scrHeight::Int, scrWidth::Int
-    , gsSurface::Maybe Surface
-    , bgSurface::Maybe Surface
-    , cachedGlyphs::CachedGlyphs
-    , lastDrawArgs::Maybe DrawArgs
-    , miniLocks::Map Lock Surface
-    , registeredSelectables::Map HexVec Selectable
-    , contextButtons::[ButtonGroup]
-    , uiOptions::UIOptions
-    , settingBinding::Maybe Command
-    , uiKeyBindings :: Map InputMode KeyBindings
-    , dispFont::Maybe TTF.Font
-    , dispFontSmall::Maybe TTF.Font
-    , lastFrameTicks::Word32
-    , paintTileIndex::Int
-    , leftButtonDown::Maybe HexVec, middleButtonDown::Maybe HexVec, rightButtonDown::Maybe HexVec
-    , mousePos::(HexVec,Bool)
-    , message::Maybe (Pixel, String)
-    , hoverStr :: Maybe String
-    , needHoverUpdate::Bool
-    , dispCentre::HexPos
-    , dispLastCol::PieceColouring
-    , animFrame::Int
-    , nextAnimFrameAt::Maybe Word32
-    , fps::Int
+data UIState = UIState
+    { scrHeight             :: Int
+    , scrWidth              :: Int
+    , gsSurface             :: Maybe Surface
+    , bgSurface             :: Maybe Surface
+    , cachedGlyphs          :: CachedGlyphs
+    , lastDrawArgs          :: Maybe DrawArgs
+    , miniLocks             :: Map Lock Surface
+    , registeredSelectables :: Map HexVec Selectable
+    , contextButtons        :: [ButtonGroup]
+    , uiOptions             :: UIOptions
+    , settingBinding        :: Maybe Command
+    , uiKeyBindings         :: Map InputMode KeyBindings
+    , dispFont              :: Maybe TTF.Font
+    , dispFontSmall         :: Maybe TTF.Font
+    , lastFrameTicks        :: Word32
+    , paintTileIndex        :: Int
+    , leftButtonDown        :: Maybe HexVec
+    , middleButtonDown      :: Maybe HexVec
+    , rightButtonDown       :: Maybe HexVec
+    , mousePos              :: (HexVec,Bool)
+    , message               :: Maybe (Pixel, String)
+    , hoverStr              :: Maybe String
+    , dispCentre            :: HexPos
+    , dispLastCol           :: PieceColouring
+    , animFrame             :: Int
+    , nextAnimFrameAt       :: Maybe Word32
+    , fps                   :: Int
 #ifdef SOUND
-    , sounds::Map String [Chunk]
+    , sounds                :: Map String [Chunk]
 #endif
     }
     deriving (Eq, Ord, Show)
 type UIM = StateT UIState IO
 nullUIState = UIState 0 0 Nothing Nothing emptyCachedGlyphs Nothing Map.empty Map.empty []
     defaultUIOptions Nothing Map.empty Nothing Nothing 0 0 Nothing Nothing Nothing
-    (zero,False) Nothing Nothing False (PHS zero) Map.empty 0 Nothing 50
+    (zero,False) Nothing Nothing (PHS zero) Map.empty 0 Nothing 50
 #ifdef SOUND
     Map.empty
 #endif
 
 data UIOptions = UIOptions
-    { useFiveColouring::Bool
-    , showBlocks::ShowBlocks
-    , whsButtons::Maybe WrHoSel
-    , useBackground::Bool
-    , fullscreen::Bool
-    , showButtonText::Bool
-    , useSounds::Bool
-    , uiAnimTime::Word32
-    , shortUiAnimTime::Word32
+    { useFiveColouring :: Bool
+    , showBlocks       :: ShowBlocks
+    , whsButtons       :: Maybe WrHoSel
+    , useBackground    :: Bool
+    , fullscreen       :: Bool
+    , showButtonText   :: Bool
+    , useSounds        :: Bool
+    , uiAnimTime       :: Word32
+    , shortUiAnimTime  :: Word32
     }
     deriving (Eq, Ord, Show, Read)
 defaultUIOptions = UIOptions False ShowBlocksBlocking Nothing True False True True 100 20
@@ -141,7 +146,7 @@
     modify $ \ds -> ds { lastFrameTicks = now }
 
 
-data Button = Button { buttonPos::HexVec, buttonCmd::Command, buttonHelp::[ButtonHelp] }
+data Button = Button { buttonPos :: HexVec, buttonCmd :: Command, buttonHelp :: [ButtonHelp] }
     deriving (Eq, Ord, Show)
 type ButtonGroup = ([Button],(Int,Int))
 type ButtonHelp = (String, HexVec)
@@ -149,33 +154,28 @@
 singleButton pos cmd col helps = ([Button pos cmd helps], (col,0))
 getButtons :: InputMode -> UIM [ ButtonGroup ]
 getButtons mode = do
-    mwhs <- gets $ whsButtons.uiOptions
+    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 (tl+^neg hw) CmdPlay 2 [("play", hu+^neg hw)]
+            , markButtonGroup
             , 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 ]
+        IMPlay -> whsBGs mwhs mode
+        IMReplay -> [ markButtonGroup ]
         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)]
+            , singleButton (serverPos +^ 2*^neg hv +^ 2*^hw) CmdInitiation 3 [("initi",hu+^neg hw),("ation",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)] ]
@@ -184,31 +184,36 @@
             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)
+                    , ( [ 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) )
+                        | 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) ) ])
+                ([( [ 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) ) | whs /= WHSWrench]) ++
+                ([( [ 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) ) | whs == WHSSelected && mode /= IMEdit])
             tr = periphery 0
             tl = periphery 2
             bl = periphery 3
             br = periphery 5
 
+markButtonGroup = ([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))
+    where
+    tl = periphery 2
+
 data AccessedInfo = AccessedSolved | AccessedPublic | AccessedReadNotes | AccessedUndeclared
     deriving (Eq, Ord, Show)
 data Selectable = SelOurLock
+    | SelTut Bool
+    | SelInitLock HexVec Bool
     | SelLock ActiveLock
     | SelLockUnset Bool ActiveLock
     | SelSelectedCodeName Codename
@@ -234,8 +239,8 @@
 
 registerSelectable :: HexVec -> Int -> Selectable -> UIM ()
 registerSelectable v r s =
-    modify $ \ds -> ds {registeredSelectables = foldr
-        (`Map.insert` s) (registeredSelectables ds) $ map (v+^) $ hexDisc r}
+    modify $ \ds -> ds {registeredSelectables = foldr (
+        (`Map.insert` s) . (v+^)) (registeredSelectables ds) (hexDisc r)}
 registerButtonGroup :: ButtonGroup -> UIM ()
 registerButtonGroup g = modify $ \ds -> ds {contextButtons = g:contextButtons ds}
 registerButton :: HexVec -> Command -> Int -> [ButtonHelp] -> UIM ()
@@ -249,15 +254,17 @@
     unless noUndo $ registerButton (periphery 2+^hu) CmdUndo 0 [("undo",hu+^neg hw)]
     unless noRedo $ registerButton (periphery 2+^hu+^neg hv) CmdRedo 2 [("redo",hu+^neg hw)]
 
-commandOfSelectable IMMeta SelOurLock _ = Just $ CmdEdit
+commandOfSelectable IMInit (SelTut _) _ = Just . CmdSolveInit $ Just zero
+commandOfSelectable IMInit (SelInitLock v _) _ = Just . CmdSolveInit $ Just v
+commandOfSelectable IMMeta SelOurLock _ = Just CmdEdit
 commandOfSelectable IMMeta (SelLock (ActiveLock _ i)) False = Just $ CmdSolve (Just i)
 commandOfSelectable IMMeta (SelLock (ActiveLock _ i)) True = Just $ CmdPlaceLock (Just i)
 commandOfSelectable IMMeta (SelScoreLock Nothing _ (ActiveLock _ i)) False = Just $ CmdSolve (Just i)
 commandOfSelectable IMMeta (SelScoreLock Nothing _ (ActiveLock _ i)) True = Just $ CmdPlaceLock (Just i)
-commandOfSelectable IMMeta (SelScoreLock (Just _) _ _) _ = Just $ CmdHome
+commandOfSelectable IMMeta (SelScoreLock (Just _) _ _) _ = Just CmdHome
 commandOfSelectable IMMeta (SelLockUnset True (ActiveLock _ i)) _ = Just $ CmdPlaceLock (Just i)
 commandOfSelectable IMMeta (SelSelectedCodeName _) False = Just $ CmdSelCodename Nothing
-commandOfSelectable IMMeta (SelSelectedCodeName _) True = Just $ CmdHome
+commandOfSelectable IMMeta (SelSelectedCodeName _) True = Just CmdHome
 commandOfSelectable IMMeta (SelUndeclared undecl) _ = Just $ CmdDeclare $ Just undecl
 commandOfSelectable IMMeta (SelReadNote note) False = Just $ CmdSelCodename $ Just $ noteAuthor note
 commandOfSelectable IMMeta (SelReadNote note) True = Just $ CmdViewSolution $ Just note
@@ -268,7 +275,7 @@
 commandOfSelectable IMMeta (SelSecured note) False = Just $ CmdSelCodename $ Just $ lockOwner $ noteOn note
 commandOfSelectable IMMeta (SelSecured note) True = Just $ CmdViewSolution $ Just note
 commandOfSelectable IMMeta (SelOldLock ls) _ = Just $ CmdPlayLockSpec $ Just ls
-commandOfSelectable IMMeta (SelLockPath) _ = Just $ CmdSelectLock
+commandOfSelectable IMMeta SelLockPath _ = Just CmdSelectLock
 commandOfSelectable IMTextInput (SelLock (ActiveLock _ i)) _ = Just $ CmdInputSelLock i
 commandOfSelectable IMTextInput (SelScoreLock _ _ (ActiveLock _ i)) _ = Just $ CmdInputSelLock i
 commandOfSelectable IMTextInput (SelLockUnset _ (ActiveLock _ i)) _ = Just $ CmdInputSelLock i
@@ -279,13 +286,17 @@
 commandOfSelectable IMTextInput (SelUndeclared undecl) _ = Just $ CmdInputSelUndecl undecl
 commandOfSelectable _ _ _ = Nothing
 
+helpOfSelectable (SelTut False) = Just "Enter tutorials"
+helpOfSelectable (SelTut True) = Just "Revisit tutorials"
+helpOfSelectable (SelInitLock _ False) = Just "Attempt lock"
+helpOfSelectable (SelInitLock _ True) = Just "Revisit solved lock"
 helpOfSelectable SelOurLock = Just
     "Design a lock."
 helpOfSelectable (SelSelectedCodeName name) = Just $
-    "Currently viewing "++name++"."
-helpOfSelectable SelRelScore = Just $
-    "The extent to which you are held in higher esteem than this fellow guild member."
-helpOfSelectable SelRelScoreComponent = Just $
+    "Currently viewing player "++name++"."
+helpOfSelectable SelRelScore = Just
+    "The extent to which you are held in higher esteem than this player."
+helpOfSelectable SelRelScoreComponent = Just
     "Contribution to total relative esteem."
 helpOfSelectable (SelLock (ActiveLock name i)) = Just $
     name++"'s lock "++[lockIndexChar i]++"."
@@ -294,36 +305,36 @@
 helpOfSelectable (SelLockUnset False _) = Just
     "An empty lock slot."
 helpOfSelectable (SelUndeclared _) = Just
-    "Declare yourself able to unlock a lock by securing a note on it behind a lock of your own."
+    "Declare your solution to a lock by securing a note on it behind a lock of your own."
 helpOfSelectable (SelRandom _) = Just
-    "Random set of guild members. Colours show relative esteem, bright red (-3) to bright green (+3)."
+    "Random set of players. Colours show relative esteem, bright red (-3) to bright green (+3)."
 helpOfSelectable (SelScoreLock (Just name) Nothing _) = Just $
-    "Your lock, which "++name++" can not unlock."
+    "Your lock. "++name++" can not not unlock it."
 helpOfSelectable (SelScoreLock (Just name) (Just AccessedPrivyRead) _) = Just $
-    "Your lock, on which "++name++" has read three notes: -1 to relative esteem."
+    "Your lock. "++name++" has read three notes on it: -1 to relative esteem."
 helpOfSelectable (SelScoreLock (Just name) (Just (AccessedPrivySolved False)) _) = Just $
-    "Your lock, on which "++name++" has declared a note which you have not read: -1 to relative esteem."
+    "Your lock. "++name++" has declared a note on it which you have not read: -1 to relative esteem."
 helpOfSelectable (SelScoreLock (Just name) (Just (AccessedPrivySolved True)) _) = Just $
-    "Your lock, on which "++name++" has declared a note which you have, however, read."
-helpOfSelectable (SelScoreLock (Just name) (Just AccessedPub) _) = Just $
-    "Your lock, the secrets of which have been publically revealed: -1 to relative esteem."
+    "Your lock. "++name++" has declared a note on it, but you have read that note."
+helpOfSelectable (SelScoreLock (Just name) (Just AccessedPub) _) = Just
+    "Your lock. Its secrets have been publically revealed: -1 to relative esteem."
 helpOfSelectable (SelScoreLock (Just name) (Just AccessedEmpty) _) = Just $
-    "Your empty lock slot; "++name++" can unlock all your locks: -1 to relative esteem."
+    "Your empty lock slot. "++name++" can unlock all your locks: -1 to relative esteem."
 helpOfSelectable (SelScoreLock Nothing Nothing (ActiveLock name _)) = Just $
-    name++"'s lock, which you can not unlock."
+    name++"'s lock. You can not unlock it."
 helpOfSelectable (SelScoreLock Nothing (Just AccessedPrivyRead) (ActiveLock name _)) = Just $
-    name++"'s lock, on which you have read three notes: +1 to relative esteem."
+    name++"'s lock. You have read three notes on it: +1 to relative esteem."
 helpOfSelectable (SelScoreLock Nothing (Just (AccessedPrivySolved False)) (ActiveLock name _)) = Just $
-    name++"'s lock, on which you have declared a note which "++name++" has not read: +1 to relative esteem."
+    name++"'s lock. You have declared a note on it which "++name++" has not read: +1 to relative esteem."
 helpOfSelectable (SelScoreLock Nothing (Just (AccessedPrivySolved True)) (ActiveLock name _)) = Just $
-    name++"'s lock, on which you have declared a note which "++name++" has, however, read."
+    name++"'s lock. You have declared a note on it, but "++name++" has read your note."
 helpOfSelectable (SelScoreLock Nothing (Just AccessedPub) (ActiveLock name _)) = Just $
-    name++"'s lock, the secrets of which have been publically revealed: +1 to relative esteem."
+    name++"'s lock. Its secrets have been publically revealed: +1 to relative esteem."
 helpOfSelectable (SelScoreLock Nothing (Just AccessedEmpty) (ActiveLock name _)) = Just $
-    name++"'s empty lock slot; you can unlock all "++name++"'s locks: +1 to relative esteem."
+    name++"'s empty lock slot. You can unlock all "++name++"'s locks: +1 to relative esteem."
 helpOfSelectable (SelReadNote note) = Just $
     "You have read "++noteAuthor note++"'s note on this lock."
-helpOfSelectable SelReadNoteSlot = Just $
+helpOfSelectable SelReadNoteSlot = Just
     "Reading three notes on this lock would suffice to reveal its secrets."
 helpOfSelectable (SelSecured note) = let ActiveLock owner idx = noteOn note in
     Just $ "Secured note on "++owner++"'s lock "++[lockIndexChar idx]++"."
@@ -333,8 +344,8 @@
     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."
-helpOfSelectable (SelPublicLock) = Just
-    "Notes behind retired or public locks are public; locks with three public notes are public."
+helpOfSelectable SelPublicLock = Just
+    "Notes behind retired or public locks are public; a lock with three public notes on it is public."
 helpOfSelectable (SelAccessedInfo meth) = Just $ case meth of
     AccessedSolved -> "You picked this lock and declared your solution, so may read any notes it secures."
     AccessedPublic -> "The secrets of this lock have been publically revealed."
@@ -342,18 +353,18 @@
     AccessedReadNotes ->
         "Having read three notes on others' solutions to this lock, you have unravelled its secrets."
 helpOfSelectable (SelOldLock ls) = Just $
-    "Retired lock, #"++show ls++". Any notes which were secured by the lock are now public knowledge."
-helpOfSelectable SelLockPath = Just $
+    "Retired lock #"++show ls++". Any notes which were secured by the lock are now public knowledge."
+helpOfSelectable SelLockPath = Just
     "Select a lock by its name. The names you give your locks are not revealed to others."
-helpOfSelectable SelPrivyHeader = Just $
-    "Fellow guild members able to unlock this lock, hence able to read its secured notes."
-helpOfSelectable SelNotesHeader = Just $
-    "Secured notes. Notes are obfuscated sketches of method, proving success but revealing little."
-helpOfSelectable SelToolWrench = Just $ "The wrench, one of your lockpicking tools. Click and drag to move."
-helpOfSelectable SelToolHook = Just $ "The hook, one of your lockpicking tools. Click and drag to move, use mousewheel to turn."
+helpOfSelectable SelPrivyHeader = Just
+    "Notes on this lock declared by players who picked the lock."
+helpOfSelectable SelNotesHeader = Just
+    "Notes secured by this lock. These notes are read by everyone who can unlock the lock."
+helpOfSelectable SelToolWrench = Just "The wrench, one of your lockpicking tools. Click and drag to move."
+helpOfSelectable SelToolHook = Just "The hook, one of your lockpicking tools. Click and drag to move, use mousewheel to turn."
 
 cmdAtMousePos pos@(mPos,central) im selMode = do
-    buttons <- (concat . map fst) <$> getButtons im
+    buttons <- concatMap fst <$> getButtons im
     sels <- gets registeredSelectables
     return $ listToMaybe $
         [ buttonCmd button
@@ -366,47 +377,46 @@
 
 helpAtMousePos :: (HexVec, Bool) -> InputMode -> UIM (Maybe [Char])
 helpAtMousePos (mPos,_) _ =
-    join . fmap helpOfSelectable . Map.lookup mPos <$> gets registeredSelectables
+    gets $ (helpOfSelectable <=< Map.lookup mPos) . registeredSelectables
 
 
-data UIOptButton a = UIOptButton { getUIOpt::UIOptions->a, setUIOpt::a->UIOptions->UIOptions,
-    uiOptVals::[a], uiOptPos::HexVec, uiOptGlyph::a->Glyph, uiOptDescr::a->String,
-    uiOptModes::[InputMode], onSet :: Maybe (a -> UIM ()) }
+data UIOptButton a = UIOptButton { getUIOpt :: UIOptions->a, setUIOpt :: a->UIOptions->UIOptions,
+    uiOptVals :: [a], uiOptPos :: HexVec, uiOptGlyph :: a->Glyph, uiOptDescr :: a->String,
+    uiOptModes :: [InputMode], onSet :: Maybe (a -> UIM ()) }
 
 -- non-uniform type, so can't use a list...
 uiOB1 = UIOptButton useFiveColouring (\v o -> o {useFiveColouring=v}) [True,False]
-        (periphery 0 +^ 2 *^ hu) UseFiveColourButton
+        (periphery 0 +^ 3 *^ hu +^ neg hv) 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
+        (\case
             ShowBlocksBlocking -> "Blocking forces are annotated"
-            ShowBlocksAll -> "Blocked and blocking forces are annotated"
-            ShowBlocksNone -> "Blockage annotations disabled")
+            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
+        (\case
             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")
+                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
+        (periphery 0 +^ 2 *^ hu +^ 3 *^ hv) ShowButtonTextButton
         (\v -> if v then "Help text enabled" else
         "Help text disabled")
-        [IMPlay, IMEdit, IMReplay, IMMeta] Nothing
+        [IMPlay, IMEdit, IMReplay, IMMeta, IMInit] 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)
+        (\v -> if v then "Fullscreen mode active" else "Windowed mode active")
+        [IMPlay, IMEdit, IMReplay, IMMeta, IMInit] (Just $ const $ initVideo 0 0)
 uiOB6 = UIOptButton useSounds (\v o -> o {useSounds=v}) [True,False]
-        (periphery 0 +^ 3 *^ hu +^ hv) UseSoundsButton
+        (periphery 0 +^ 4 *^ hu +^ hv) UseSoundsButton
         (\v -> if v then "Sound effects enabled" else
         "Sound effects disabled")
         [IMPlay, IMEdit, IMReplay] Nothing
@@ -422,20 +432,20 @@
     drawUIOptionButton mode uiOB6
 #endif
 drawUIOptionButton im b = when (im `elem` uiOptModes b) $ do
-    value <- gets $ (getUIOpt b).uiOptions
+    value <- gets $ getUIOpt b . uiOptions
     renderToMain $ mapM_ (\g -> drawAtRel g (uiOptPos b))
         [HollowGlyph $ obscure purple, uiOptGlyph b value]
 describeUIOptionButton :: UIOptButton a -> MaybeT UIM String
 describeUIOptionButton b = do
-    value <- gets $ (getUIOpt b).uiOptions
+    value <- gets $ getUIOpt b . uiOptions
     return $ uiOptDescr b value
 -- XXX: hand-hacking lenses...
 toggleUIOption (UIOptButton getopt setopt vals _ _ _ _ monSet) = do
-    value <- gets $ getopt.uiOptions
-    let value' = head $ drop (1 + (fromMaybe 0 $ elemIndex value vals)) $ cycle vals
+    value <- gets $ getopt . uiOptions
+    let value' = cycle vals !! max 0 (1 + fromMaybe 0 (elemIndex value vals))
     modifyUIOptions $ setopt value'
     case monSet of
-        Nothing -> return ()
+        Nothing    -> return ()
         Just onSet -> onSet value'
 
 readUIConfigFile :: UIM ()
@@ -444,7 +454,7 @@
     mOpts <- liftIO $ readReadFile path
     case mOpts of
         Just opts -> modify $ \s -> s {uiOptions = opts}
-        Nothing -> return ()
+        Nothing   -> return ()
 writeUIConfigFile :: UIM ()
 writeUIConfigFile = do
     path <- liftIO $ confFilePath "SDLUI.conf"
@@ -458,7 +468,7 @@
     mbdgs <- liftIO $ readReadFile path
     case mbdgs of
         Just bdgs -> modify $ \s -> s {uiKeyBindings = bdgs}
-        Nothing -> return ()
+        Nothing   -> return ()
 writeBindings :: UIM ()
 writeBindings = do
     path <- liftIO $ confFilePath "bindings"
@@ -468,7 +478,7 @@
 
 getBindings :: InputMode -> UIM [(Char, Command)]
 getBindings mode = do
-    uibdgs <- Map.findWithDefault [] mode `liftM` gets uiKeyBindings
+    uibdgs <- gets (Map.findWithDefault [] mode . uiKeyBindings)
     return $ uibdgs ++ bindings mode
 
 paintTiles :: [ Maybe Tile ]
@@ -500,7 +510,7 @@
         do
             let gl = case paintTiles!!i of
                     Nothing -> HollowInnerGlyph $ dim purple
-                    Just t -> TileGlyph t $ dim purple
+                    Just t  -> TileGlyph t $ dim purple
             drawAtRel gl pos
             when selected $ drawAtRel cursorGlyph pos
         | i <- take (length paintTiles) [0..]
@@ -515,21 +525,21 @@
 messageLineCentre = ((maxlocksize+1)`div`2)*^hw +^ ((maxlocksize+1+1)`div`2)*^neg hv
 titlePos = (maxlocksize+1)*^hv +^ ((maxlocksize+1)`div`2)*^hu
 
-screenWidthHexes,screenHeightHexes::Int
+screenWidthHexes,screenHeightHexes :: Int
 screenWidthHexes = 32
-screenHeightHexes = 25
+screenHeightHexes = 26
 getGeom :: UIM (SVec, Int)
 getGeom = do
     h <- gets scrHeight
     w <- gets scrWidth
     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]
+    -- and [2*size*screenWidthHexes < width
+    --        , 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)))]
+    let size = max 2 $ minimum [ (w-1)`div`(2*screenWidthHexes)
+            , floor $ sqrt 3 * (0.5 + fi ((h-1)`div`(3*screenHeightHexes)))]
     return (scrCentre, size)
 
 data DrawArgs = DrawArgs [PieceIdx] Bool [Alert] GameState UIOptions
@@ -551,14 +561,14 @@
 
     lastAnimFrame <- gets animFrame
     now <- liftIO getTicks
-    anim <- maybe False (<now) <$> gets nextAnimFrameAt
+    anim <- gets (maybe False (<now) . nextAnimFrameAt)
     when anim $
         modify $ \ds -> ds { animFrame = lastAnimFrame+1, nextAnimFrameAt = Nothing }
     animFrameToDraw <- gets animFrame
-    void $ if (lastArgs == Just args && lastAnimFrame == animFrameToDraw)
+    void $ if lastArgs == Just args && lastAnimFrame == animFrameToDraw
         then do
             vidSurf <- liftIO getVideoSurface
-            gsSurf <- liftM fromJust $ gets gsSurface
+            gsSurf <- gets (fromJust . gsSurface)
             liftIO $ blitSurface gsSurf Nothing vidSurf Nothing
         else do
             modify $ \ds -> ds { lastDrawArgs = Just args }
@@ -571,9 +581,9 @@
                 splitAlerts frameAs (a:as) =
                     splitAlerts (a:frameAs) as
                 splitAlerts frameAs [] = [(frameAs,st,False)]
-                isGlobalAlert (AlertAppliedForce _) = False
+                isGlobalAlert (AlertAppliedForce _)      = False
                 isGlobalAlert (AlertIntermediateState _) = False
-                isGlobalAlert _ = True
+                isGlobalAlert _                          = True
             let animAlertedStates = nub $
                     let ass = splitAlerts [] transitoryAlerts
                     in if last ass == ([],st,False) then ass else ass ++ [([],st,False)]
@@ -581,10 +591,9 @@
             let (drawAlerts',drawSt,isIntermediate) = animAlertedStates !! animFrameToDraw
             let drawAlerts = drawAlerts' ++ globalAlerts
             -- let drawAlerts = takeWhile (/= AlertIntermediateState drawSt) alerts
-            nextIsSet <- isJust <$> gets nextAnimFrameAt
+            nextIsSet <- gets (isJust . nextAnimFrameAt)
             when (not nextIsSet && frames > animFrameToDraw+1) $ do
-                time <- (if isIntermediate then uiAnimTime else shortUiAnimTime) <$>
-                    gets uiOptions
+                time <- gets ((if isIntermediate then uiAnimTime else shortUiAnimTime) . uiOptions)
                 modify $ \ds -> ds { nextAnimFrameAt = Just $ now + time }
 
             let board = stateBoard drawSt
@@ -594,9 +603,9 @@
                 then boardColouring drawSt coloured lastCol
                 else pieceTypeColouring drawSt coloured
             modify $ \ds -> ds { dispLastCol = colouring }
-            gsSurf <- liftM fromJust $ gets gsSurface
+            gsSurf <- gets (fromJust . gsSurface)
             renderToMainWithSurf gsSurf $ do
-                let tileGlyphs = fmap (ownedTileGlyph colouring highlight) board
+                let tileGlyphs = ownedTileGlyph colouring highlight <$> board
 
                     applyAlert (AlertAppliedForce f@(Torque idx tdir)) =
                         let poss = case getpp drawSt idx of
@@ -635,8 +644,8 @@
                             displaceSpring _ _ = id
 
                             displaceSprings =
-                                (flip (foldr $ displaceSpring True) $ springsRootAtIdx drawSt idx) .
-                                (flip (foldr $ displaceSpring False) $ springsEndAtIdx drawSt idx)
+                                flip (foldr $ displaceSpring True) (springsRootAtIdx drawSt idx) .
+                                flip (foldr $ displaceSpring False) (springsEndAtIdx drawSt idx)
                     applyAlert _ = id
 
                     applyAlerts = flip (foldr applyAlert) drawAlerts
@@ -647,9 +656,9 @@
                     ]
 
                 when (showBlocks uiopts /= ShowBlocksNone) $ sequence_
-                    $ [ drawBlocked drawSt colouring False force
-                        | AlertBlockedForce force <- drawAlerts
-                        , showBlocks uiopts == ShowBlocksAll ]
+                    $ [drawBlocked drawSt colouring False force |
+                   showBlocks uiopts == ShowBlocksAll,
+                   AlertBlockedForce force <- drawAlerts]
                     ++ [ drawBlocked drawSt colouring True force
                         | AlertBlockingForce force <- drawAlerts ]
                     -- ++ [ drawBlocked drawSt colouring True force |
@@ -676,9 +685,11 @@
         alertSound (AlertDivertedWrench _) = Just "wrenchscrape"
         alertSound (AlertAppliedForce (Torque idx _))
             | isPivot.placedPiece.getpp st $ idx = Just "pivot"
+            | isTool.placedPiece.getpp st $ idx = Just "toolmove"
         alertSound (AlertAppliedForce (Push idx dir))
             | isBall.placedPiece.getpp st $ idx = Just "ballmove"
-        alertSound (AlertAppliedForce (Push idx dir)) = do
+            | isTool.placedPiece.getpp st $ idx = Just "toolmove"
+            | otherwise = 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)
@@ -704,13 +715,13 @@
 
 drawMiniLock :: Lock -> HexVec -> UIM ()
 drawMiniLock lock v = do
-    surface <- Map.lookup lock <$> gets miniLocks >>= maybe new return
+    surface <- gets miniLocks >>= maybe new return . Map.lookup lock
     renderToMain $ blitAt surface v
     where
         miniLocksize = 3
         new = do
             (_, size) <- getGeom
-            let minisize = size `div` (ceiling $ lockSize lock % miniLocksize)
+            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
@@ -722,7 +733,7 @@
                     then boardColouring st coloured Map.empty
                     else pieceTypeColouring st coloured
                 draw = sequence_ [ drawAt glyph pos |
-                    (pos,glyph) <- Map.toList $ fmap (ownedTileGlyph colouring []) $ stateBoard st ]
+                    (pos,glyph) <- Map.toList $ ownedTileGlyph colouring [] <$> stateBoard st ]
             liftIO $ runRenderM draw emptyCachedGlyphs $
                 RenderContext surf Nothing (PHS zero) (SVec (width`div`2) (height`div`2)) zero minisize Nothing
             clearOldMiniLocks
@@ -740,7 +751,7 @@
 getBindingStr :: InputMode -> UIM (Command -> String)
 getBindingStr mode = do
     setting <- gets settingBinding
-    uibdgs <- Map.findWithDefault [] mode `liftM` gets uiKeyBindings
+    uibdgs <- gets (Map.findWithDefault [] mode . uiKeyBindings)
     return (\cmd ->
         if Just cmd == setting then "??"
         else maybe "" showKey $ findBinding (uibdgs ++ bindings mode) cmd)
@@ -749,7 +760,7 @@
 drawButtons mode = do
     buttons <- getButtons mode
     bindingStr <- getBindingStr mode
-    showBT <- showButtonText <$> gets uiOptions
+    showBT <- gets (showButtonText . uiOptions)
     smallFont <- gets dispFontSmall
     renderToMain $ sequence_ $ concat [ [ do
                 drawAtRel (ButtonGlyph col) v
@@ -758,7 +769,7 @@
                 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
+            | (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
         ]
@@ -774,16 +785,21 @@
         -- current screen res rather than current window size
         (quitSubSystem [InitVideo] >> initSubSystem [InitVideo] >> initMisc)
 
-    fs <- fullscreen <$> gets uiOptions
+    fs <- gets (fullscreen . uiOptions)
     liftIO $ do
-        (w',h') <- if (fs || (w,h)/=(0,0)) then return (w,h) else do
+        (w',h') <- if fs || (w,h)/=(0,0) then return (w,h) else
+#ifdef APPLE
             -- 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)
+            do
+                (w',h') <- getDimensions
+                return (4*w'`div`5,4*h'`div`5)
+#else
+            getDimensions
+#endif
         setVideoMode w' h' 0 $ if fs then [Fullscreen] else [Resizable]
 
     (w',h') <- liftIO getDimensions
@@ -800,10 +816,10 @@
     smallFont <- liftIO $ TTF.tryOpenFont fontpath (2*size`div`3)
     modify $ \ds -> ds { dispFont = font, dispFontSmall = smallFont }
 
-    useBG <- gets $ useBackground.uiOptions
+    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
+            renderToMainWithSurf bgsurf $ drawBasicBG $ 2*max screenWidthHexes screenHeightHexes`div`3
             return $ Just bgsurf
         else return Nothing
     modify $ \ds -> ds { bgSurface = mbg }
@@ -833,7 +849,7 @@
     liftIO $ allocateChannels 16
     let seqWhileJust (m:ms) = m >>= \ret -> case ret of
             Nothing -> return []
-            Just a -> (a:) <$> seqWhileJust ms
+            Just a  -> (a:) <$> seqWhileJust ms
     soundsdir <- liftIO $ getDataPath "sounds"
     sounds <- sequence [ do
             chunks <- liftIO $ seqWhileJust
@@ -846,12 +862,13 @@
                         "-" ++ (if n < 10 then ('0':) else id) (show n) ++ ext
                         | ext <- [".ogg", ".wav"] ]
                 , let vol = case sound of
-                        "pivot" -> 64
+                        "pivot"        -> 64
                         "wrenchscrape" -> 64
-                        _ -> 128
+                        "toolmove"     -> 64
+                        _              -> 128
                 ]
             return (sound,chunks)
-        | sound <- ["hookblocked","hookarmblocked","wrenchblocked","wrenchscrape","pivot","unlocked","ballmove"]
+        | sound <- ["hookblocked","hookarmblocked","wrenchblocked","wrenchscrape","pivot","unlocked","ballmove","toolmove"]
                 ++ ["spring" ++ d ++ show l | d <- ["extend","contract"], l <- [1..12]] ]
     -- liftIO $ print sounds
     modify $ \s -> s { sounds = Map.fromList sounds }
@@ -869,24 +886,26 @@
 
 drawMsgLine = void.runMaybeT $ do
     (col,str) <- msum
-        [ ((,) dimWhiteCol) <$> MaybeT (gets hoverStr)
-        , MaybeT $ gets message
+        [ MaybeT $ gets message
+        , (dimWhiteCol,) <$> MaybeT (gets hoverStr)
         ]
     lift $ do
         renderToMain $ blankRow messageLineCentre
         smallFont <- gets dispFontSmall
         renderToMain $
             (if length str > screenWidthHexes * 3 then withFont smallFont else id) $
-                renderStrColAt col str messageLineCentre
+                renderStrColAtCentre col str messageLineCentre
 
 setMsgLineNoRefresh col str = do
     modify $ \s -> s { message = Just (col,str) }
-    unless (null str) $ modify $ \s -> s { hoverStr = Nothing }
     drawMsgLine
 setMsgLine col str = setMsgLineNoRefresh col str >> refresh
 
-drawTitle (Just title) = renderToMain $ renderStrColAt messageCol title titlePos
-drawTitle Nothing = return ()
+clearMsg :: UIM ()
+clearMsg = modify $ \s -> s { message = Nothing }
+
+drawTitle (Just title) = renderToMain $ renderStrColAtCentre messageCol title titlePos
+drawTitle Nothing      = return ()
 
 say = setMsgLine messageCol
 sayError = setMsgLine errorCol
diff --git a/SDLUIMInstance.hs b/SDLUIMInstance.hs
--- a/SDLUIMInstance.hs
+++ b/SDLUIMInstance.hs
@@ -8,48 +8,50 @@
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
 
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
+{-# LANGUAGE CPP               #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE FlexibleInstances #-}
 module SDLUIMInstance () where
 
-import Graphics.UI.SDL hiding (flip, name)
-import qualified Graphics.UI.SDL as SDL
-import qualified Graphics.UI.SDL.TTF as TTF
-import Control.Concurrent.STM
-import Control.Applicative
-import System.Timeout
-import qualified Data.Map as Map
-import Data.Map (Map)
-import qualified Data.Vector as Vector
-import Data.Maybe
-import Control.Concurrent (threadDelay)
-import Control.Monad.State
-import Control.Monad.Trans.Maybe
-import Control.Monad.Trans.Reader
-import Data.Word
-import Data.Array
-import Data.List
-import Data.Function (on)
-import Data.Foldable (for_)
+import           Control.Applicative
+import           Control.Concurrent         (threadDelay)
+import           Control.Concurrent.STM
+import           Control.Monad.State
+import           Control.Monad.Trans.Maybe
+import           Control.Monad.Trans.Reader
+import           Data.Array
+import           Data.Foldable              (for_)
+import           Data.Function              (on)
+import           Data.List
+import           Data.Map                   (Map)
+import qualified Data.Map                   as Map
+import           Data.Maybe
+import qualified Data.Vector                as Vector
+import           Data.Word
+import           Graphics.UI.SDL            hiding (flip, name)
+import qualified Graphics.UI.SDL            as SDL
+import qualified Graphics.UI.SDL.TTF        as TTF
+import           Safe                       (maximumBound)
+import           System.Timeout
 --import Debug.Trace (traceShow)
 
-import MainState
-import Hex
-import Command
-import GameStateTypes
-import Lock
-import KeyBindings
-import Mundanities
-import Metagame
-import Protocol
-import Cache
-import Database
-import ServerAddr
-import Util
-import InputMode
-import SDLRender
-import SDLGlyph
-import SDLUI
+import           Cache
+import           Command
+import           Database
+import           GameStateTypes
+import           Hex
+import           InputMode
+import           KeyBindings
+import           Lock
+import           MainState
+import           Metagame
+import           Mundanities
+import           Protocol
+import           SDLGlyph
+import           SDLRender
+import           SDLUI
+import           ServerAddr
+import           Util
 
 instance UIMonad (StateT UIState IO) where
     runUI m = evalStateT m nullUIState
@@ -57,204 +59,20 @@
         lift $ clearButtons >> clearSelectables
         s <- get
         let mode = ms2im s
-        lift $ waitFrame
+        lift waitFrame
         drawMainState' s
         lift . drawTitle =<< getTitle
         lift $ do
             drawButtons mode
             drawUIOptionButtons mode
-            gets needHoverUpdate >>? do
-                updateHoverStr mode
-                modify (\ds -> ds {needHoverUpdate=False})
+            updateHoverStr mode
             drawMsgLine
-            drawShortMouseHelp mode
+            drawShortMouseHelp mode s
             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 { esGameState=st, esGameStateStack=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) ] ]
-
+    clearMessage = clearMsg
     drawMessage = say
     drawPrompt full s = say $ s ++ (if full then "" else "_")
-    endPrompt = say ""
+    endPrompt = clearMsg
     drawError = sayError
 
     reportAlerts = playAlertSounds
@@ -276,12 +94,12 @@
 
     setUIBinding mode cmd ch =
         modify $ \s -> s { uiKeyBindings =
-                Map.insertWith (\[bdg] -> \bdgs -> if bdg `elem` bdgs then delete bdg bdgs else bdg:bdgs)
+                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
+    initUI = (isJust <$>) . runMaybeT $ do
         catchIOErrorMT $ SDL.init
 #ifdef SOUND
             [InitVideo,InitAudio]
@@ -292,21 +110,20 @@
         lift $ do
             readUIConfigFile
             initVideo 0 0
-            liftIO $ initMisc
+            liftIO initMisc
             w <- gets scrWidth
             h <- gets scrHeight
             liftIO $ warpMouse (fi $ w`div`2) (fi $ h`div`2)
-            renderToMain $ erase
+            renderToMain erase
             initAudio
             readBindings
-        )
         where
-            catchIOErrorMT m = MaybeT $ liftIO $ catchIO (m >> return (Just ())) (\_ -> return Nothing)
+            catchIOErrorMT m = MaybeT . liftIO . ignoreIOErrAlt $ m >> return (Just ())
 
     endUI = do
         writeUIConfigFile
         writeBindings
-        liftIO $ quit
+        liftIO quit
 
     unblockInput = return $ pushEvent VideoExpose
     suspend = return ()
@@ -314,13 +131,13 @@
 
     impatience ticks = do
         liftIO $ threadDelay 50000
-        if (ticks>20) then do
+        if ticks>20 then do
                 let pos = serverWaitPos
                 smallFont <- gets dispFontSmall
                 renderToMain $ do
-                    mapM (drawAtRel (FilledHexGlyph $ bright black)) [ pos +^ i*^hu | i <- [0..3] ]
+                    mapM_ (drawAtRel (FilledHexGlyph $ bright black)) [ pos +^ i*^hu | i <- [0..3] ]
                     withFont smallFont $
-                        renderStrColAtLeft errorCol ("waiting..."++replicate ((ticks`div`5)`mod`3) '.') $ pos
+                        renderStrColAtLeft errorCol ("waiting..."++replicate ((ticks`div`5)`mod`3) '.') pos
                 clearButtons
                 registerButton (pos +^ neg hv) CmdQuit 0 [("abort",hu+^neg hw)]
                 drawButtons IMImpatience
@@ -336,17 +153,16 @@
         liftIO $ warpMouse (fi x) (fi y)
         lbp <- gets leftButtonDown
         rbp <- gets rightButtonDown
-        let [lbp',rbp'] = fmap (fmap (\_ -> (pos-^centre))) [lbp,rbp]
+        let [lbp',rbp'] = ((const $ pos -^ centre) <$>) <$> [lbp,rbp]
         modify $ \s -> s {leftButtonDown = lbp', rightButtonDown = rbp'}
 
     getUIMousePos = do
         centre <- gets dispCentre
-        (Just.(+^centre).fst) <$> gets mousePos
+        gets ((Just.(+^centre).fst) . mousePos)
 
     setYNButtons = do
         clearButtons
-        registerButton (periphery 5 +^ hw) (CmdInputChar 'Y') 2 []
-        registerButton (periphery 5 +^ neg hv) (CmdInputChar 'N') 0 []
+        registerButton (periphery 5 +^ hw +^ neg hv) (CmdInputChar 'Y') 2 [("confirm",hu+^neg hw)]
         drawButtons IMTextInput
         refresh
 
@@ -363,14 +179,15 @@
             newUIState <- get
             return (cmds,uistatesMayVisiblyDiffer oldUIState newUIState)
         now <- liftIO getTicks
-        animFrameReady <- maybe False (<now) <$> gets nextAnimFrameAt
-        return $ cmds ++ if uiChanged || animFrameReady then [CmdRefresh] else []
+        animFrameReady <- gets (maybe False (<now) . nextAnimFrameAt)
+        unless (null cmds) clearMsg
+        return $ cmds ++ [CmdRefresh | uiChanged || animFrameReady]
         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)
+                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_
@@ -378,7 +195,7 @@
                     | (pti,pt) <- zip [0..] paintTiles
                     , cmd <- cmds
                     , (isNothing pt && cmd == CmdDelete) ||
-                        (isJust $ do
+                        isJust (do
                             pt' <- pt
                             CmdTile t <- Just cmd
                             guard $ ((==)`on`tileType) t pt') ]
@@ -396,10 +213,10 @@
                         when (ch /= '\ESC') $ setUIBinding mode (fromJust setting) ch
                         return []
                     else do
-                        uibdgs <- Map.findWithDefault [] mode `liftM` gets uiKeyBindings
+                        uibdgs <- gets (Map.findWithDefault [] mode . uiKeyBindings)
                         let mCmd = lookup ch $ uibdgs ++ bindings mode
                         return $ maybeToList mCmd
-            processEvent (MouseMotion {}) = do
+            processEvent MouseMotion {} = do
                 (oldMPos,_) <- gets mousePos
                 (pos@(mPos,_),(sx,sy,sz)) <- getMousePos
                 updateMousePos mode pos
@@ -410,7 +227,7 @@
                     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)]
+                        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
@@ -420,8 +237,8 @@
                         Nothing -> if mPos /= oldMPos
                             then do
                                 pti <- getEffPaintTileIndex
-                                return $ [ CmdMoveTo $ mPos +^ centre ] ++
-                                    (if isJust lbp then [ CmdPaintFromTo (paintTiles!!pti) (oldMPos+^centre) (mPos+^centre) ] else [])
+                                return $ CmdMoveTo (mPos +^ centre) :
+                                    ([CmdPaintFromTo (paintTiles!!pti) (oldMPos+^centre) (mPos+^centre) | isJust lbp])
                             else return []
                     IMPlay -> return $ maybeToList $ msum $ map drag [lbp, rbp]
                     _ -> return []
@@ -434,11 +251,11 @@
             processEvent (MouseButtonDown _ _ ButtonLeft) = do
                 pos@(mPos,central) <- gets mousePos
                 modify $ \s -> s { leftButtonDown = Just mPos }
-                rb <- isJust <$> gets rightButtonDown
+                rb <- gets (isJust . rightButtonDown)
                 mcmd <- cmdAtMousePos pos mode (Just False)
                 let hotspotAction = listToMaybe
                         $ map (\cmd -> return [cmd]) (maybeToList mcmd)
-                        ++ [ (modify $ \s -> s {paintTileIndex = i}) >> return []
+                        ++ [ modify (\s -> s {paintTileIndex = i}) >> return []
                             | i <- take (length paintTiles) [0..]
                             , mPos == paintButtonStart +^ i*^hv ]
                         ++ [ toggleUIOption uiOB1 >> updateHoverStr mode >> return []
@@ -461,10 +278,10 @@
                 else flip fromMaybe hotspotAction $ case mode of
                     IMEdit -> do
                         pti <- getEffPaintTileIndex
-                        return $ [ drawCmd (paintTiles!!pti) False ]
+                        return [ drawCmd (paintTiles!!pti) False ]
                     IMPlay -> do
                         centre <- gets dispCentre
-                        return $ [ CmdManipulateToolAt $ mPos +^ centre ]
+                        return [ CmdManipulateToolAt $ mPos +^ centre ]
                     _ -> return []
             processEvent (MouseButtonUp _ _ ButtonLeft) = do
                 modify $ \s -> s { leftButtonDown = Nothing }
@@ -472,7 +289,7 @@
             processEvent (MouseButtonDown _ _ ButtonRight) = do
                 pos@(mPos,_) <- gets mousePos
                 modify $ \s -> s { rightButtonDown = Just mPos }
-                lb <- isJust <$> gets leftButtonDown
+                lb <- gets (isJust . leftButtonDown)
                 if lb
                 then return [ CmdWait ]
                 else (fromMaybe [] <$>) $ runMaybeT $ msum
@@ -486,17 +303,17 @@
                         return [cmd]
                     , case mode of
                         IMPlay -> return [ CmdClear, CmdWait ]
-                        _ -> return [ CmdClear, CmdSelect ] ]
+                        _      -> return [ CmdClear, CmdSelect ] ]
             processEvent (MouseButtonUp _ _ ButtonRight) = do
                 modify $ \s -> s { rightButtonDown = Nothing }
-                return [ CmdUnselect ]
+                return [ CmdUnselect | mode == IMEdit ]
             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 []
+                rb <- gets (isJust . rightButtonDown)
+                return $ [CmdDelete | rb]
             processEvent (MouseButtonUp _ _ ButtonMiddle) = do
                 modify $ \s -> s { middleButtonDown = Nothing }
                 return []
@@ -509,30 +326,30 @@
             processEvent _ = return []
 
             doWheel dw = do
-                rb <- isJust <$> gets rightButtonDown
-                mb <- isJust <$> gets middleButtonDown
+                rb <- gets (isJust . rightButtonDown)
+                mb <- gets (isJust . 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) }
+                    modify $ \s -> s { paintTileIndex = (paintTileIndex s + dw) `mod` length paintTiles }
                     return []
 
 
-            drawCmd mt True = CmdPaint mt
+            drawCmd mt True        = CmdPaint mt
             drawCmd (Just t) False = CmdTile t
-            drawCmd Nothing _ = CmdDelete
+            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 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) $
+                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
@@ -546,10 +363,7 @@
         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;"]
+            let extraHelpStrs = (["Mouse commands:", "Hover over a button to see keys, right-click to rebind;"]
                         ++ 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;",
@@ -560,8 +374,8 @@
                                 "Scroll wheel to rotate selected piece; scroll wheel while held down to undo/redo."]
                             IMReplay -> ["Scroll wheel for undo/redo."]
                             IMMeta -> ["Left-clicking on something does most obvious thing;"
-                                , "Right-clicking does second-most obvious thing."]]
-                    ++ case mode of
+                                , "Right-clicking does second-most obvious thing."])
+                    : case mode of
                         IMMeta -> [[
                             "Basic game instructions:"
                             , "Choose [C]odename, then [R]egister it;"
@@ -570,45 +384,55 @@
                             , "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
+            when False $ do
+                renderStrColAtCentre cyan "Keybindings:" $ (screenHeightHexes`div`4)*^(hv+^neg hw)
+                let keybindingsHeight = screenHeightHexes - (3 + length extraHelpStrs + sum (map length extraHelpStrs))
+                    bdgWidth = (screenWidthHexes-6) `div` 3
+                    showKeys chs = intercalate "/" (map showKeyFriendly chs)
+                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_ [ renderStrColAtCentre (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)..] ]
+                | ((str,firstLine),y) <- intercalate [("",False)] (map (`zip`
+                (True:repeat False)) extraHelpStrs) `zip`
+                --[(keybindingsHeight+1)..]
+                [((screenHeightHexes - sum (length <$> extraHelpStrs)) `div` 2)..]
+                ]
         refresh
         return True
+    showHelp IMInit HelpPageGame = do
+        renderToMain $ drawBasicHelpPage ("INTRICACY",red) (initiationHelpText,purple)
+        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)
+        renderToMain $ drawBasicHelpPage ("Initiation complete",purple) (initiationCompleteText 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 ""
+    onNewMode mode = clearMsg
 
     withNoBG m = do
         bg <- gets bgSurface
@@ -617,35 +441,251 @@
         isNothing <$> gets bgSurface >>?
             modify (\uiState -> uiState{bgSurface=bg})
 
+drawMainState' :: MainState -> MainStateT UIM ()
+drawMainState' PlayState { psCurrentState=st, psLastAlerts=alerts,
+        wrenchSelected=wsel, psTutLevel=tutLevel, psSolved=solved } = do
+    canUndo <- gets (null . psGameStateMoveStack)
+    canRedo <- gets (null . psUndoneStack)
+    let isTut = isJust tutLevel
+    lift $ do
+        let selTools = [ idx |
+                (idx, PlacedPiece pos p) <- enumVec $ placedPieces st
+                , (wsel && isWrench p) || (not wsel && isHook p) ]
+        drawMainGameState selTools False alerts st
+        lb <- gets (isJust . leftButtonDown)
+        rb <- gets (isJust . leftButtonDown)
+        when isTut $ do
+            centre <- gets dispCentre
+            sequence_
+                [ registerSelectable (pos -^ centre) 0 $
+                   if isWrench p then SelToolWrench else SelToolHook
+                | not $ lb || rb
+                , PlacedPiece pos p <- Vector.toList $ placedPieces st
+                , isTool p]
+        unless (noUndoTutLevel tutLevel) $ do
+            registerUndoButtons canUndo canRedo
+            registerButtonGroup markButtonGroup
+        registerButton (periphery 0) CmdOpen (if solved then 2 else 0) $
+            ("open", hu+^neg hw) : [("Press-->",9*^neg hu) | solved && isTut]
+drawMainState' ReplayState { rsCurrentState=st, rsLastAlerts=alerts } = do
+    canUndo <- gets (null . rsGameStateMoveStack)
+    canRedo <- gets (null . rsMoveStack)
+    lift $ do
+        drawMainGameState [] False alerts st
+        registerUndoButtons canUndo canRedo
+        renderToMain $ drawCursorAt Nothing
+drawMainState' EditState { esGameState=st, esGameStateStack=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_
+        [ unless (any (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' InitState {initLocks=initLocks, tutProgress=TutProgress{tutSolved=tutSolved}} = lift $ do
+    renderToMain (erase >> drawCursorAt Nothing)
+    renderToMain . renderStrColAtCentre white "I N T R I C A C Y" $ 3 *^ (hv +^ neg hw)
+    drawInitLock zero
+    mapM_ drawInitLock $ Map.keys accessible
+    registerButton (tutPos +^ 3 *^ neg hu +^ hv) (CmdSolveInit Nothing) 2
+        [("solve",hu+^neg hw),("lock",hu+^neg hv)]
+    where
+    accessible = accessibleInitLocks tutSolved initLocks
+    tutPos = maximumBound 0 (hx <$> Map.keys accessible) *^ neg hu
+    name v | v == zero = "TUT"
+        | otherwise = maybe "???" initLockName $ Map.lookup v accessible
+    solved v | v == zero = tutSolved
+        | otherwise = Just True == (initLockSolved <$> Map.lookup v accessible)
+    isLast v | v == zero = False
+        | otherwise = Just True == (isLastInitLock <$> Map.lookup v accessible)
+    drawInitLock v = do
+        let pos = tutPos +^ 2 *^ v
+        drawNameCol (name v) pos $ if solved v then brightish green else brightish yellow
+        renderToMain $ sequence_
+            [ (if open then PathGlyph h $ brightish white
+                else GateGlyph h $ (if inbounds then dim else bright) white)
+                `drawAtRel` (pos +^ h)
+            | h <- hexDirs
+            , let v' = v +^ h
+            , let inbounds = abs (hy v') < 2 && hx v' >= 0 && hz v' <= 0
+            , let acc = v' `Map.member` accessible || v' == zero
+            , not acc || h `elem` [hu, neg hw, neg hv]
+            , let open = inbounds && (solved v || solved v') && (acc || (isLast v && h == hu)) ]
+        registerSelectable pos 0 $ if v == zero then SelTut (solved v) else SelInitLock v (solved v)
+drawMainState' MetaState {curServer=saddr, undeclareds=undecls,
+        cacheOnly=cOnly, curAuth=auth, codenameStack=names,
+        randomCodenames=rnamestvar, retiredLocks=mretired, curLockPath=path,
+        curLock=mlock, asyncCount=count} = do
+    modify $ \ms -> ms { listOffsetMax = True }
+    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
 
-drawShortMouseHelp mode = do
+    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 $ readTVarIO 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)
+                (`drawMiniLock` 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 $ unless (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 $ readTVarIO 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 = head accesses !! 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) ] ]
+
+
+drawShortMouseHelp mode s = do
     mwhs <- gets $ whsButtons.uiOptions
-    showBT <- showButtonText <$> gets uiOptions
+    showBT <- gets (showButtonText . uiOptions)
     when (showBT && isNothing mwhs) $ do
-        let helps = shortMouseHelp mode
+        let helps = shortMouseHelp mode s
         smallFont <- gets dispFontSmall
         renderToMain $ withFont smallFont $ sequence_
-            [ renderStrColAtLeft (dim cyan) help
+            [ renderStrColAtLeft (dim white) help
                 (periphery 3 +^ neg hu +^ (2-n)*^hv )
             | (n,help) <- zip [0..] helps ]
     where
-        shortMouseHelp IMPlay =
+        shortMouseHelp IMPlay PlayState { psTutLevel = tutLevel } =
             [ "LMB: select/move tool"
-            , "LMB+drag: move tool"
-            , "Wheel: turn hook"
-            , "RMB: wait a turn"
-            , "RMB+Wheel: undo/redo"
-            ]
-        shortMouseHelp IMEdit =
+            , "LMB+drag: move tool" ] ++
+            [ "Wheel: turn hook"
+            | not $ wrenchOnlyTutLevel tutLevel ] ++
+            [ "RMB+Wheel: undo/redo"
+            | not $ noUndoTutLevel tutLevel ] ++
+            [ "RMB: wait a turn"
+            | isNothing tutLevel ]
+        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 =
+        shortMouseHelp IMReplay _ =
             [ "Wheel: advance/regress time" ]
-        shortMouseHelp _ = []
+        shortMouseHelp _ _ = []
 
 -- waitEvent' : copy of SDL.Events.waitEvent, with the timeout increased
 -- drastically to reduce CPU load when idling.
@@ -655,7 +695,7 @@
                     event <- pollEvent
                     case event of
                       NoEvent -> threadDelay 10000 >> loop
-                      _ -> return event
+                      _       -> return event
 
 getEvents = do
     e <- waitEvent'
@@ -670,7 +710,7 @@
 updateHoverStr :: InputMode -> UIM ()
 updateHoverStr mode = do
     p@(mPos,isCentral) <- gets mousePos
-    showBT <- showButtonText <$> gets uiOptions
+    showBT <- gets (showButtonText . uiOptions)
     hstr <- runMaybeT $ msum
         [ MaybeT ( cmdAtMousePos p mode Nothing ) >>= lift . describeCommandAndKeys
         , guard showBT >> MaybeT (helpAtMousePos p mode)
@@ -691,10 +731,10 @@
     where
         describeCommandAndKeys :: Command -> UIM String
         describeCommandAndKeys cmd = do
-            uibdgs <- Map.findWithDefault [] mode `liftM` gets uiKeyBindings
+            uibdgs <- gets (Map.findWithDefault [] mode . uiKeyBindings)
             return $ describeCommand cmd ++ " ["
-                ++ concat (intersperse ","
-                    (map showKeyFriendly $ findBindings (uibdgs ++ bindings mode) cmd))
+                ++ intercalate ","
+                    (map showKeyFriendly $ findBindings (uibdgs ++ bindings mode) cmd)
                 ++ "]"
 
 
@@ -705,16 +745,17 @@
         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
+                drop (max 0 $ 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 ($)) $
+        (selDraws,allDrawn) = if length draws' > na
+            then (take (na-1) draws' ++ [listButton CmdNextPage], False)
+            else (take na draws', True)
+    unless allDrawn . modify $ \ms -> ms { listOffsetMax = False }
+    mapM_ (uncurry ($)) (
         zip selDraws $ sortBy (compare `on` hexVec2SVec 37) $
             take (length selDraws) $ sortBy
                 (compare `on` (hexLen . (-^centre)))
-                area
+                area)
 
 drawOldLock ls pos = void.runMaybeT $ msum [ do
         lock <- mgetLock ls
@@ -724,12 +765,14 @@
     ]
 
 
-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
+drawName,drawNullName :: Codename -> HexVec -> MainStateT UIM ()
+drawName name pos = nameCol name >>= lift . drawNameCol name pos
+drawNullName name pos = lift . drawNameCol name pos $ invisible white
+
+drawNameCol name pos col = renderToMain $ do
+    drawAtRel (playerGlyph col) pos
+    renderStrColAt buttonTextCol name pos
+
 drawRelScore name pos = do
     col <- nameCol name
     relScore <- getRelScore name
@@ -756,7 +799,7 @@
 drawNameWithCharAndCol name charcol char col pos = do
     size <- fi.snd <$> lift getGeom
     let up = FVec 0 $ 1/2 - ylen
-    let down = FVec 0 $ ylen
+    let down = FVec 0 ylen
     smallFont <- lift $ gets dispFontSmall
     lift.renderToMain $ do
         drawAtRel (playerGlyph col) pos
@@ -768,17 +811,17 @@
 pubColour = colourWheel pubWheelAngle -- ==purple
 accColour = cyan
 nameCol name = do
-    ourName <- (authUser <$>) <$> gets curAuth
+    ourName <- gets ((authUser <$>) . 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
+        0    -> 0x80800000
+        1    -> 0x70a00000
+        2    -> 0x40c00000
+        3    -> 0x00ff0000
         (-1) -> 0xa0700000
         (-2) -> 0xc0400000
         (-3) -> 0xff000000
@@ -788,14 +831,14 @@
     let centre = hw+^neg hv +^ 7*(idx-1)*^hu
     lift $ drawEmptyMiniLock centre
     drawNameWithCharAndCol name white (lockIndexChar idx) (invisible white) centre
-    ourName <- (authUser <$>) <$> gets curAuth
+    ourName <- gets ((authUser <$>) . 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
+    ourName <- gets ((authUser <$>) . curAuth)
     runMaybeT $ msum [
         do
             lock <- mgetLock $ lockSpec lockinfo
@@ -809,23 +852,21 @@
 
     size <- snd <$> lift getGeom
     lift $ do
-        renderToMain $ displaceRender (FVec 1 0) $ renderStrColAt (brightish white) "UNLOCKED BY" $ accessedByPos +^ hv
+        renderToMain $ displaceRender (FVec 1 0) $ renderStrColAt (brightish white) "SOLUTIONS" $ accessedByPos +^ hv
         registerSelectable (accessedByPos +^ hv) 0 SelPrivyHeader
         registerSelectable (accessedByPos +^ hv +^ hu) 0 SelPrivyHeader
     if public lockinfo
     then lift $ do
-        renderToMain $ renderStrColAt pubColour "All" accessedByPos
+        renderToMain $ renderStrColAt pubColour "Public" accessedByPos
         registerSelectable accessedByPos 1 SelPublicLock
     else if null $ accessedBy lockinfo
-        then lift.renderToMain $ renderStrColAt dimWhiteCol "No-one" accessedByPos
+        then lift.renderToMain $ renderStrColAt dimWhiteCol "None" 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) ]
+                $ [ \pos -> lift (registerSelectable pos 0 (SelSolution note)) >> drawNote note pos
+                    | note <- lockSolutions lockinfo ]
 
     undecls <- gets undeclareds
     case if isJust $ guard . (|| public lockinfo) . (`elem` map noteAuthor (lockSolutions lockinfo)) =<< ourName
@@ -844,12 +885,12 @@
             unless (ourName == Just name) $ do
                 let readPos = accessedPos +^ (-3)*^hu
                 lift.renderToMain $ renderStrColAt (if length read == 3 then accColour else dimWhiteCol)
-                    "Read:" $ readPos
+                    "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)))
+                    $ 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
@@ -861,18 +902,17 @@
                 [ 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
+                [ \pos -> lift (registerSelectable pos 0 (SelSecured note)) >> drawActiveLock (noteOn note) pos
                     | note <- notesSecured lockinfo ]
 
 drawBasicHelpPage :: (String,Pixel) -> ([String],Pixel) -> RenderM ()
 drawBasicHelpPage (title,titleCol) (body,bodyCol) = do
     erase
-    let headPos = (screenHeightHexes`div`4)*^(hv+^neg hw)
-    renderStrColAt titleCol title headPos
+    let startPos = hv +^ (length body `div` 4)*^(hv+^neg hw)
+    renderStrColAtCentre titleCol title $ startPos +^ hv +^neg hw
     sequence_
-        [ renderStrColAt bodyCol str $
-            headPos
+        [ renderStrColAtCentre bodyCol str $
+            startPos
               +^ (y`div`2)*^(hw+^neg hv)
               +^ (y`mod`2)*^hw
-        | (y,str) <- zip [1..] body
-        ]
+        | (y,str) <- zip [0..] body ]
diff --git a/Server.hs b/Server.hs
--- a/Server.hs
+++ b/Server.hs
@@ -12,67 +12,69 @@
 
 module Main where
 
-import Network.Fancy
+import           Network.Fancy
 
-import Control.Concurrent (threadDelay,forkIO)
-import Control.Applicative
-import Control.Monad
-import Control.Monad.Trans.State
-import Control.Monad.Trans.Except
-import Control.Monad.Trans.Maybe
-import Control.Monad.Trans.Reader
-import Control.Monad.Trans
-import Control.Monad.IO.Class
-import System.Random
-import Data.Maybe
-import Data.Word
-import Data.Foldable (for_)
-import Data.Time.Clock
-import System.IO
-import System.FilePath
-import System.Directory (renameFile)
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.ByteString.Char8 as CS
-import qualified Data.Binary as B
-import qualified Data.Text as TS
-import qualified Data.Text.Lazy as TL
-import qualified Data.Text.Short as TSh
-import Data.Array
-import Control.Exception
-import System.IO.Error
-import Data.List
-import Data.Function (on)
-import Pipes
-import qualified Pipes.Prelude as P
+import           Control.Applicative
+import           Control.Concurrent         (forkIO, threadDelay)
+import           Control.Exception.Base     (evaluate)
+import           Control.Monad
+import           Control.Monad.Catch
+import           Control.Monad.IO.Class
+import           Control.Monad.Trans
+import           Control.Monad.Trans.Except
+import           Control.Monad.Trans.Maybe
+import           Control.Monad.Trans.Reader
+import           Control.Monad.Trans.State
+import           Data.Array
+import qualified Data.Binary                as B
+import qualified Data.ByteString.Char8      as CS
+import qualified Data.ByteString.Lazy       as BL
+import           Data.Foldable              (for_)
+import           Data.Function              (on)
+import           Data.List
+import           Data.Maybe
+import qualified Data.Text                  as TS
+import qualified Data.Text.Lazy             as TL
+import qualified Data.Text.Short            as TSh
+import           Data.Time.Clock
+import           Data.Word
+import           Pipes
+import qualified Pipes.Prelude              as P
+import           System.Directory           (renameFile)
+import           System.FilePath
+import           System.IO
+import           System.IO.Error
+import           System.Random
 
-import Text.Feed.Import (parseFeedFromFile)
-import Text.Feed.Export (xmlFeed)
-import Text.Feed.Constructor
-import qualified Text.XML as XML
-import Data.Time.Format
-import Data.Time.LocalTime
+import           Data.Time.Format
+import           Data.Time.LocalTime
+import           Text.Feed.Constructor
+import           Text.Feed.Export           (xmlFeed)
+import           Text.Feed.Import           (parseFeedFromFile)
+import qualified Text.XML                   as XML
 
-import Crypto.Types.PubKey.RSA (PublicKey, PrivateKey)
-import Codec.Crypto.RSA (decrypt, generateKeyPair, RSAError)
-import Crypto.Random (newGenIO, SystemRandom)
-import qualified Crypto.Argon2 as A2
+import           Codec.Crypto.RSA           (RSAError, decrypt, generateKeyPair)
+import qualified Crypto.Argon2              as A2
+import           Crypto.Random              (SystemRandom, newGenIO)
+import           Crypto.Types.PubKey.RSA    (PrivateKey, PublicKey)
 
+import           Network.Mail.Mime          (plainPart)
+import qualified Network.Mail.SMTP          as SMTP
 import qualified Text.Email.Validate
-import qualified Network.Mail.SMTP as SMTP
 
-import System.Environment
-import System.Console.GetOpt
-import System.Exit
+import           System.Console.GetOpt
+import           System.Environment
+import           System.Exit
 
-import Protocol
-import Metagame
-import Lock
-import Frame
-import Database
-import AsciiLock
-import Mundanities
-import Maxlocksize
-import Version
+import           AsciiLock
+import           Database
+import           Frame
+import           Lock
+import           Maxlocksize
+import           Metagame
+import           Mundanities
+import           Protocol
+import           Version
 
 defaultPort = 27001 -- 27001 == ('i'<<8) + 'y'
 
@@ -119,7 +121,7 @@
     withDB dbpath $ setDefaultServerInfo locksize >> setKeyPair
     writeFile (lockFilePath dbpath) ""
     logh <- case listToMaybe [ f | LogFile f <- opts ] of
-        Nothing -> return stdout
+        Nothing   -> return stdout
         Just path -> openFile path AppendMode
     streamServer serverSpec{address = IPv4 "" port, threading=Threaded} $ handler dbpath delay logh mfeedPath
     sleepForever
@@ -140,7 +142,7 @@
         putRecord RecSecretKey $ RCSecretKey secretKey
 
 argon2 :: String -> ExceptT String IO String
-argon2 s = either (throwE . show) (return) $
+argon2 s = either (throwE . show) return $
         TSh.unpack <$> A2.hashEncoded hashOptions (CS.pack s) (CS.pack salt)
     where
         salt = "intricacy salt"
@@ -179,9 +181,9 @@
             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
+                        IP n _    -> n
+                        IPv4 n _  -> n
+                        IPv6 n _  -> n
                         Unix path -> path
                     hashedHostname = take 8 $ hash hostname
                 now <- liftIO getCurrentTime
@@ -202,7 +204,7 @@
     ++ (if not $ validLock $ reframe lock then " [INVALID LOCK] " else "\n" ++ unlines (lockToAscii lock))
     ++ "[SOLN]"
 showAction (DeclareSolution soln ls target idx) = "DeclareSolution [SOLN] "
-    ++ (concat $ intersperse " " $ [show ls,show target,show idx])
+    ++ unwords [show ls,show target,show idx]
 showAction act = show act
 showResponse :: ServerResponse -> String
 showResponse (ServedLock lock) = "ServedLock lock:\n" ++ unlines (lockToAscii lock)
@@ -212,20 +214,20 @@
 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
+            Authenticate     -> ReadMode
+            GetServerInfo    -> ReadMode
+            GetPublicKey     -> ReadMode
+            GetLock _        -> ReadMode
+            GetUserInfo _ _  -> ReadMode
+            GetRetired _     -> ReadMode
+            GetSolution _    -> ReadMode
             GetRandomNames _ -> ReadMode
-            _ -> ReadWriteMode
+            _                -> ReadWriteMode
 
     -- check solutions prior to write-locking database:
-    (withDBLock dbpath ReadMode $ runExceptT checkRequest) >>= 
+    withDBLock dbpath ReadMode (runExceptT checkRequest) >>=
         either (return . ServerError) (const $
-        withDBLock dbpath lockMode $ runExceptT handleRequest' >>= 
+        withDBLock dbpath lockMode $ runExceptT handleRequest' >>=
             either (return . ServerError) return)
     where
         checkRequest = do
@@ -251,7 +253,7 @@
                     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!"
+                    when (checkSolved $ reframe lock) $ throwE "Lock not locked!"
                     RCLockHashes hashes <- getRecordErrored RecLockHashes
                             `catchE` const (return (RCLockHashes []))
                     let hashed = hash $ show lock
@@ -327,19 +329,19 @@
                     ls <- erroredDB $ newLockRecord lock
                     let oldLockInfo = userLocks info ! idx
                     execStateT (do
-                            when (isJust $ oldLockInfo) $
+                            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
+                        erroredDB $ putRecord (RecRetiredLocks name) $ RCLockSpecs $ lockSpec oldui:lss
                     doNews $ "New lock " ++ alockStr al ++ "."
                     return ServerAck
                 GetRandomNames n -> do
-                    names <- erroredDB $ listUsers
-                    gen <- erroredIO $ getStdGen
+                    names <- erroredDB listUsers
+                    gen <- erroredIO getStdGen
                     let l = length names
                         namesArray = listArray (0,l-1) names
                         negligible name = do
@@ -360,7 +362,7 @@
         erroredIO c = do
             ret <- liftIO $ catchIO (Right <$> c) (return.Left)
             case ret of
-                Left e -> throwE $ "Server IO error: " ++ show e
+                Left e  -> throwE $ "Server IO error: " ++ show e
                 Right x -> return x
         erroredDB :: DBM a -> ExceptT String IO a
         erroredDB = erroredIO . withDB dbpath
@@ -377,19 +379,19 @@
             RCSolution soln <- getRecordErrored $ RecNote note
             return soln
         getServerInfo = do
-            RCServerInfo sinfo <- getRecordErrored $ RecServerInfo
+            RCServerInfo sinfo <- getRecordErrored RecServerInfo
             return sinfo
         getPublicKey = do
-            RCPublicKey publicKey <- getRecordErrored $ RecPublicKey
+            RCPublicKey publicKey <- getRecordErrored RecPublicKey
             return publicKey
         getRetired name = do
-            RCLockSpecs lss <- fromMaybe (RCLockSpecs []) <$> (erroredDB $ getRecord $ RecRetiredLocks name)
+            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"
+                Nothing       -> throwE "Lock not set"
                 Just lockinfo -> return lockinfo
         checkValidLockIndex idx =
             unless (0<=idx && idx < maxLocks) $ throwE "Bad lock index"
@@ -431,7 +433,7 @@
             when exists $ throwE "Codename taken"
             pw' <- decryptPassword pw >>= argon2
             erroredDB $ putRecord (RecPasswordArgon2 name) (RCPasswordArgon2 pw')
-            erroredDB $ putRecord (RecUserInfo name) (RCUserInfo $ (1,initUserInfo name))
+            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
@@ -444,7 +446,7 @@
             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"
+            unless (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
@@ -463,7 +465,7 @@
             erroredDB $ modifyRecord (RecUserInfoLog name) $
                 \(RCUserInfoDeltas deltas') -> RCUserInfoDeltas $ deltas ++ deltas'
             erroredDB $ modifyRecord (RecUserInfo name) $
-                \(RCUserInfo (v,info)) -> RCUserInfo $
+                \(RCUserInfo (v,info)) -> RCUserInfo
                     (v+length deltas, applyDeltas info deltas)
         declareNote note@(NoteInfo _ _ target) behind@(ActiveLock name idx) = do
             accessLock name target =<< getCurrALock target
@@ -492,16 +494,16 @@
         scrapNote _ = return ()
         unreadNote note@(NoteInfo name (Just al) _) = do
             lock <- getCurrALock al
-            mapM_ (\name' -> addDelta name' (DelRead note)) $ name:(accessedBy lock)
+            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 ] )
+                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
@@ -513,16 +515,16 @@
             lock <- getCurrALock al
             let countPub = fromIntegral $ length $
                     filter (isNothing.noteBehind) $ lockSolutions lock
-            if (countPub == notesNeeded)
+            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
+            applyDeltas info . map snd . filter ((==name).fst) <$> get
         getCurrALock al@(ActiveLock name idx) =
-             (fromJust.(!idx).userLocks) <$> getCurrUserInfo name
+             fromJust.(!idx).userLocks <$> getCurrUserInfo name
         doNews :: String -> ExceptT String IO ()
         doNews news = case mfeedPath of
             Nothing -> return ()
@@ -547,7 +549,7 @@
             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 ++
+                [plainPart $ 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 ." ++
diff --git a/ServerAddr.hs b/ServerAddr.hs
--- a/ServerAddr.hs
+++ b/ServerAddr.hs
@@ -10,9 +10,9 @@
 
 module ServerAddr where
 
-import Data.List
-import Data.Maybe
-import Control.Applicative
+import           Control.Applicative
+import           Data.List
+import           Data.Maybe
 
 data ServerAddr = ServerAddr {hostname::String, port::Int}
     deriving (Eq, Ord, Show, Read)
diff --git a/Setup.hs b/Setup.hs
--- a/Setup.hs
+++ b/Setup.hs
@@ -8,5 +8,5 @@
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
 
-import Distribution.Simple
+import           Distribution.Simple
 main = defaultMain
diff --git a/Util.hs b/Util.hs
--- a/Util.hs
+++ b/Util.hs
@@ -9,10 +9,10 @@
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
 
 module Util where
-import qualified Data.Vector as Vector
-import Data.Vector (Vector)
-import Control.Monad
-import Control.Monad.Trans.Maybe
+import           Control.Monad
+import           Control.Monad.Trans.Maybe
+import           Data.Vector               (Vector)
+import qualified Data.Vector               as Vector
 
 enumVec :: Vector a -> [(Int,a)]
 enumVec = Vector.toList . Vector.indexed
diff --git a/initiation/BAL.lock b/initiation/BAL.lock
new file mode 100644
--- /dev/null
+++ b/initiation/BAL.lock
@@ -0,0 +1,17 @@
+        " " " " " " " " "          
+       "       &   % $ # " " " "   
+      " o - & & } 9   [ # "     "  
+     " /       & # # [ O # "   # " 
+    "           &   %     # # #   "
+   "             & & & &     "   " 
+  " S S S S #       1     \ % " "  
+ "   '     # ]     1   &   o Z "   
+"   o O O #   )   1   & & &   Z "  
+ "     o - O   ) 1     & & & & "   
+  "             % #   & & Z & "    
+ " "       #       #   & & 5 "     
+" * '     '           # & & "      
+ " @ " O o     & & # #   & "       
+  " " " /   & & & &     & "        
+       " & & & & & & & & "         
+        " " " " " " " " "          
diff --git a/initiation/BAL.text b/initiation/BAL.text
new file mode 100644
--- /dev/null
+++ b/initiation/BAL.text
@@ -0,0 +1,1 @@
+Balance and trembling
diff --git a/initiation/CLR.lock b/initiation/CLR.lock
new file mode 100644
--- /dev/null
+++ b/initiation/CLR.lock
@@ -0,0 +1,17 @@
+        & & & & & & & & &          
+       &     " " " " " " & & & &   
+      &     " O O O O O " &     &  
+     &     " " " " " " " " &     & 
+    & S S S S S S S S S S " " " " &
+   & # #                 " # &   & 
+  &       % % % % % % . o - # & &  
+ &   %   % % %   % %           &   
+&   %   % ] % % % %         #   &  
+ &   % %   ] % % %             &   
+  &     % % ] % %             &    
+ & &   \ ' % # % % % % %   % &     
+& * '   o O o - % [     . o &      
+ & @ &   O /   % [         &       
+  & & &   O   % #         &        
+       &   O O       #   &         
+        & & & & & & & & &          
diff --git a/initiation/CLR.text b/initiation/CLR.text
new file mode 100644
--- /dev/null
+++ b/initiation/CLR.text
@@ -0,0 +1,1 @@
+Everything must go!
diff --git a/initiation/CMB.lock b/initiation/CMB.lock
new file mode 100644
--- /dev/null
+++ b/initiation/CMB.lock
@@ -0,0 +1,17 @@
+        " " " " " " " " "          
+       "     #       # # " " " "   
+      "   #   #     # #   "     "  
+     "     #   ]   # #     " %   " 
+    "   #   # % % # # & & & %     "
+   "     #   ]   % #   7   % "   " 
+  "   #   # " " # '   7   % % " "  
+ "     #   ]   " o % %   '   % "   
+"       # % % # '   7 . o     % "  
+ "   #   ]   % o   7         1 "   
+  "   # " " # ' # #         1 "    
+ " "   #   " o   7         # "     
+" * '     % '   7           "      
+ " @ "   % o % %           "       
+  " " " %     7           "        
+       "     7           "         
+        " " " " " " " " "          
diff --git a/initiation/CMB.text b/initiation/CMB.text
new file mode 100644
--- /dev/null
+++ b/initiation/CMB.text
@@ -0,0 +1,1 @@
+Combination lock
diff --git a/initiation/COG.lock b/initiation/COG.lock
new file mode 100644
--- /dev/null
+++ b/initiation/COG.lock
@@ -0,0 +1,17 @@
+        " " " " " " " " "          
+       " # # # # [ # # # " " " "   
+      " # # # # [ # S S % "     "  
+     " # # # # [       % % "     " 
+    " # # # # [           % % %   "
+   " #   \   % % % %     %   "   " 
+  "       o - ' % [     . o   " "  
+ "   # # / . o   [ # #     `   "   
+"   # # # # \ ` # # [     . o   "  
+ "   # #   ' o - ' [         ` "   
+  "     . o / . o %       #   "    
+ " "       ` #   ` %     #   "     
+" * '     # # # % % % % #   "      
+ " @ "   # # #   % # # #   "       
+  " " "   # # % % # # #   "        
+       "                 "         
+        " " " " " " " " "          
diff --git a/initiation/COG.text b/initiation/COG.text
new file mode 100644
--- /dev/null
+++ b/initiation/COG.text
@@ -0,0 +1,1 @@
+Cogs
diff --git a/initiation/DIV.lock b/initiation/DIV.lock
new file mode 100644
--- /dev/null
+++ b/initiation/DIV.lock
@@ -0,0 +1,17 @@
+        " " " " " " " " "          
+       "                 " " " "   
+      "   # S S S S S %   "     "  
+     "     O   "       %   "     " 
+    " S S & & & o -   % % % % % % "
+   "   & &   #   #           "   " 
+  "         # #   # #   # # # " "  
+ "         #   #             # "   
+"               # # #   # # # # "  
+ "             # #             "   
+  "             #         O   "    
+ " "   #     %   # #   # # # "     
+" * '     % % %           # "      
+ " @ "   O % } % % % o   # "       
+  " " " % O % "     /   # "        
+       " %     O       # "         
+        " " " " " " " " "          
diff --git a/initiation/DIV.text b/initiation/DIV.text
new file mode 100644
--- /dev/null
+++ b/initiation/DIV.text
@@ -0,0 +1,1 @@
+Division of labour
diff --git a/initiation/END.lock b/initiation/END.lock
new file mode 100644
--- /dev/null
+++ b/initiation/END.lock
@@ -0,0 +1,17 @@
+        " " " " " " " " "          
+       " #   o -   o - & " " " "   
+      " # \ / . o /     & "     "  
+     " {   o - O ` " s s & "     " 
+    " & & ' O %   "   o \ & & &   "
+   " ' . o O   O O O O ` o   "   " 
+  " o " O `   %   ' % $ # `   " "  
+ "   ` "   # 9 . o   % % % D & "   
+" ]     " { #     # D & & \ &   "  
+ " ]     "       % $ &     o   "   
+  " & & # D D D "           ` "    
+ " "   & " " " "         o O "     
+" * ' &   " c c c c %   / O "      
+ " @ " & " &   % % %       "       
+  " " " & &   % c c c c # "        
+       "                 "         
+        " " " " " " " " "          
diff --git a/initiation/END.text b/initiation/END.text
new file mode 100644
--- /dev/null
+++ b/initiation/END.text
@@ -0,0 +1,1 @@
+The final challenge
diff --git a/initiation/GAP.lock b/initiation/GAP.lock
new file mode 100644
--- /dev/null
+++ b/initiation/GAP.lock
@@ -0,0 +1,17 @@
+        & & & & & & & & &          
+       &                 & & & &   
+      &             % %   &     &  
+     & # C C C C % %   %   & #   & 
+    &                 % # # #     &
+   &                 %   7   &   & 
+  & $ $ S S S " O O %   7     & &  
+ &             #   " % %       &   
+& $ S S S S S %   " C C C C C D &  
+ &         # %   % O           &   
+  &             % Z           &    
+ & &           %   Z         &     
+& * '             # #       &      
+ & @ &         # #         &       
+  & & &                   &        
+       &                 &         
+        & & & & & & & & &          
diff --git a/initiation/GAP.text b/initiation/GAP.text
new file mode 100644
--- /dev/null
+++ b/initiation/GAP.text
@@ -0,0 +1,1 @@
+The jaws that snap...
diff --git a/initiation/HLD.lock b/initiation/HLD.lock
new file mode 100644
--- /dev/null
+++ b/initiation/HLD.lock
@@ -0,0 +1,17 @@
+        " " " " " " " " "          
+       " ~ ~ S S S s s # " " " "   
+      " \   ~   &       # "     "  
+     "   o &     & . o - # "     " 
+    "     ` Z     " #     # # #   "
+   " %   # # Z   " [     #   "   " 
+  " %   #   # Z " [ "   #     " "  
+ " %       O # Z " "       # # "   
+" % O       O # " S S S S %   # "  
+ " %         #   # # # # . o - "   
+  " %       #   # O O   #     "    
+ " " \         #       #     "     
+" * ' o     #             % "      
+ " @ " %   7             % "       
+  " " " % 7           O % "        
+       " % % % % % % % % "         
+        " " " " " " " " "          
diff --git a/initiation/HLD.text b/initiation/HLD.text
new file mode 100644
--- /dev/null
+++ b/initiation/HLD.text
@@ -0,0 +1,1 @@
+HOLD BALL
diff --git a/initiation/ICE.lock b/initiation/ICE.lock
new file mode 100644
--- /dev/null
+++ b/initiation/ICE.lock
@@ -0,0 +1,17 @@
+        " " " " " " " " "          
+       "             [   " " " "   
+      "   # . o O   [     "     "  
+     "             [       "     " 
+    "             [ # S S % % %   "
+   "   # % % % % %       %   "   " 
+  "   # % # # # # S S S S & & " "  
+ "             #       & &     "   
+"       &                       "  
+ "     &   # # #     "   # \ # "   
+  "   &   # \     " " "     o "    
+ " "   & & & o   " " "       "     
+" * '     &   ` " 9 " . o - "      
+ " @ " & & O " " 9 " " O # "       
+  " " "       # # #       "        
+       "       #         "         
+        " " " " " " " " "          
diff --git a/initiation/ICE.text b/initiation/ICE.text
new file mode 100644
--- /dev/null
+++ b/initiation/ICE.text
@@ -0,0 +1,1 @@
+Obligatory slippy-slidey ice world
diff --git a/initiation/ONE.lock b/initiation/ONE.lock
new file mode 100644
--- /dev/null
+++ b/initiation/ONE.lock
@@ -0,0 +1,17 @@
+        % % % % % % % % %          
+       %                 % % % %   
+      % S S S S S S S S " %     %  
+     % # # #           " " %     % 
+    %       o       \ "   " $ $ # %
+   %       / . o     o -     %   % 
+  % #   % # # # . o - . o -   % %  
+ %                     %     # %   
+% " " % C C "         %     [ # %  
+ %         O %       %     [   %   
+  %           # # # # \   %   %    
+ % %   o -     #       o . o %     
+% * '   . o # # o     " ` # %      
+ % @ % #   #   / `   " C C %       
+  % % % #   % C C C C "   %        
+       % #     #         %         
+        % % % % % % % % %          
diff --git a/initiation/ONE.text b/initiation/ONE.text
new file mode 100644
--- /dev/null
+++ b/initiation/ONE.text
@@ -0,0 +1,1 @@
+One ball to block them all
diff --git a/initiation/PLG.lock b/initiation/PLG.lock
new file mode 100644
--- /dev/null
+++ b/initiation/PLG.lock
@@ -0,0 +1,17 @@
+        " " " " " " " " "          
+       " #             ( " " " "   
+      "   #           (   "     "  
+     "   # #         (     " #   " 
+    "   #   #       (       #     "
+   "         #     (       # "   " 
+  "   & &   %     (         # " "  
+ "   & & & & Z   (         # # "   
+"   # C C & & Z (       # #   # "  
+ "   & & & & & #             7 "   
+  "   & & & & & ]           7 "    
+ " "     & & &   ] %       7 "     
+" * '   o \ O   # " %     7 "      
+ " @ "   ` o     #   %   7 "       
+  " " "   #   %   #   % 7 "        
+       "     % %       % "         
+        " " " " " " " " "          
diff --git a/initiation/PLG.text b/initiation/PLG.text
new file mode 100644
--- /dev/null
+++ b/initiation/PLG.text
@@ -0,0 +1,1 @@
+Pull the plug
diff --git a/initiation/RAT.lock b/initiation/RAT.lock
new file mode 100644
--- /dev/null
+++ b/initiation/RAT.lock
@@ -0,0 +1,17 @@
+        " " " " " " " " "          
+       "                 " " " "   
+      "                 # "     "  
+     " #                 # " #   " 
+    "   #                 # #     "
+   " #   #   % O O O " " " # "   " 
+  "     #   % % O O O " " " # " "  
+ "           % S S S S S S " # "   
+" #   # # #   % % %   % % " # # "  
+ "         #   % %   # # # # 7 "   
+  "     # #   ' % % &   # # 7 "    
+ " "   # \ . o % % Z Z   # % "     
+" * '     o - `   % Z Z   % "      
+ " @ "   /   # # % % Z Z % "       
+  " " "   # # \ O   % Z Z "        
+       "       o O % % Z "         
+        " " " " " " " " "          
diff --git a/initiation/RAT.text b/initiation/RAT.text
new file mode 100644
--- /dev/null
+++ b/initiation/RAT.text
@@ -0,0 +1,1 @@
+Ratchet
diff --git a/initiation/REP.lock b/initiation/REP.lock
new file mode 100644
--- /dev/null
+++ b/initiation/REP.lock
@@ -0,0 +1,17 @@
+        " " " " " " " " "          
+       " } #             " " " "   
+      " & }   # # S S %   "     "  
+     "   & }       & & % % "     " 
+    "     & }     &       % % %   "
+   " %     & }   &           "   " 
+  " [ % $ # & } &             " "  
+ " [         & &           o   "   
+" # # # # # o - O         / ` % "  
+ "   % #   /     O       %   % "   
+  " % # %         O     %     "    
+ " "   % %         O   %     "     
+" * '     %         O %     "      
+ " @ "     % # # # # O   # "       
+  " " "     #             "        
+       "           #     "         
+        " " " " " " " " "          
diff --git a/initiation/REP.text b/initiation/REP.text
new file mode 100644
--- /dev/null
+++ b/initiation/REP.text
@@ -0,0 +1,1 @@
+Do the shuffle.
diff --git a/initiation/RUN.lock b/initiation/RUN.lock
new file mode 100644
--- /dev/null
+++ b/initiation/RUN.lock
@@ -0,0 +1,17 @@
+        " " " " " " " " "          
+       " ~ ~ ~ ~ ~   # # " " " "   
+      " ~   ~ ~ ~   # #   "     "  
+     " ~ ~ ~ ~ ~   # #     " #   " 
+    " ~ ~ ~ $ " O # #   # # #     "
+   " ~ ~ ~ ~ ~   # # #     7 "   " 
+  " ~ ~ ~ ~ ~             7   " "  
+ " ~ ~ ~ ~ ~ O % D " " " "     "   
+" ~ & & & & & & & &             "  
+ " ~ ~ ~ ~   # # # &           "   
+  "               &           "    
+ " "   & & & & & &           "     
+" * ' & C C C C C C C C C C "      
+ " @ " % % % % % % % % % % "       
+  " " " % % % % % % %   % "        
+       " % % % % % % % % "         
+        " " " " " " " " "          
diff --git a/initiation/RUN.text b/initiation/RUN.text
new file mode 100644
--- /dev/null
+++ b/initiation/RUN.text
@@ -0,0 +1,1 @@
+Quick!
diff --git a/initiation/SOK.lock b/initiation/SOK.lock
new file mode 100644
--- /dev/null
+++ b/initiation/SOK.lock
@@ -0,0 +1,17 @@
+        " " " " " " " " "          
+       "   O         #   " " " "   
+      " % % %       #   # "     "  
+     "   % %       #     ' " &   " 
+    "     %           # o & &     "
+   "   O %   O   #   #   ` & "   " 
+  " O     %     # # # O     & " "  
+ "       %     #       # O   & "   
+"       %     #               & "  
+ "   #   %       # # # # # # 7 "   
+  " #     %     #         # 7 "    
+ " " O #       #         O % "     
+" * '   #                   "      
+ " @ "             %   #   "       
+  " " "   #       O % #   "        
+       "     O           "         
+        " " " " " " " " "          
diff --git a/initiation/SOK.text b/initiation/SOK.text
new file mode 100644
--- /dev/null
+++ b/initiation/SOK.text
@@ -0,0 +1,1 @@
+Sokoban
diff --git a/initiation/initiation.map b/initiation/initiation.map
new file mode 100644
--- /dev/null
+++ b/initiation/initiation.map
@@ -0,0 +1,3 @@
+[["DIV","ICE","CLR","COG","BAL"],
+["RUN","HLD","SOK","ONE","END"],
+["PLG","REP","CMB","GAP","RAT"]]
diff --git a/intricacy.cabal b/intricacy.cabal
--- a/intricacy.cabal
+++ b/intricacy.cabal
@@ -1,6 +1,6 @@
 cabal-version:      >=1.10
 name:               intricacy
-version:            0.7.2.3
+version:            0.8.0
 license:            GPL-3
 license-file:       COPYING
 maintainer:         mbays@sdf.org
@@ -8,16 +8,17 @@
 homepage:           http://mbays.freeshell.org/intricacy
 synopsis:           A game of competitive puzzle-design
 description:
-    A networked game with client-server architecture. The core game is a
-    lockpicking-themed turn-based puzzle game on a hex grid. Players design
-    puzzles (locks) and solve those designed by others. A metagame encourages
-    the design of maximally difficult puzzles, within tight size constraints.
-    The client supports Curses and SDL, with all graphics in SDL mode drawn by
-    code using SDL-gfx. The network protocol is based on the 'binary' package,
-    and is intended to be reasonably efficient. TVars are used to give
-    transparent local caching and background network operations. Also
-    incorporates an implementation of a graph 5-colouring algorithm (see
-    GraphColouring.hs).
+    A lockpicking-themed turn-based puzzle game on a hex grid. A series of
+    preset puzzles serves as an extended single-player introduction, after
+    which players enter a multi-player game with a client-server architecture,
+    in which players design puzzles (locks) and solve those designed by
+    others. A metagame encourages the design of maximally difficult puzzles,
+    within tight size constraints. The client supports Curses and SDL, with
+    all graphics in SDL mode drawn by code using SDL-gfx. The network protocol
+    is based on the 'binary' package, and is intended to be reasonably
+    efficient. TVars are used to give transparent local caching and background
+    network operations. Also incorporates an implementation of a graph
+    5-colouring algorithm (see GraphColouring.hs).
 
 category:           Game
 build-type:         Simple
@@ -25,6 +26,9 @@
     VeraMoBd.ttf
     tutorial/*.lock
     tutorial/*.text
+    initiation/initiation.map
+    initiation/*.lock
+    initiation/*.text
     sounds/*.ogg
 
 extra-source-files:
@@ -103,6 +107,7 @@
             transformers >=0.3.0.0 && <0.6,
             stm >=2.1 && <2.6,
             directory >=1.0 && <1.4,
+            exceptions >=0.8.3 && <0.11,
             filepath >=1.0 && <1.5,
             time >=1.2 && <1.10,
             bytestring ==0.10.*,
@@ -206,6 +211,7 @@
             transformers >=0.4 && <0.6,
             stm >=2.1 && <2.6,
             directory >=1.0 && <1.4,
+            exceptions >=0.8.3 && <0.11,
             filepath >=1.0 && <1.5,
             time >=1.5 && <1.10,
             bytestring ==0.10.*,
@@ -225,6 +231,7 @@
             email-validate >=1.0 && <2.4,
             text >=0.1 && < 1.3,
             text-short ==0.1.*,
+            mime-mail >=0.4.4 && < 0.6,
             smtp-mail >=0.1.4.1 && < 0.4,
             argon2 ==1.3.*
 
diff --git a/sounds/toolmove-01.ogg b/sounds/toolmove-01.ogg
new file mode 100644
Binary files /dev/null and b/sounds/toolmove-01.ogg differ
diff --git a/sounds/toolmove-02.ogg b/sounds/toolmove-02.ogg
new file mode 100644
Binary files /dev/null and b/sounds/toolmove-02.ogg differ
diff --git a/sounds/toolmove-03.ogg b/sounds/toolmove-03.ogg
new file mode 100644
Binary files /dev/null and b/sounds/toolmove-03.ogg differ
diff --git a/sounds/toolmove-04.ogg b/sounds/toolmove-04.ogg
new file mode 100644
Binary files /dev/null and b/sounds/toolmove-04.ogg differ
diff --git a/sounds/toolmove-05.ogg b/sounds/toolmove-05.ogg
new file mode 100644
Binary files /dev/null and b/sounds/toolmove-05.ogg differ
diff --git a/tutorial/07-pivots.lock b/tutorial/07-pivots.lock
deleted file mode 100644
--- a/tutorial/07-pivots.lock
+++ /dev/null
@@ -1,11 +0,0 @@
-       " " " " " "       
-      " \     # # " " "  
-     "   o -   \ ' " # " 
-    " % /   "   o - #   "
-   " % %   " "   # # " " 
-  " % % %   " O   # # "  
- " "         . o - 7 "   
-" * ' . o - &   ` 7 "    
- " @ " O     & & & "     
-  " " " # #   & & "      
-       " " " " " "       
diff --git a/tutorial/07-pivots.text b/tutorial/07-pivots.text
deleted file mode 100644
--- a/tutorial/07-pivots.text
+++ /dev/null
@@ -1,1 +0,0 @@
-push arms to rotate them around their pivots
diff --git a/tutorial/07-traps.lock b/tutorial/07-traps.lock
new file mode 100644
--- /dev/null
+++ b/tutorial/07-traps.lock
@@ -0,0 +1,13 @@
+       & & & & & & &       
+      &             & & &  
+     & % O % S S "   &   & 
+    &         #   " " " " &
+   & "         O   " " & & 
+  & " "   # #     # # # &  
+ & "                   # & 
+  & " " "         # # # &  
+ & &   " } # #   #     &   
+& * '     % # #   #   &    
+ & @ &     O       # &     
+  & & &     # # # # &      
+       & & & & & & &       
diff --git a/tutorial/07-traps.text b/tutorial/07-traps.text
new file mode 100644
--- /dev/null
+++ b/tutorial/07-traps.text
@@ -0,0 +1,1 @@
+if you make a mistake, you can undo moves ('X') or reset to the start ('^')
diff --git a/tutorial/09-pivots.lock b/tutorial/09-pivots.lock
new file mode 100644
--- /dev/null
+++ b/tutorial/09-pivots.lock
@@ -0,0 +1,11 @@
+       " " " " " "       
+      " \     # # " " "  
+     "   o -   \ ' " # " 
+    " % /   "   o - #   "
+   " % %   " "   # # " " 
+  " % % %   " O   # # "  
+ " "         . o - 7 "   
+" * ' . o - &   ` 7 "    
+ " @ " O     & & & "     
+  " " " # #   & & "      
+       " " " " " "       
diff --git a/tutorial/09-pivots.text b/tutorial/09-pivots.text
new file mode 100644
--- /dev/null
+++ b/tutorial/09-pivots.text
@@ -0,0 +1,1 @@
+push arms to rotate them around their pivots
diff --git a/tutorial/09-traps.lock b/tutorial/09-traps.lock
deleted file mode 100644
--- a/tutorial/09-traps.lock
+++ /dev/null
@@ -1,13 +0,0 @@
-       & & & & & & &       
-      &             & & &  
-     & % O % S S "   &   & 
-    &         #   " " " " &
-   & "         O   " " & & 
-  & " "   # #     # # # &  
- & "                   # & 
-  & " " "         # # # &  
- & &   " } # #   #     &   
-& * '     % # #   #   &    
- & @ &     O       # &     
-  & & &     # # # # &      
-       & & & & & & &       
diff --git a/tutorial/09-traps.text b/tutorial/09-traps.text
deleted file mode 100644
--- a/tutorial/09-traps.text
+++ /dev/null
@@ -1,1 +0,0 @@
-if you make a mistake, you can undo moves ('X') or reset to the start ('^')
diff --git a/tutorial/10-puzzle.lock b/tutorial/10-puzzle.lock
deleted file mode 100644
--- a/tutorial/10-puzzle.lock
+++ /dev/null
@@ -1,17 +0,0 @@
-        " " " " " " " " "          
-       "                 " " " "   
-      "   # S S S S S %   "     "  
-     "     O   "       %   "     " 
-    " S S & & & o -   % % % % % % "
-   "   & &   #   #           "   " 
-  "         # #   # #   # # # " "  
- "         #   #             # "   
-"               # # #   # # # # "  
- "             # #             "   
-  "             #         O   "    
- " "   #     %   # #   # # # "     
-" * '     % % %           # "      
- " @ "   O % } % % % o   # "       
-  " " " % O % "     /   # "        
-       " %     O       # "         
-        " " " " " " " " "          
diff --git a/tutorial/10-puzzle.text b/tutorial/10-puzzle.text
deleted file mode 100644
--- a/tutorial/10-puzzle.text
+++ /dev/null
@@ -1,1 +0,0 @@
-your final test!