diff --git a/Cache.hs b/Cache.hs
--- a/Cache.hs
+++ b/Cache.hs
@@ -32,7 +32,7 @@
 import ServerAddr
 
 data FetchedRecord = FetchedRecord {fresh :: Bool, fetchError :: Maybe String, fetchedRC :: Maybe RecordContents}
-    deriving (Eq, Ord, Show)
+    deriving (Eq, Show)
 
 
 getRecordCached :: ServerAddr -> Maybe Auth -> Maybe (TVar Bool) -> Bool -> Record -> IO (TVar FetchedRecord)
diff --git a/Command.hs b/Command.hs
--- a/Command.hs
+++ b/Command.hs
@@ -76,7 +76,7 @@
 describeCommand CmdTutorials = "play tutorial levels"
 describeCommand CmdShowRetired = "toggle showing retired locks"
 describeCommand CmdSetServer = "set server"
-describeCommand CmdToggleCacheOnly = "toggle using only cache"
+describeCommand CmdToggleCacheOnly = "toggle offline mode"
 describeCommand (CmdSelCodename mname) = "select player"
 	++ maybe "" (' ':) mname
 describeCommand CmdBackCodename = "select last player"
diff --git a/CursesUI.hs b/CursesUI.hs
--- a/CursesUI.hs
+++ b/CursesUI.hs
@@ -21,6 +21,7 @@
 import Control.Monad.Trans.Maybe
 import Control.Monad.State
 import Data.Function (on)
+import Data.Foldable (forM_)
 
 import Hex
 import GameState (stateBoard)
@@ -57,7 +58,7 @@
     liftIO makeConfDir
     liftIO $ writeFile path $ show bdgs
 
-getBindings :: InputMode -> UIM [(Char, Command)]
+getBindings :: InputMode -> UIM KeyBindings
 getBindings mode = do
     uibdgs <- Map.findWithDefault [] mode <$> gets uiKeyBindings
     return $ uibdgs ++ bindings mode
@@ -68,6 +69,135 @@
     return $ (("["++).(++"]")) $ intercalate "," $
 	map (maybe "" showKey . findBinding bdgs) cmds
 
+
+data Gravity = GravUp | GravLeft | GravRight | GravDown | GravCentre
+    deriving (Eq, Ord, Show, Enum)
+
+data Draw = Draw { drawWidth :: Int, doDraw :: CVec -> UIM () }
+
+doDrawAt :: CVec -> Draw -> UIM ()
+doDrawAt = flip doDraw
+
+alignDraw :: Gravity -> Int -> Draw -> Draw
+alignDraw gravity w (Draw w' d) = Draw (max w w') $ \(CVec y x) ->
+    d $ CVec y $ x + shift
+    where
+        shift = case gravity of
+            GravLeft -> 0
+            GravRight -> max 0 $ w - w'
+            _ -> max 0 . (`div` 2) $ w - w'
+
+instance Monoid Draw where
+    mempty = Draw 0 (const $ return ())
+    mappend (Draw w d) (Draw w' d') =
+        Draw (w+w') $ \cpos@(CVec y x) -> d cpos >> d' (CVec y (x+w))
+
+stringDraw :: Curses.Attr -> ColPair -> String -> Draw
+stringDraw attr col str =
+    Draw (length str) $ \cpos -> drawStr attr col cpos str
+
+greyDraw :: String -> Draw
+greyDraw = stringDraw a0 white
+
+bindingsDraw :: KeyBindings -> [Command] -> Draw
+bindingsDraw = bindingsDrawColour white
+bindingsDrawColour :: ColPair -> KeyBindings -> [Command] -> Draw
+bindingsDrawColour col bdgs cmds =
+    mconcat . ((stringDraw a0 col "[") :) . (++ [stringDraw a0 col "]"]) .
+    intersperse (stringDraw a0 col ",") $
+        catMaybes $ ((keyDraw <$>) . findBinding bdgs) <$> cmds
+    where
+        keyDraw = stringDraw bold col . showKeyFriendlyShort
+
+data BindingsEntry = BindingsEntry String [Command]
+
+drawBindingsTables :: InputMode -> Frame -> UIM ()
+drawBindingsTables mode 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
+            descX = (w `div` 2) + if grav == GravRight
+                then startRight + maxBdgs + 2
+                else -(startRight + maxBdgs + 2 + maxDesc)
+            bdgsX = (w `div` 2) + if grav == GravRight
+                then startRight
+                else -(startRight + maxBdgs)
+            oppGrav = if grav == GravRight then GravLeft else GravRight
+            useDescs = maxDesc + 1 + maxBdgs <= maxWidth
+        in sequence_
+            [ do
+                when (maxBdgs <= maxWidth) $
+                    doDrawAt (CVec y bdgsX) $ alignDraw
+                        (if useDescs then grav else oppGrav) maxBdgs
+                        bdgsDraw
+                when useDescs $
+                    doDrawAt (CVec y descX) $ alignDraw oppGrav maxDesc descDraw
+            | (yoff, (descDraw, bdgsDraw)) <- drawsTable
+            , let y = (h `div` 2) + yoff
+            ]
+    where
+        bindingsTable IMPlay GravLeft =
+            [ (-5, BindingsEntry "move tool" $
+                map (CmdDir WHSSelected) hexDirs)
+            , (-4, 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]])
+            , ( 0, BindingsEntry "wait" [CmdWait])
+            , ( 2, BindingsEntry "open lock" [CmdOpen])
+            , ( 4, BindingsEntry "undo, redo" [CmdUndo, CmdRedo])
+            , ( 5, BindingsEntry "marks" [CmdMark, CmdJumpMark, CmdReset])
+            ]
+        bindingsTable IMPlay GravRight =
+            [ (-7, BindingsEntry "help" [CmdHelp])
+            , (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])
+            , ( 4, BindingsEntry "undo, redo" [CmdUndo, CmdRedo])
+            , ( 5, BindingsEntry "marks" [CmdMark, CmdJumpMark, CmdReset])
+            ]
+        bindingsTable IMEdit GravRight =
+            [ (-7, BindingsEntry "help" [CmdHelp])
+            , (-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])
+            , ( 4, BindingsEntry "write" [CmdWriteState])
+            , ( 7, BindingsEntry "quit" [CmdQuit])
+            ]
+        bindingsTable _ _ = []
+
+drawBindingsTables _ _ = return ()
+
+-- |frameWidth = maximum . map (abs . cx . hexVec2CVec) .
+--      blockPattern . placedPiece . framePiece
+frameWidth :: Frame -> Int
+frameWidth frame@(BasicFrame size) = max (2*size) $
+    2*(size + boltWidth frame) - (size`div`2)
 
 erase :: UIM ()
 erase = liftIO Curses.erase
diff --git a/CursesUIMInstance.hs b/CursesUIMInstance.hs
--- a/CursesUIMInstance.hs
+++ b/CursesUIMInstance.hs
@@ -23,6 +23,7 @@
 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
@@ -85,8 +86,6 @@
             drawNameWithChar pos name magenta 'P'
 
 
-data Gravity = GravUp | GravLeft | GravRight | GravDown | GravCentre
-    deriving (Eq, Ord, Show, Enum)
 fillBox :: CVec -> CVec -> Int -> Gravity -> [CVec -> MainStateT UIM ()] -> MainStateT UIM Int
 fillBox (CVec t l) (CVec b r) width grav draws = do
     let half = width`div`2
@@ -169,28 +168,82 @@
 	    void $ fillBox (CVec (lockBottom+3) (left+1)) (CVec bottom (right-1)) 5 GravUp
 		[ (`drawActiveLock` al) | al <- map noteOn $ notesSecured lockinfo ]
 
-drawBasicHelpPage :: (String,ColPair) -> ([String],ColPair) -> UIM ()
-drawBasicHelpPage (title,titleCol) (body,bodyCol) = do
+
+data HelpReturn = HelpNone | HelpDone | HelpContinue Int
+
+showHelpPaged :: Int -> InputMode -> HelpPage -> UIM Bool
+showHelpPaged from mode page =
+    showHelpPaged' from mode page >>= \ret -> case ret of
+        HelpNone -> return False
+        HelpDone -> return True
+        HelpContinue from' -> do
+            drawPrompt False "[MORE]"
+            getInput IMTextInput
+            showHelpPaged from' mode page
+showHelpPaged' :: Int -> InputMode -> HelpPage -> UIM HelpReturn
+showHelpPaged' from mode HelpPageInput = do
+    bdgs <- nub <$> getBindings mode
     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
+    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
+    let draws =
+            [ drawStr a0 cyan (CVec (y+2) (x*bdgWidth) ) $
+                keysStr ++ replicate pad ' ' ++ ": " ++ desc
+            | ((keysStr,pad,desc),(x,y)) <- zip
+                [ (keysStr,pad,desc)
+                | group <- groups
+                , let cmd = snd $ head group
+                , let desc = describeCommand cmd
+                , let chs = map 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..])
+            , (x+1)*bdgWidth < w]
+    sequence_ draws
+    refresh
+    return $ if length draws < length groups
+        then HelpContinue $ from + length draws
+        else HelpDone
+showHelpPaged' from IMMeta HelpPageGame =
+    drawBasicHelpPage from ("INTRICACY",magenta) (metagameHelpText,magenta)
+showHelpPaged' from IMEdit HelpPageFirstEdit =
+    drawBasicHelpPage from ("Your first lock:",magenta) (firstEditHelpText,green)
+showHelpPaged' _ _ _ = return HelpNone
+
+drawBasicHelpPage :: Int -> (String,ColPair) -> ([String],ColPair) -> UIM HelpReturn
+drawBasicHelpPage from (title,titleCol) (body,bodyCol) = do
+    erase
+    (h,w) <- liftIO Curses.scrSize
     drawStrCentred a0 titleCol (CVec 0 $ w`div`2) title
-    if w >= maximum (map length metagameHelpText)
-        then sequence_ [drawStrCentred a0 bodyCol (CVec line $ w`div`2) str |
-                (line,str) <- zip [2..h] $ body ]
-        else do
-            let wrap max = wrap' max max
-                wrap' _ _ [] = []
-                wrap' max left (w:ws) = if 1+length w > left
-                    then if left == max
-                        then take max w ++ "\n" ++
-                            wrap' max max (drop max w : ws)
-                        else '\n' : wrap' max max (w:ws)
-                    else let prepend = if left == max then w else ' ':w
-                        in prepend ++ wrap' max (left - length prepend) ws
-            sequence_ [drawStrCentred a0 bodyCol (CVec line $ w`div`2) str |
-                (line,str) <- zip [1..h] $
-                    lines (wrap w $ words $ intercalate " " body) ]
+    let strs = drop from $
+            if w >= maximum (map length metagameHelpText)
+            then body
+            else
+                let wrap max = wrap' max max
+                    wrap' _ _ [] = []
+                    wrap' max left (w:ws) = if 1+length w > left
+                        then if left == max
+                            then take max w ++ "\n" ++
+                                wrap' max max (drop max w : ws)
+                            else '\n' : wrap' max max (w:ws)
+                        else let prepend = if left == max then w else ' ':w
+                            in prepend ++ wrap' max (left - length prepend) ws
+                in lines . wrap w . words $ intercalate " " body
+    let draws = [drawStrCentred a0 bodyCol (CVec y $ w`div`2) str |
+                (y,str) <- zip [2..h-2] $ strs ]
+    sequence_ draws
+    return $ if length draws < length strs
+        then HelpContinue $ from + length draws
+        else HelpDone
 
+
 charify :: Curses.Key -> Maybe Char
 charify key = case key of
     Curses.KeyChar ch -> Just ch
@@ -205,6 +258,14 @@
     Curses.KeyEnd -> Just '1'
     _ -> Nothing
 
+handleEsc k@(Curses.KeyChar '\ESC') = do
+    Curses.timeout 100
+    cch <- Curses.getch
+    Curses.timeout (-1)
+    return $ if cch == -1 then k
+        else Curses.KeyChar $ chr $ fi cch+128
+handleEsc k = return k
+
 instance UIMonad (StateT UIState IO) where
     runUI m = evalStateT m nullUIState
 
@@ -216,16 +277,20 @@
 	drawMainState' s
 	lift refresh
 	where
-	drawMainState' (PlayState { psCurrentState=st, psLastAlerts=alerts, wrenchSelected=wsel }) = lift $ do
+	drawMainState' (PlayState { psCurrentState=st, psLastAlerts=alerts,
+                wrenchSelected=wsel, psFrame=frame }) = lift $ do
 	    drawState [] False alerts st
+            drawBindingsTables IMPlay frame
 	    drawCursorAt $ listToMaybe [ pos |
 		(_, PlacedPiece pos p) <- enumVec $ placedPieces st
 		, or [wsel && isWrench p, not wsel && isHook p] ]
 	drawMainState' (ReplayState {}) = do
 	    lift . drawState [] False [] =<< gets rsCurrentState
 	    lift $ drawCursorAt Nothing
-	drawMainState' (EditState { esGameStateStack=(st:_), selectedPiece=selPiece, selectedPos=selPos }) = lift $ do
+	drawMainState' (EditState { esGameStateStack=(st:_), selectedPiece=selPiece,
+                selectedPos=selPos, esFrame=frame }) = lift $ do
 	    drawState (maybeToList selPiece) True [] st
+            drawBindingsTables IMEdit frame
 	    drawCursorAt $ if isNothing selPiece then Just selPos else Nothing
 	drawMainState' (MetaState {curServer=saddr, undeclareds=undecls,
 		cacheOnly=cOnly, curAuth=auth, codenameStack=names,
@@ -236,22 +301,28 @@
 	    let home = isJust ourName && ourName == selName
 	    (h,w) <- liftIO Curses.scrSize
 	    when (h<20 || w<40) $ liftIO CursesH.end >> error "Terminal too small!"
+            bdgs <- lift $ getBindings IMMeta
 	    lift $ do
 		drawCursorAt Nothing
-		sstr <- (++"   Server: ") <$> bindingsStr IMMeta [CmdSetServer, CmdToggleCacheOnly]
-		hstr <- (\[ks,ts] -> ts++" tut   "++ks++" keys") <$>
-		    bindingsStr IMMeta `mapM` [[CmdHelp],[CmdTutorials]]
-		drawStrGrey (CVec 0 0) $ sstr ++
-		    take (w - length sstr - length hstr)
-			(saddrStr saddr ++ (if cOnly then "  (cache only) " else "") ++ repeat ' ') ++
-		    hstr
-		drawStrGrey (CVec 1 0) =<<
-		    (\[es,ls] -> take 5 (es ++ repeat ' ') ++ "   Lock: " ++ path ++ "     " ++ ls) <$>
-			bindingsStr IMMeta `mapM`
-			    [ [CmdEdit] ++ if path == "" then [] else [CmdPlaceLock Nothing]
-			    , [CmdSelectLock] ++ if path == "" then [] else [CmdNextLock, CmdPrevLock]
-			    ]
-	    lift $ drawStrGrey (CVec 2 (maximum [w`div`3+1, w`div`2 - 13])) =<< bindingsStr IMMeta [CmdSelCodename Nothing]
+		let serverBdgsDraw = bindingsDraw bdgs
+                        [CmdSetServer, CmdToggleCacheOnly]
+                    lockBdgsDraw = bindingsDraw bdgs $
+                        [CmdEdit] ++ if path == "" then [] else [CmdPlaceLock Nothing]
+                    leftBdgsWidth = (+3) . maximum $ map drawWidth [serverBdgsDraw, lockBdgsDraw]
+		    helpDraw = bindingsDraw bdgs [CmdTutorials] <> greyDraw " tutorial  " <>
+                        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]
+                    lockTextDraw = greyDraw . take (w - leftBdgsWidth - drawWidth lockBdgsDraw' - 1) $
+                        " Lock: " ++ path ++ replicate 5 ' '
+		doDrawAt (CVec 0 0) $ alignDraw GravLeft leftBdgsWidth serverBdgsDraw <> serverTextDraw
+                doDrawAt (CVec 0 0) $ alignDraw GravRight w helpDraw
+		doDrawAt (CVec 1 0) $ alignDraw GravLeft leftBdgsWidth lockBdgsDraw <> lockTextDraw <> lockBdgsDraw'
+
+                doDrawAt (CVec 2 $ maximum [w`div`3+1, w`div`2 - 13]) $ bindingsDraw bdgs [CmdSelCodename Nothing]
+
 	    maybe (return ()) (drawName True (CVec 2 (w`div`2))) selName
 	    void.runMaybeT $ MaybeT (return selName) >>= lift . getUInfoFetched 300 >>=
 		\(FetchedRecord fresh err muirc) -> lift $ do
@@ -259,33 +330,48 @@
 			unless fresh $ drawAtCVec (Glyph '*' red bold) $ CVec 2 (w`div`2+7)
 			maybe (return ()) sayError err
 			when (fresh && (isNothing ourName || home || isNothing muirc)) $
-			    drawStrGrey (CVec 2 (w`div`2+1+9)) =<<
-				(bindingsStr IMMeta $
-				    if (isNothing muirc && isNothing ourName) || home then [CmdRegister $ isJust ourName] else [CmdAuth])
+			    doDrawAt (CVec 2 (w`div`2+1+9)) $
+				bindingsDraw bdgs $
+				    if (isNothing muirc && isNothing ourName) || home
+                                    then [CmdRegister $ isJust ourName] else [CmdAuth]
 		    for_ muirc $ \(RCUserInfo (_,uinfo)) -> case mretired of
 			Just retired -> do
 			    (h,w) <- liftIO Curses.scrSize
 			    void $ fillBox (CVec 6 2) (CVec (h-1) (w-2)) 5 GravCentre
 				[ \pos -> lift $ drawStrGrey pos $ show ls | ls <- retired ]
-			    lift $ drawStrGrey (CVec 5 (w`div`3)) =<< bindingsStr IMMeta
-				([CmdShowRetired] ++ if null retired then [] else [CmdPlayLockSpec Nothing])
+			    lift $ doDrawAt (CVec 5 (w`div`3)) $ bindingsDraw bdgs $
+				[CmdShowRetired] ++ if null retired
+                                then [] else [CmdPlayLockSpec Nothing]
 			Nothing -> do
 			    sequence_ [ drawLockInfo (ActiveLock (codename uinfo) i) lockinfo |
 				(i,Just lockinfo) <- assocs $ userLocks uinfo ]
 			    unless (null $ elems $ userLocks uinfo) $ lift $
-				drawStrGrey (CVec 5 (w`div`3)) =<< bindingsStr IMMeta [CmdSolve Nothing, CmdViewSolution Nothing]
+				doDrawAt (CVec 5 (w`div`3)) $ bindingsDraw bdgs $
+                                [CmdSolve Nothing] ++ if isJust ourName then [CmdViewSolution Nothing] else []
 	    when (isJust ourName && ourName == selName) $ do
-		unless (null undecls) $ do
-		    str <- lift $ (++" Undeclared solutions:") <$> bindingsStr IMMeta [CmdDeclare Nothing]
-		    let s = max 1 $ (w-(length str + 6*length undecls))`div`2
-		    let y = 4
-		    lift $ drawStr bold white (CVec y s) str
-		    void $ fillBox (CVec y (s+length str+1)) (CVec y (w-1)) 5 GravLeft
-			[ (`drawActiveLock` al) | Undeclared _ _ al <- undecls ]
 		rnames <- liftIO $ atomically $ readTVar rnamestvar
 		unless (null rnames) $
-		    void $ fillBox (CVec 2 5) (CVec 5 (w`div`3)) 3 GravCentre
+		    void $ fillBox (CVec 2 0) (CVec 5 (w`div`3)) 3 GravCentre
 			[ \pos -> drawName False pos name | name <- rnames ]
+		unless (null undecls) $
+                    let declareBdgDraw = bindingsDraw bdgs [CmdDeclare Nothing]
+                        declareText = " Undeclared solutions:"
+		        y = 4
+                        leftBound = w`div`3 + 1
+                        undeclsWidth = 1 + 6 * length undecls
+                        declareDraw =
+                            if leftBound + drawWidth declareBdgDraw + length declareText + undeclsWidth >= w
+                            then declareBdgDraw
+                            else declareBdgDraw <> stringDraw bold white declareText
+                        width = drawWidth declareDraw + undeclsWidth
+                        left = max leftBound ((w - width) `div` 2)
+                    in do
+                        lift $ doDrawAt (CVec y left) declareDraw
+                        void $ fillBox
+                            (CVec y $ left + drawWidth declareDraw + 1)
+                            (CVec y (w-1)) 5 GravLeft
+                            [ (`drawActiveLock` al) | Undeclared _ _ al <- undecls ]
+
 	    when (ourName /= selName) $ void $ runMaybeT $ do
 		sel <- liftMaybe selName
 		us <- liftMaybe ourName
@@ -319,39 +405,9 @@
     endPrompt = say "" >> (liftIO $ void $ Curses.cursSet Curses.CursorInvisible)
     drawError = sayError
 
-    showHelp mode HelpPageInput = do
-	bdgs <- nub <$> getBindings mode
-	erase
-	(h,w) <- liftIO Curses.scrSize
-	let bdgWidth = 35
-	    showKeys chs = intercalate "/" (map showKey chs)
-	    maxkeyslen = maximum $ map (length.showKeys.map fst) $ groupBy ((==) `on` snd) bdgs
-	drawStrCentred a0 cyan (CVec 0 (w`div`2)) "Bindings:"
-	sequence_ [ drawStr a0 cyan (CVec (y+2) (x*bdgWidth) ) $
-		keysStr ++ replicate pad ' ' ++ ": " ++ desc |
-	    ((keysStr,pad,desc),(x,y)) <- zip [(keysStr,pad,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 pad = max 0 $ minimum [maxkeyslen + 1 - length keysStr,
-			    bdgWidth - length desc - length keysStr - 1]
-		    ]
-		(map (`divMod` (h-3)) [0..])
-	    , (x+1)*bdgWidth < w]
-	refresh
-	return True
-    showHelp IMMeta HelpPageGame = do
-        drawBasicHelpPage ("INTRICACY",magenta) (metagameHelpText,magenta)
-        return True
-    showHelp IMEdit HelpPageFirstEdit = do
-        drawBasicHelpPage ("Your first lock:",magenta) (firstEditHelpText,green)
-        return True
-    showHelp _ _ = return False
+    showHelp = showHelpPaged 0
 
-    getChRaw = (charify<$>) $ liftIO $ CursesH.getKey (return ())
+    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)
@@ -398,7 +454,8 @@
 
     getInput mode = do
 	let userResizeCode = 1337  -- XXX: chosen not to conflict with HSCurses codes
-	key <- liftIO $ CursesH.getKey (Curses.ungetCh userResizeCode)
+	key <- liftIO $ CursesH.getKey (Curses.ungetCh userResizeCode) >>=
+            handleEsc
 	if key == Curses.KeyUnknown userResizeCode
 	    then do
 		liftIO Curses.scrSize
diff --git a/Database.hs b/Database.hs
--- a/Database.hs
+++ b/Database.hs
@@ -23,6 +23,7 @@
 import qualified Data.ByteString.Char8 as CS
 
 import Crypto.Hash (hashlazy, Digest, SHA1, digestToHexByteString)
+import Crypto.Types.PubKey.RSA (PublicKey, PrivateKey)
 
 import Protocol
 import Metagame
@@ -46,6 +47,8 @@
     | RecRetiredLocks Codename
     | RecServerInfo
     | RecServerEmail
+    | RecPublicKey
+    | RecSecretKey
     deriving (Eq, Ord, Show)
 data RecordContents
     = RCPassword Password
@@ -57,13 +60,16 @@
     | RCLockSpecs [LockSpec]
     | RCServerInfo ServerInfo
     | RCEmail CS.ByteString
-    deriving (Eq, Ord, Show)
+    | RCPublicKey PublicKey
+    | RCSecretKey PrivateKey
+    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"
 
 invariantRecord (RecUserInfo _) = False
@@ -79,6 +85,7 @@
 askForRecord (RecLock ls) = GetLock ls
 askForRecord (RecNote note) = GetSolution note
 askForRecord (RecRetiredLocks name) = GetRetired name
+askForRecord RecPublicKey = GetPublicKey
 askForRecord _ = error "no corresponding request"
 
 type DBM = ReaderT FilePath IO
@@ -104,6 +111,8 @@
 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
@@ -129,6 +138,8 @@
 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
@@ -177,6 +188,8 @@
 	recordPath' RecLockHashes = "lockHashes"
 	recordPath' RecServerInfo = "serverInfo"
 	recordPath' RecServerEmail = "serverEmail"
+	recordPath' RecPublicKey = "publicKey"
+	recordPath' RecSecretKey = "secretKey"
 
 	userDir name = "users" ++ [pathSeparator] ++ pathifyName name ++ [pathSeparator]
 	alockFN (ActiveLock name idx) = pathifyName name ++":"++ show idx
diff --git a/Frame.hs b/Frame.hs
--- a/Frame.hs
+++ b/Frame.hs
@@ -30,7 +30,6 @@
 boltWidth :: Frame -> Int
 boltWidth (BasicFrame size) = size`div`4+1
 
-
 baseState :: Frame -> GameState
 baseState f =
     GameState
diff --git a/Interact.hs b/Interact.hs
--- a/Interact.hs
+++ b/Interact.hs
@@ -8,6 +8,8 @@
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
 
+{-# LANGUAGE ScopedTypeVariables #-}
+
 module Interact (interactUI) where
 
 import Control.Monad.State
@@ -18,6 +20,7 @@
 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
@@ -28,7 +31,13 @@
 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 Crypto.Types.PubKey.RSA (PublicKey)
+import Codec.Crypto.RSA (encrypt)
+import Crypto.Random (newGenIO, SystemRandom)
+
 import Hex
 import Command
 import Physics
@@ -214,24 +223,23 @@
 	liftIO $ atomically $ writeTVar rnamestvar []
 	invalidateAllUInfo
 	refreshUInfoUI
-processCommand' IMMeta CmdToggleCacheOnly =
-    not <$> gets cacheOnly >>= \c -> modify $ \ms -> ms {cacheOnly = c}
+processCommand' IMMeta CmdToggleCacheOnly = do
+    newCOnly <- gets $ not . cacheOnly
+    modify $ \ms -> ms {cacheOnly = newCOnly}
+    unless newCOnly $
+        invalidateAllUInfo >> invalidateAllIndexedLocks
 
 processCommand' IMMeta (CmdRegister _) = void.runMaybeT $ do
     regName <- mgetCurName
     mauth <- gets curAuth
     let isUs = maybe False ((==regName).authUser) mauth
-    let inputPassword = do
-            pw <- MaybeT $ lift $ textInput "Enter new password:" 64 True False Nothing Nothing
-            guard $ not $ null pw
-            return $ hashPassword regName pw
     if isUs
 	then msum [ do
 		confirmOrBail "Log out?"
 		modify $ \ms -> ms {curAuth = Nothing}
 	    , do
 		confirmOrBail "Reset password?"
-		passwd <- inputPassword
+		passwd <- inputPassword regName "Enter new password:"
 		lift $ do
 		    resp <- curServerAction $ ResetPassword passwd
 		    case resp of
@@ -245,7 +253,7 @@
 		setNotifications
 	    ]
 	else do
-	    passwd <- inputPassword
+	    passwd <- inputPassword regName "Enter new password:"
 	    lift $ do
 		modify $ \ms -> ms {curAuth = Just $ Auth regName passwd}
 		resp <- curServerAction Register
@@ -277,8 +285,7 @@
 	modify $ \ms -> ms {curAuth = Nothing}
     else do
 	name <- mgetCurName
-	passwd <- (hashPassword name <$>) $ MaybeT $ lift $
-	    textInput ("Enter password for "++name++":") 64 True False Nothing Nothing
+	passwd <- inputPassword name $ "Enter password for "++name++":"
 	lift $ do
 	    modify $ \ms -> ms {curAuth = Just $ Auth name passwd}
 	    resp <- curServerAction $ Authenticate
@@ -661,7 +668,7 @@
     drawTile selPos tile True
 processCommand' IMEdit (CmdPaintFromTo tile from to) = do
     frame <- gets esFrame
-    paintTilePath tile (truncateToEditable frame from) (truncateToEditable frame to)
+    paintTilePath frame tile (truncateToEditable frame from) (truncateToEditable frame to)
 processCommand' IMEdit CmdMerge = do
     selPos <- gets selectedPos
     st:_ <- gets esGameStateStack
@@ -712,9 +719,32 @@
 	    Just err -> lift $ drawError $ "Write failed: "++err
 processCommand' _ _ = return ()
 
-hashPassword :: String -> String -> String
--- ^ salt password
-hashPassword name password = hash $ "IY" ++ name ++ password
+inputPassword :: UIMonad uiM => Codename -> String -> MaybeT (MainStateT uiM) String
+inputPassword name prompt = do
+    pw <- MaybeT $ lift $ textInput prompt 64 True False Nothing Nothing
+    guard $ not $ null pw
+    RCPublicKey publicKey <- MaybeT $ getFreshRecBlocking RecPublicKey
+    encryptPassword publicKey name pw
+
+-- | Salt and encrypt a password, to protect users' passwords from sniffing
+-- and dictionary attack. We can hope that they wouldn't use valuable
+-- passwords, but we shouldn't assume it.
+-- Note that in all other respects, the protocol is entirely insecure -
+-- nothing else is encrypted, and anyone sniffing an encrypted password can
+-- replay it to authenticate as the user.
+encryptPassword :: UIMonad uiM =>
+    PublicKey -> String -> String -> MaybeT (MainStateT uiM) String
+encryptPassword publicKey name password = msum
+    [ MaybeT . liftIO .
+        handle (\(e :: SomeException) -> return Nothing) $ do
+        g <- newGenIO :: IO SystemRandom
+        return . Just . CS.unpack . BL.toStrict . fst . encrypt g publicKey .
+            BL.fromStrict . CS.pack $ hashed
+    , confirmOrBail
+        "Failed to encrypt password - send unencrypted?"
+        >> return hashed
+    ]
+    where hashed = hash $ "IY" ++ name ++ password
 
 setSelectedPosFromMouse :: UIMonad uiM => MainStateT uiM ()
 setSelectedPosFromMouse = lift getUIMousePos >>= maybe (return ()) setSelectedPos
diff --git a/InteractUtil.hs b/InteractUtil.hs
--- a/InteractUtil.hs
+++ b/InteractUtil.hs
@@ -60,10 +60,12 @@
     lastMP <- gets lastModPos
     modifyEState $ modTile tile pos lastMP painting
     modify $ \es -> es {lastModPos = pos}
-paintTilePath tile from to = if from == to
+paintTilePath frame tile from to = if from == to
     then modify $ \es -> es {lastModPos = to}
-    else let from' = (hexVec2HexDirOrZero $ to-^from) +^ from
-	in drawTile from' tile True >> paintTilePath tile from' to
+    else do
+        let from' = (hexVec2HexDirOrZero $ to-^from) +^ from
+	when (inEditable frame from') $ drawTile from' tile True
+        paintTilePath frame tile from' to
 
 pushEState :: UIMonad uiM => GameState -> MainStateT uiM ()
 pushEState st = do
diff --git a/KeyBindings.hs b/KeyBindings.hs
--- a/KeyBindings.hs
+++ b/KeyBindings.hs
@@ -8,11 +8,13 @@
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
 
-module KeyBindings (KeyBindings, bindings, findBindings, findBinding, showKey, showKeyFriendly) where
+module KeyBindings (KeyBindings, bindings, findBindings, findBinding, showKey,
+    showKeyFriendly, showKeyFriendlyShort) where
 
 import Data.Maybe
 import Data.Char
 import Data.List
+import Data.Bits (xor)
 
 import Command
 import Hex
@@ -21,9 +23,11 @@
 
 type KeyBindings = [ (Char,Command) ]
 
-ctrl, unctrl :: Char -> Char
-ctrl c = toEnum $ fromEnum c - 64
-unctrl c = toEnum $ fromEnum c + 64
+ctrl, unctrl, meta, unmeta :: Char -> Char
+ctrl = toEnum . xor 64 . fromEnum
+meta = toEnum . xor 128 . fromEnum
+unctrl = ctrl
+unmeta = meta
 
 lowerToo :: KeyBindings -> KeyBindings
 lowerToo = concat . map addLower
@@ -207,9 +211,11 @@
 findBinding :: KeyBindings -> Command -> Maybe Char
 findBinding = (listToMaybe.) . findBindings
 
-showKey ch | isPrint ch = [ch]
-showKey ch | isPrint (unctrl ch) = ('^':[unctrl ch])
-showKey _ = "[?]"
+showKey ch
+    | isAscii (unmeta ch) = 'M':'-':showKey (unmeta ch)
+    | isPrint ch = [ch]
+    | isPrint (unctrl ch) = ('^':[unctrl ch])
+    | otherwise = "[?]"
 
 showKeyFriendly ' ' = "space"
 showKeyFriendly '\r' = "return"
@@ -217,3 +223,8 @@
 showKeyFriendly '\t' = "tab"
 showKeyFriendly '\b' = "bksp"
 showKeyFriendly ch = showKey ch
+
+showKeyFriendlyShort '\r' = "ret"
+showKeyFriendlyShort '\t' = "tab"
+showKeyFriendlyShort '\b' = "bksp"
+showKeyFriendlyShort ch = showKey ch
diff --git a/MainState.hs b/MainState.hs
--- a/MainState.hs
+++ b/MainState.hs
@@ -289,6 +289,10 @@
     RCLock lock <- MaybeT $ (fetchedRC<$>) $ liftIO $ atomically $ readTVar tvar
     return $ reframe lock
 
+invalidateAllIndexedLocks :: UIMonad uiM => MainStateT uiM ()
+invalidateAllIndexedLocks =
+    modify $ \ms -> ms { indexedLocks = Map.empty }
+
 refreshUInfoUI :: (UIMonad uiM) => MainStateT uiM ()
 refreshUInfoUI = void.runMaybeT $ do
     modify $ \ms -> ms { listOffset = 0 }
@@ -450,10 +454,10 @@
 
 metagameHelpText :: [String]
 metagameHelpText =
-    [ "By ruthlessly guarded secret arrangement, the Council's agents can pick any lock in the city."
-    , "The Guild produces the necessary locks - apparently secure, but with fatal hidden flaws."
+    [ "By ruthlessly guarded secret arrangement, the council's agents can pick any lock in the city."
+    , "A secret guild produces the necessary locks - apparently secure, but with fatal hidden flaws."
     , "A ritual game is played to determine the best designs."
-    , "To play the game well, you must build locks which can be picked only by one who knows the secret,"
+    , "To master it, you must build locks which can be picked only by one who knows the secret,"
     , "and you must discover the secret flaws in the locks designed by your colleagues."
     , ""
     , "You may put forward up to three prototype locks. They will guard the secrets you discover."
@@ -477,7 +481,7 @@
 firstEditHelpText :: [String]
 firstEditHelpText =
     [ "Design a lock to protect your secrets."
-    , "It must be possible to solve your lock by pulling a sprung bolt from the hole in the top-right,"
+    , "It must be possible to pick your lock by pulling a sprung bolt from the hole in the top-right,"
     , "but you should place blocks, springs, pivots, and balls to make this as difficult as possible."
     , ""
     , "Place pieces with keyboard or mouse. Springs must be set next to blocks, and arms next to pivots."
diff --git a/Metagame.hs b/Metagame.hs
--- a/Metagame.hs
+++ b/Metagame.hs
@@ -126,7 +126,7 @@
 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 SetPublic lockinfo = lockinfo { public = True, lockSolutions = [], accessedBy = []}
+applyLockDelta SetPublic lockinfo = lockinfo { public = True, lockSolutions = [], accessedBy = [], notesSecured = []}
 
 instance Binary UserInfo where
     put (UserInfo name locks notes) = put name >> put locks >> put notes
diff --git a/Mundanities.hs b/Mundanities.hs
--- a/Mundanities.hs
+++ b/Mundanities.hs
@@ -14,6 +14,7 @@
 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
@@ -50,8 +51,9 @@
     BS.writeFile file $ BSC.pack $ unlines x
 
 confFilePath :: FilePath -> IO FilePath
-confFilePath str =
-    (++(pathSeparator:str)) <$> getAppUserDataDirectory "intricacy"
+confFilePath str = (++(pathSeparator:str)) <$>
+    catchIO (getEnv "INTRICACY_PATH")
+        (const $ getAppUserDataDirectory "intricacy")
 
 getDataPath :: FilePath -> IO FilePath
 getDataPath = getDataFileName
diff --git a/NEWS b/NEWS
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,11 @@
 This is an abbreviated summary; see the git log for gory details.
 
+0.7:
+    Encrypt passwords when communicating with server
+        (in previous versions, they were salted and hashed but not encrypted).
+    Clean out solutions when a lock becomes public.
+    Various UI improvements, particularly for curses mode.
+
 0.6.2:
     Fix obscure but actual bug in core game physics:
         wrenches were being blocked when they shouldn't be.
diff --git a/Protocol.hs b/Protocol.hs
--- a/Protocol.hs
+++ b/Protocol.hs
@@ -13,6 +13,8 @@
 import Data.Binary
 import Control.Monad
 
+import Crypto.Types.PubKey.RSA (PublicKey)
+
 import BinaryInstances
 import Metagame
 import Lock
@@ -31,6 +33,7 @@
     | ResetPassword Password
     | SetEmail String
     | GetServerInfo
+    | GetPublicKey
     | GetLock LockSpec
     | GetRetired Codename
     | GetUserInfo Codename (Maybe Int)
@@ -48,6 +51,7 @@
 
 needsAuth :: Action -> Bool
 needsAuth GetServerInfo = False
+needsAuth GetPublicKey = False
 needsAuth (GetLock _) = False
 needsAuth (GetUserInfo _ _) = False
 needsAuth (GetRetired _) = False
@@ -59,6 +63,7 @@
     | ServerMessage String
     | ServerError String
     | ServedServerInfo ServerInfo
+    | ServedPublicKey PublicKey
     | ServedLock Lock
     | ServedRetired [LockSpec]
     | ServedUserInfo VersionedUInfo
@@ -69,7 +74,7 @@
     | ServerCodenameFree
     | ServerFresh
     | ServerUndefinedResponse
-    deriving (Eq, Ord, Show, Read)
+    deriving (Eq, Show, Read)
 
 data ServerInfo = ServerInfo {serverLockSize :: Int, serverInfoString::String}
     deriving (Eq, Ord, Show, Read)
@@ -93,6 +98,7 @@
     put (ResetPassword pw) = put (10::Word8) >> put pw
     put (GetRetired name) = put (11::Word8) >> put name
     put (SetEmail address) = put (12::Word8) >> put address
+    put GetPublicKey = put (13::Word8)
     get = do
 	tag <- get :: Get Word8
 	case tag of
@@ -109,6 +115,7 @@
 	    10 -> liftM ResetPassword get
 	    11 -> liftM GetRetired get
 	    12 -> liftM SetEmail get
+	    13 -> return GetPublicKey
             _ -> return UndefinedAction
 
 instance Binary Auth where
@@ -129,6 +136,7 @@
     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
@@ -145,6 +153,7 @@
 	    10 -> return ServerCodenameFree
 	    11 -> return ServerFresh
 	    12 -> liftM ServedRetired get
+	    13 -> liftM (ServedPublicKey . read) get
             _ -> return ServerUndefinedResponse
 instance Binary ServerInfo where
     put (ServerInfo sz str) = put sz >> put str
diff --git a/SDLGlyph.hs b/SDLGlyph.hs
new file mode 100644
--- /dev/null
+++ b/SDLGlyph.hs
@@ -0,0 +1,371 @@
+-- This file is part of Intricacy
+-- Copyright (C) 2013 Martin Bays <mbays@sdf.org>
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of version 3 of the GNU General Public License as
+-- published by the Free Software Foundation, or any later version.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program.  If not, see http://www.gnu.org/licenses/.
+
+module 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 Hex
+import SDLRender
+import GameState
+import GameStateTypes
+import BoardColouring
+import Physics
+import Command
+import Util
+
+
+data ShowBlocks = ShowBlocksBlocking | ShowBlocksAll | ShowBlocksNone
+    deriving (Eq, Ord, Show, Read)
+
+data Glyph
+    = TileGlyph Tile Pixel
+    | BlockedArm HexDir TorqueDir Pixel
+    | TurnedArm HexDir TorqueDir Pixel
+    | BlockedBlock Tile HexDir Pixel
+    | BlockedPush HexDir Pixel
+    | CollisionMarker
+    | HollowGlyph Pixel
+    | HollowInnerGlyph Pixel
+    | FilledHexGlyph Pixel
+    | ButtonGlyph Pixel
+    | UseFiveColourButton Bool
+    | ShowBlocksButton ShowBlocks
+    | ShowButtonTextButton Bool
+    | UseSoundsButton Bool
+    | WhsButtonsButton (Maybe WrHoSel)
+    | FullscreenButton Bool
+    | UnfreshGlyph
+    deriving (Eq, Ord, Show)
+
+type SizedGlyph = (Glyph,Int)
+data CachedGlyphs = CachedGlyphs (Map SizedGlyph Surface) [SizedGlyph]
+    deriving (Eq, Ord, Show)
+emptyCachedGlyphs = CachedGlyphs Map.empty []
+maxCachedGlyphs = 100
+
+type RenderM = RenderT (StateT CachedGlyphs IO)
+runRenderM :: RenderM a -> CachedGlyphs -> RenderContext -> IO (a,CachedGlyphs)
+runRenderM m cgs rc = runStateT (runReaderT m rc) cgs
+
+drawAt :: Glyph -> HexPos -> RenderM ()
+drawAt gl pos = do
+	centre <- asks renderHCentre
+	drawAtRel gl (pos -^ centre)
+
+drawAtRel :: Glyph -> HexVec -> RenderM ()
+drawAtRel gl v = do
+    size <- asks renderSize
+    displaceRenderSVec (hexVec2SVec size v) $ renderGlyphCaching gl
+
+renderGlyphCaching :: Glyph -> RenderM ()
+-- Glyph caching:
+--  We aim to cache glyphs which are "currently" being regularly drawn, so
+--  they can be blitted from RAM rather than being drawn afresh each time.
+--  Rather than track statistics, we adopt the following probabilistic scheme.
+renderGlyphCaching gl = do
+    CachedGlyphs cmap clist <- lift get
+    size <- asks renderSize
+    let sgl = (gl,size)
+	w = size*2 + 1
+	h = ysize size*4 + 1
+	newGlyphSurf = do
+	    -- csurf <- liftIO $ createRGBSurface [] w h 32 0xff000000 0x00ff0000 0x0000ff00 0x000000ff
+	    csurf <- liftIO $ createRGBSurface [] w h 16 0 0 0 0
+	    liftIO $ setColorKey csurf [SrcColorKey,RLEAccel] $ Pixel 0
+	    return csurf
+	renderOnCache csurf =
+            let ccxt rc = rc { renderSurf = csurf, renderSCentre = SVec (w`div`2) (h`div`2) }
+	    in local ccxt $ renderGlyph gl
+	addToCache cacheFull csurf = do
+	    CachedGlyphs cmap clist <- lift get
+	    let cmap' = Map.insert sgl csurf cmap
+	    lift $ put $ if cacheFull
+		then CachedGlyphs (Map.delete (last clist) cmap') (sgl:List.init clist)
+		else CachedGlyphs cmap' (sgl:clist)
+	promote = do
+	    CachedGlyphs cmap clist <- lift get
+	    lift $ put $ CachedGlyphs cmap (sgl:List.delete sgl clist)
+	blitGlyph csurf = do
+            surf <- asks renderSurf
+	    (x,y) <- renderPos zero
+	    void $ liftIO $ blitSurface csurf Nothing surf $ Just $
+		Rect (x-w`div`2) (y-h`div`2) (w+1) (h+1)
+    let cacheFull = Map.size cmap >= maxCachedGlyphs
+    let mcsurf = Map.lookup sgl cmap
+    -- with probability 1 in (maxCachedGlyphs`div`2), we put this glyph at the
+    -- head of the cached list, throwing away the tail to make room if needed.
+    cacheIt <- (((cacheable &&) . (not cacheFull ||)) <$>) $
+	liftIO $ (==0) <$> randomRIO (0::Int,maxCachedGlyphs`div`2)
+    case mcsurf of
+	Nothing -> if cacheIt
+	    then do
+		csurf <- newGlyphSurf
+		renderOnCache csurf
+		addToCache cacheFull csurf
+		blitGlyph csurf
+	    else
+		renderGlyph gl
+	Just csurf -> do
+	    when cacheIt promote
+	    blitGlyph csurf
+    where
+	cacheable = case gl of
+	    -- some glyphs need to be drawn with blending - those involving
+	    -- anti-aliasing which bleed over the edge of the hex or which
+	    -- may be drawn on top of an existing glyph.
+	    -- TODO: we should find a way to deal with at least some of these;
+	    -- springs in particular are common and expensive to draw.
+	    -- Maybe we could truncate the spring glyphs to a hex?
+	    TileGlyph (BlockTile adjs) _ -> null adjs
+	    TileGlyph (SpringTile extn dir) _ -> False
+	    FilledHexGlyph _ -> False
+	    HollowGlyph _ -> False
+	    BlockedBlock _ _ _ -> False
+	    BlockedPush _ _ -> False
+	    CollisionMarker -> False
+	    _ -> True
+
+renderGlyph :: Glyph -> RenderM ()
+renderGlyph (TileGlyph (BlockTile adjs) col) =
+    rimmedPolygonR corners col $ bright col
+	where
+	    corners = concat [
+		if or $ map adjAt [0,1]
+		then [corner $ hextant dir]
+		else if adjAt $ -1
+		    then []
+		    else [innerCorner dir]
+		| dir <- hexDirs
+		, let adjAt r = rotate r dir `elem` adjs
+		]
+
+renderGlyph (TileGlyph (SpringTile extn dir) col) =
+    thickLinesR points 1 $ brightness col
+	where
+            n :: Int
+	    n = 3*case extn of
+		Stretched -> 1
+		Relaxed -> 2
+		Compressed -> 4
+	    brightness = if extn == Relaxed then dim else bright
+	    dir' = if dir == zero then hu else dir
+	    s = corner (hextant dir' - 1)
+	    off = corner (hextant dir')
+	    e = corner (hextant dir' - 3)
+	    points = [ b +^ (fi i / fi n) **^ (e -^ s)
+		| i <- [0..n]
+		, i`mod`3 /= 1
+		, let b = if i`mod`3==0 then s else off ]
+
+renderGlyph (TileGlyph (PivotTile dir) col) = do
+    rimmedCircleR zero (7/8) col $ bright col
+    when (dir /= zero)
+	$ aaLineR from to $ bright col
+    return ()
+	where
+	    from = (7/8) **^ edge (neg dir)
+	    to = (7/8) **^ edge dir
+
+renderGlyph (TileGlyph (ArmTile dir _) col) =
+    thickLineR from to 1 col
+	where
+	    dir' = if dir == zero then hu else dir
+	    from = edge $ neg dir'
+	    to = innerCorner dir'
+
+renderGlyph (TileGlyph HookTile col) =
+    rimmedCircleR zero (7/8) col $ bright col
+
+renderGlyph (TileGlyph (WrenchTile mom) col) = do
+    rimmedCircleR zero (1/3) col $ bright col
+    when (mom /= zero) $
+	let
+	    from = innerCorner $ neg mom
+	    to = edge $ neg mom
+	    shifts = [ (1/2) **^ (b -^ a)
+		| rot <- [-1,0,1]
+		, let a = innerCorner $ neg mom
+		, let b = innerCorner $ rotate rot $ neg mom
+		]
+	in sequence_
+	    [ aaLineR (from+^shift) (to+^shift) $ col
+	    | shift <- shifts ]
+
+renderGlyph (TileGlyph BallTile col) =
+    rimmedCircleR zero (7/8) (faint col) (obscure col)
+
+renderGlyph (BlockedArm armdir tdir col) =
+    aaLineR from to col
+	where
+	    from = innerCorner $ rotate (2*tdir) armdir
+	    to = edge $ rotate tdir armdir
+
+renderGlyph (TurnedArm armdir tdir col) =
+    sequence_ [ arcR c r a1 a2 col | r <- [8/4,9/4] ]
+    where
+	c = hexVec2FVec $ neg armdir
+	a0 = fi $ -60*hextant armdir
+	a1' = a0 + fi tdir * 10
+	a2' = a0 + fi tdir * 30
+	a1 = min a1' a2'
+	a2 = max a1' a2'
+
+renderGlyph (BlockedBlock tile dir col) =
+    displaceRender shift $ renderGlyph (TileGlyph tile col)
+	where shift = innerCorner dir -^ edge dir
+
+renderGlyph (BlockedPush dir col) = do
+    thickLineR zero tip 1 col
+    thickLineR tip (arms!!0) 1 col
+    thickLineR tip (arms!!1) 1 col
+    where
+	tip@(FVec tx ty) = edge dir
+        arms = [ FVec ((tx/2) + d*ty/4) (ty/2 - d*tx/4) | d <- [-1,1] ]
+
+renderGlyph CollisionMarker = do
+    -- rimmedCircle surf centre (size`div`3) (bright purple) $ bright purple
+    aaLineR start end $ col
+    aaCircleR zero rad col
+    where
+	[start,end] = map (((1/2)**^) . corner) [0,3]
+	rad = ylen
+	col = dim purple
+
+renderGlyph (HollowGlyph col) =
+    aaPolygonR corners $ opaquify col
+    where corners = map corner [0..5]
+renderGlyph (HollowInnerGlyph col) =
+    aaPolygonR corners $ opaquify col
+    where corners = map innerCorner hexDirs
+
+renderGlyph (FilledHexGlyph col) =
+    rimmedPolygonR corners col $ brightish col
+    where corners = map corner [0..5]
+
+renderGlyph (ButtonGlyph col) =
+    renderGlyph (TileGlyph (BlockTile []) col)
+
+renderGlyph (UseFiveColourButton using) =
+    rescaleRender (1/2) $ sequence_ [
+        displaceRender (corner h) $ renderGlyph
+            (TileGlyph (BlockTile [])
+                (dim $ colourWheel (if using then h`div`2 else 1)))
+        | h <- [0,2,4] ]
+
+renderGlyph (ShowBlocksButton showing) = do
+    renderGlyph (TileGlyph (BlockTile []) (dim red))
+    when (showing == ShowBlocksAll) $
+	renderGlyph (BlockedPush hu (bright orange))
+    when (showing /= ShowBlocksNone) $
+	renderGlyph (BlockedPush hw (bright purple))
+
+renderGlyph (ShowButtonTextButton showing) = do
+    rescaleRender (1/2) $ displaceRender (edge (neg hu)) $
+        renderGlyph (ButtonGlyph (dim yellow))
+    when showing $
+	sequence_ [ pixelR (FVec (1/3 + i/4) (-1/4)) (bright white) | i <- [-1..1] ]
+
+renderGlyph (UseSoundsButton use) = do
+    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) $
+        aaLineR (innerCorner hw) (innerCorner $ neg hw) $ dim red
+
+renderGlyph (WhsButtonsButton Nothing) = rescaleRender (1/3) $ do
+    renderGlyph (ButtonGlyph (dim red))
+    sequence_ [ displaceRender ((3/2) **^ edge dir) $
+            renderGlyph (ButtonGlyph (dim purple))
+        | dir <- hexDirs ]
+renderGlyph (WhsButtonsButton (Just whs)) = rescaleRender (1/2) $ do
+    when (whs /= WHSHook) $
+	displaceRender (corner 0) $ renderGlyph (TileGlyph (WrenchTile zero) col)
+    when (whs /= WHSWrench) $ do
+	displaceRender (corner 4) $ renderGlyph (TileGlyph HookTile col)
+	displaceRender (corner 2) $ renderGlyph (TileGlyph (ArmTile hv False) col)
+    where
+	col = dim white
+
+renderGlyph (FullscreenButton fs) = do
+    thickPolygonR corners 1 $ activeCol (not fs)
+    thickPolygonR corners' 1 $ activeCol fs
+    where
+	activeCol True = opaquify $ dim green
+	activeCol False = opaquify $ dim red
+	corners = [ (2/3) **^ (if dir `elem` [hu,neg hu] then edge else innerCorner) dir
+	    | dir <- hexDirs ]
+	corners' = map (((2/3)**^) . corner) [0..5]
+
+renderGlyph (UnfreshGlyph) = do
+    let col = bright red
+    renderGlyph (HollowInnerGlyph col)
+    sequence_ [pixelR (FVec (i/4) 0) col
+	| i <- [-1..1] ]
+
+playerGlyph col = FilledHexGlyph col
+
+cursorGlyph = HollowGlyph $ bright white
+
+ownedTileGlyph colouring highlight (owner,t) =
+    let col = colourOf colouring owner
+    in TileGlyph t $ (if owner `elem` highlight then bright else dim) col
+
+drawCursorAt :: Maybe HexPos -> RenderM ()
+drawCursorAt (Just pos) = drawAt cursorGlyph pos
+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]
+		a = fi $ (0x90 * (maxR - abs (hexLen v)))`div`maxR
+	    in rgbaToPixel (r,g,b,a)
+
+drawBlocked :: GameState -> PieceColouring -> Bool -> Force -> RenderM ()
+drawBlocked st colouring blocking (Torque idx dir) = do
+    let (pos,arms) = case getpp st idx of
+	    PlacedPiece pos (Pivot arms) -> (pos,arms)
+	    PlacedPiece pos (Hook arm _) -> (pos,[arm])
+	    _ -> (pos,[])
+	col = if blocking then bright $ purple else dim $ colourOf colouring idx
+    sequence_ [ drawAt (BlockedArm arm dir col) (arm +^ pos) |
+	arm <- arms ]
+drawBlocked st colouring blocking (Push idx dir) = do
+    let footprint = plPieceFootprint $ getpp st idx
+	fullfootprint = fullFootprint st idx
+	col = bright $ if blocking then purple else orange
+    sequence_ [ drawAt (BlockedPush dir col) pos
+	| pos <- footprint
+	, (dir+^pos) `notElem` fullfootprint ]
+    -- drawAt (blockedPush dir $ bright orange) $ placedPos $ getpp st idx
+
+drawApplied :: GameState -> PieceColouring -> Force -> RenderM ()
+drawApplied st colouring (Torque idx dir) = do
+    let (pos,arms) = case getpp st idx of
+	    PlacedPiece pos (Pivot arms) -> (pos,arms)
+	    PlacedPiece pos (Hook arm _) -> (pos,[arm])
+	    _ -> (pos,[])
+	col = dim $ colourOf colouring idx
+    sequence_ [ drawAt (TurnedArm arm dir col) (arm +^ pos) |
+	    arm <- arms ]
+drawApplied _ _ _ = return ()
diff --git a/SDLRender.hs b/SDLRender.hs
--- a/SDLRender.hs
+++ b/SDLRender.hs
@@ -8,6 +8,7 @@
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
 
+-- |SDLRender: generic wrapper around sdl-gfx for drawing on hex grids
 module SDLRender where
 
 import Graphics.UI.SDL
@@ -16,435 +17,234 @@
 import Data.Monoid
 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 Data.List (maximumBy)
 import Data.Function (on)
 import GHC.Int (Int16)
 import Control.Applicative
-import System.Random (randomRIO)
 
 import Hex
-import GameState
-import GameStateTypes
-import BoardColouring
-import Physics
-import Command
 import Util
 
--- aaPolygon seems to be a bit buggy in sdl-gfx-0.6.0
-aaPolygon' surf verts col =
-    aaLines surf (verts ++ take 1 verts) col
--- aaCircle too
-aaCircle' surf x y rad col =
-    if (rad == 1) then pixel surf x y col
-    else aaCircle surf x y rad col
+-- |SVec: screen vectors, in pixels
+data SVec = SVec { cx, cy :: Int }
+    deriving (Eq, Ord, Show)
+instance Monoid SVec where
+    mempty = SVec 0 0
+    mappend (SVec x y) (SVec x' y') = SVec (x+x') (y+y')
+instance Grp SVec where
+    neg (SVec x y) = SVec (-x) (-y)
+type CCoord = PHS SVec
 
-aaLines surf verts col =
-    sequence_ [ aaLine surf x y x' y' col |
-	((x,y),(x',y')) <- zip (take (length verts - 1) verts) (drop 1 verts) ]
+-- |FVec: floating point screen vectors, multiplied by 'size' to get SVecs.
+data FVec = FVec { rcx, rcy :: Float }
+    deriving (Eq, Ord, Show)
+instance Monoid FVec where
+    mempty = FVec 0 0
+    mappend (FVec x y) (FVec x' y') = FVec (x+x') (y+y')
+instance Grp FVec where
+    neg (FVec x y) = FVec (-x) (-y)
 
-rimmedPolygon surf verts fillCol rimCol = do
-    filledPolygon surf verts fillCol
-    aaPolygon' surf verts $ opaquify rimCol
-    return ()
+-- The following leads to overlapping instances (not sure why):
+--instance MultAction Float FVec where
+--    r *^ FVec x y = FVec (r*x) (r*y)
+-- So instead, we define a new operator:
+(**^) :: Float -> FVec -> FVec
+r **^ FVec x y = FVec (r*x) (r*y)
+    
 
-circleAt surf centre@(SVec x y) rad col =
-    aaCircle' surf (fi x) (fi y) (fi rad) col
+hexVec2SVec :: Int -> HexVec -> SVec
+hexVec2SVec size (HexVec x y z) =
+    SVec ((x-z) * size) (-y * 3 * ysize size)
 
-filledCircleAt surf centre@(SVec x y) rad col =
-    filledCircle surf (fi x) (fi y) (fi rad) col
+hexVec2FVec :: HexVec -> FVec
+hexVec2FVec (HexVec x y z) =
+    FVec (fi $ x-z) (-(fi y) * 3 * ylen)
 
-rimmedCircle surf centre@(SVec x y) rad fillCol rimCol = void $ do
-    filledCircleAt surf centre rad fillCol
-    circleAt surf centre rad $ opaquify rimCol
+sVec2dHV :: Int -> SVec -> (Double,Double,Double)
+sVec2dHV size (SVec sx sy) =
+    let sx',sy',size' :: Double
+	[sx',sy',size',ysize'] = map fi [sx,sy,size,ysize size]
+	y' = -sy' / ysize' / 3
+	x' = ((sx' / size') - y') / 2
+	z' = -((sx' / size') + y') / 2
+    in (x',y',z')
 
-thickLine :: Surface -> (Int16,Int16) -> (Int16,Int16) -> Float -> Pixel -> IO ()
-thickLine surf from@(x,y) to@(x',y') thickness col = do
-    let (dx,dy) = (x'-x,y'-y)
-	[rdx,rdy] = map fi [dx,dy]
-	s = thickness / (sqrt $ rdx^2 + rdy^2)
-	perp@(px,py) = (round $ s*rdy, round $ s*(-rdx))
-	mperp = (-px,-py)
-	addHalf (a,b) (c,d) = ( (2*a + c) `div` 2, (2*b + d) `div` 2 )
-    rimmedPolygon surf
-	(map (uncurry addHalf) [(from,perp),(to,perp),(from,mperp),(to,mperp)])
-	(dim col) (bright col)
+sVec2HexVec :: Int -> SVec -> HexVec
+sVec2HexVec size sv =
+    let (x',y',z') = sVec2dHV size sv
+	unrounded = Map.fromList [(1,x'),(2,y'),(3,z')]
+	rounded = Map.map round unrounded
+	maxdiff = fst $ maximumBy (compare `on` snd) $
+	    [ (i, abs $ c'-c) | i <- [1..3],
+		let c' = unrounded Map.! i, let c = fi $ rounded Map.! i]
+	[x,y,z] = map snd $ Map.toList $
+	    Map.adjust (\x -> x - (sum $ Map.elems rounded)) maxdiff rounded
+    in HexVec x y z
 
-thickLines surf verts thickness col =
-    sequence_ [ thickLine surf v v' thickness col |
-	(v,v') <- zip (take (length verts - 1) verts) (drop 1 verts) ]
 
-thickPolygon surf verts thickness col =
-    thickLines surf (verts ++ take 1 verts) thickness col
+data RenderContext = RenderContext
+    { renderSurf :: Surface
+    , renderBGSurf :: Maybe Surface
+    , renderHCentre :: HexPos
+    , renderSCentre :: SVec
+    , renderSize :: Int
+    , renderFont :: Maybe TTF.Font
+    }
+type RenderT = ReaderT RenderContext
 
-ysize :: Int -> Int
-ysize = (map (\size -> round $ fi size / sqrt 3) [0..] !!)
+runRenderT = runReaderT
 
-corner :: Integral i => SVec -> Int -> Int -> (i,i)
-corner (SVec x y) size hextant = (fi $ x+dx, fi $ y+dy)
-    where
-	[dx,dy] = f hextant
-	f 0 = [size, -ysize size]
-	f 1 = [0, -2*ysize size]
-	f 2 = [-size, -ysize size]
-	f n | n < 6 = let [x,y] = f (5-n) in [x,-y]
-	    | n < 0 = f (6-n)
-	    | otherwise = f (n`mod`6)
+displaceRender :: Monad m => FVec -> RenderT m a -> RenderT m a
+displaceRender v m = do
+    size <- asks renderSize
+    let FVec x y = fi size **^ v
+    let sv = SVec (round x) (round y)
+    displaceRenderSVec sv m
 
-innerCorner :: Integral i => SVec -> Int -> HexDir -> (i,i)
-innerCorner (SVec x y) size dir = (fi $ x+dx, fi $ y+dy)
-    where
-	[dx,dy] = f dir
-	f dir
-	    | dir == hu = [2*isize, 0]
-	    | dir == hv = [-isize, -ysize size]
-	    | dir == hw = [-isize, ysize size]
-	    | not (isHexDir dir) = error "innerCorner: not a hexdir"
-	    | otherwise = map (\z -> -z) $ f $ neg dir
-	isize = size `div` 3
+displaceRenderSVec :: Monad m => SVec -> RenderT m a -> RenderT m a
+displaceRenderSVec sv =
+    local $ \rc -> rc { renderSCentre = renderSCentre rc +^ sv }
 
-edge :: Integral i => SVec -> Int -> HexDir -> (i,i)
-edge (SVec x y) size dir = (fi $ x+dx, fi $ y+dy)
-    where
-	[dx,dy] = f dir
-	f dir
-	    | dir == hu = [size, 0]
-	    | dir == hv = [-size`div`2, -3*ysize size`div`2]
-	    | dir == hw = [-size`div`2, 3*ysize size`div`2]
-	    | not (isHexDir dir) = error "edge: not a hexdir"
-	    | otherwise = map (\z -> -z) $ f $ neg dir
+recentreAt :: Monad m => HexVec -> RenderT m a -> RenderT m a
+recentreAt v m = do
+    size <- asks renderSize
+    displaceRenderSVec (hexVec2SVec size v) m
 
-data ShowBlocks = ShowBlocksBlocking | ShowBlocksAll | ShowBlocksNone
-    deriving (Eq, Ord, Show, Read)
+rescaleRender :: Monad m => RealFrac n => n -> RenderT m a -> RenderT m a
+rescaleRender r = local $ \rc -> rc { renderSize = round $ r * (fi $ renderSize rc) }
 
-data Glyph
-    = TileGlyph Tile Pixel
-    | BlockedArm HexDir TorqueDir Pixel
-    | TurnedArm HexDir TorqueDir Pixel
-    | BlockedBlock Tile HexDir Pixel
-    | BlockedPush HexDir Pixel
-    | CollisionMarker
-    | HollowGlyph Pixel
-    | HollowInnerGlyph Pixel
-    | FilledHexGlyph Pixel
-    | ButtonGlyph Pixel
-    | UseFiveColourButton Bool
-    | ShowBlocksButton ShowBlocks
-    | ShowButtonTextButton Bool
-    | UseSoundsButton Bool
-    | WhsButtonsButton (Maybe WrHoSel)
-    | FullscreenButton Bool
-    | UnfreshGlyph
-    deriving (Eq, Ord, Show)
+withFont :: Monad m => Maybe TTF.Font -> RenderT m a -> RenderT m a
+withFont font = local $ \rc -> rc { renderFont = font }
 
-type SizedGlyph = (Glyph,Int)
-data CachedGlyphs = CachedGlyphs (Map SizedGlyph Surface) [SizedGlyph]
-    deriving (Eq, Ord, Show)
-emptyCachedGlyphs = CachedGlyphs Map.empty []
-maxCachedGlyphs = 100
+renderPos :: Monad m => Integral i => FVec -> RenderT m (i,i)
+renderPos v = do
+    size <- asks renderSize
+    let FVec dx dy = fi size **^ v
+    SVec x y <- asks renderSCentre
+    return $ (fi x + round dx, fi y + round dy)
+renderLen :: Monad m => Integral i => Float -> RenderT m i
+renderLen l = do
+    size <- asks renderSize
+    return $ round $ l * fi size
 
-renderGlyphCaching :: Glyph -> SVec -> Int -> Surface -> RenderM ()
--- Glyph caching:
---  We aim to cache glyphs which are "currently" being regularly drawn, so
---  they can be blitted from RAM rather than being drawn afresh each time.
---  Rather than track statistics, we adopt the following probabilistic scheme.
-renderGlyphCaching gl centre size surf = do
-    CachedGlyphs cmap clist <- lift get
-    let cacheFull = Map.size cmap >= maxCachedGlyphs
-    let mcsurf = Map.lookup sgl cmap
-    -- with probability 1 in (maxCachedGlyphs`div`2), we put this glyph at the
-    -- head of the cached list, throwing away the tail to make room if needed.
-    cacheIt <- (((cacheable &&) . (not cacheFull ||)) <$>) $
-	liftIO $ (==0) <$> randomRIO (0::Int,maxCachedGlyphs`div`2)
-    case mcsurf of
-	Nothing -> if cacheIt
-	    then do
-		csurf <- newGlyphSurf
-		renderOnCache csurf
-		addToCache cacheFull csurf
-		blitGlyph csurf
-	    else
-		liftIO $ renderGlyph gl centre size surf
-	Just csurf -> do
-	    when cacheIt promote
-	    blitGlyph csurf
-    where
-	sgl = (gl,size)
-	cacheable = case gl of
-	    -- some glyphs need to be drawn with blending - those involving
-	    -- anti-aliasing which bleed over the edge of the hex or which
-	    -- may be drawn on top of an existing glyph.
-	    -- TODO: we should find a way to deal with at least some of these;
-	    -- springs in particular are common and expensive to draw.
-	    -- Maybe we could truncate the spring glyphs to a hex?
-	    TileGlyph (BlockTile adjs) _ -> null adjs
-	    TileGlyph (SpringTile extn dir) _ -> False
-	    FilledHexGlyph _ -> False
-	    HollowGlyph _ -> False
-	    BlockedBlock _ _ _ -> False
-	    BlockedPush _ _ -> False
-	    CollisionMarker -> False
-	    _ -> True
-	w = size*2 + 1
-	h = ysize size*4 + 1
-	newGlyphSurf = do
-	    -- csurf <- liftIO $ createRGBSurface [] w h 32 0xff000000 0x00ff0000 0x0000ff00 0x000000ff
-	    csurf <- liftIO $ createRGBSurface [] w h 16 0 0 0 0
-	    liftIO $ setColorKey csurf [SrcColorKey,RLEAccel] $ Pixel 0
-	    return csurf
-	renderOnCache csurf =
-	    liftIO $ renderGlyph gl (SVec (w`div`2) (h`div`2)) size csurf
-	addToCache cacheFull csurf = do
-	    CachedGlyphs cmap clist <- lift get
-	    let cmap' = Map.insert sgl csurf cmap
-	    lift $ put $ if cacheFull
-		then CachedGlyphs (Map.delete (last clist) cmap') (sgl:List.init clist)
-		else CachedGlyphs cmap' (sgl:clist)
-	promote = do
-	    CachedGlyphs cmap clist <- lift get
-	    lift $ put $ CachedGlyphs cmap (sgl:List.delete sgl clist)
-	blitGlyph csurf =
-	    let SVec x y = centre
-	    in void $ liftIO $ blitSurface csurf Nothing surf $ Just $
-		Rect (x-w`div`2) (y-h`div`2) (w+1) (h+1)
 
-renderGlyph :: Glyph -> SVec -> Int -> Surface -> IO ()
-renderGlyph (TileGlyph (BlockTile adjs) col) centre size surf =
-    rimmedPolygon surf corners col $ bright col
-	where
-	    corners = concat [
-		if or $ map adjAt [0,1]
-		then [corner centre size $ hextant dir]
-		else if adjAt $ -1
-		    then []
-		    else [innerCorner centre size dir]
-		| dir <- hexDirs
-		, let adjAt r = rotate r dir `elem` adjs
-		]
+-- wrappers around sdl-gfx functions
+pixelR v col = do
+    (x,y) <- renderPos v
+    surf <- asks renderSurf
+    void.liftIO $ pixel surf x y col
 
-renderGlyph (TileGlyph (SpringTile extn dir) col) centre size surf =
-    thickLines surf points 1 $ brightness col
-	where
-	    n = 3*case extn of
-		Stretched -> 1
-		Relaxed -> 2
-		Compressed -> 4
-	    brightness = if extn == Relaxed then dim else bright
-	    dir' = if dir == zero then hu else dir
-	    (sx,sy) = corner centre size (hextant dir' - 1)
-	    (offx,offy) = corner centre size (hextant dir')
-	    (ex,ey) = corner centre size (hextant dir' - 3)
-	    points = [ (x+dx,y+dy)
-		| i <- [0..n]
-		, i`mod`3 /= 1
-		, let (x,y) = if i`mod`3==0 then (sx,sy) else (offx,offy)
-		, let (dx,dy) = ((i*(ex-sx))`div`n, (i*(ey-sy))`div`n) ]
+aaLineR v v' col = do
+    (x,y) <- renderPos v
+    (x',y') <- renderPos v'
+    surf <- asks renderSurf
+    void.liftIO $ aaLine surf x y x' y' col
 
-renderGlyph (TileGlyph (PivotTile dir) col) centre size surf = do
-    rimmedCircle surf centre rad col $ bright col
-    when (dir /= zero)
-	$ void $ aaLine surf `uncurry` from `uncurry` to $ bright col
-    return ()
-	where
-	    rad = (7*size)`div`8
-	    from = edge centre rad $ neg dir
-	    to = edge centre rad dir
+filledPolygonR verts fillCol = do
+    ps <- mapM renderPos verts
+    surf <- asks renderSurf
+    void.liftIO $ filledPolygon surf ps fillCol
 
-renderGlyph (TileGlyph (ArmTile dir _) col) centre size surf =
-    void $ thickLine surf from to 1 col
-	where
-	    dir' = if dir == zero then hu else dir
-	    from = edge centre size $ neg dir'
-	    to = innerCorner centre size dir'
+arcR v rad a1 a2 col = do
+    (x,y) <- renderPos v
+    r <- renderLen rad
+    surf <- asks renderSurf
+    void.liftIO $ arc surf x y r a1 a2 col
 
-renderGlyph (TileGlyph HookTile col) centre size surf =
-    rimmedCircle surf centre rad col $ bright col
-	where
-	    rad = (7*size)`div`8
+filledCircleR v rad col = do
+    (x,y) <- renderPos v
+    r <- renderLen rad
+    surf <- asks renderSurf
+    void.liftIO $ filledCircle surf x y r col
 
-renderGlyph (TileGlyph (WrenchTile mom) col) centre size surf = do
-    rimmedCircle surf centre (size`div`3) col $ bright col
-    when (mom /= zero) $
-	let
-	    (fx,fy) = innerCorner centre size $ neg mom
-	    (tx,ty) = edge centre size $ neg mom
-	    shifts = map (map (`div` 2)) $
-		[ [ x1-x0, y1-y0 ]
-		| rot <- [-1,0,1]
-		, let (x0,y0) = innerCorner centre size $ neg mom
-		, let (x1,y1) = innerCorner centre size $ rotate rot $ neg mom
-		]
-	in sequence_
-	    [ aaLine surf (fx+dx) (fy+dy) (tx+dx) (ty+dy) $ col
-	    | [dx,dy] <- shifts ]
+-- aaPolygon seems to be a bit buggy in sdl-gfx-0.6.0
+aaPolygonR verts col =
+    aaLinesR (verts ++ take 1 verts) col
 
-renderGlyph (TileGlyph BallTile col) centre size surf =
-    rimmedCircle surf centre rad (faint col) (obscure col)
-    where rad = (7*size)`div`8
+-- 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
+    else void.liftIO $ aaCircle surf x y r col
 
-renderGlyph (BlockedArm armdir tdir col) centre size surf =
-    void $ aaLine surf `uncurry` from `uncurry` to $ col
-	where
-	    from = innerCorner centre size $ rotate (2*tdir) armdir
-	    to = edge centre size $ rotate tdir armdir
 
-renderGlyph (TurnedArm armdir tdir col) centre size surf =
-    sequence_ [ arc surf (fi x) (fi y) (fi $ n*size `div` 4)
-	a1 a2 col | n <- [8,9] ]
-    where
-	SVec x y = centre +^ hexVec2SVec size (neg armdir)
-	a0 = fi $ -60*hextant armdir
-	a1' = a0 + fi tdir * 10
-	a2' = a0 + fi tdir * 30
-	a1 = min a1' a2'
-	a2 = max a1' a2'
+aaLinesR verts col =
+    sequence_ [ aaLineR v v' col |
+	(v,v') <- zip (take (length verts - 1) verts) (drop 1 verts) ]
 
-renderGlyph (BlockedBlock tile dir col) centre size surf =
-    renderGlyph (TileGlyph tile col) (shift +^ centre) size surf
-	where
-	    shift = SVec (x'-x) (y'-y)
-	    (x,y) = innerCorner centre size dir
-	    (x',y') = edge centre size dir
+rimmedPolygonR verts fillCol rimCol = do
+    filledPolygonR verts fillCol
+    aaPolygonR verts $ opaquify rimCol
+    return ()
 
-renderGlyph (BlockedPush dir col) centre size surf = do
-{-
-    void $ rimmedPolygon surf verts (obscure col) (dim col)
-	where verts =
-		[ innerCorner centre size $ rotate 1 dir
-		, innerCorner centre size $ rotate (-1) dir
-		, innerCorner centre size dir ]
--}
-    void $ thickLine surf base tip 1 col
-    --void $ aaLine surf `uncurry` from' `uncurry` to' $ col
-    void $ thickLine surf tip (arms!!0) 1 col
-    void $ thickLine surf tip (arms!!1) 1 col
-    where
-	--base@(bx,by) = innerCorner centre size dir
-	SVec bx' by' = centre
-	base@(bx,by) = (fi bx',fi by')
-	tip@(tx,hy) = edge centre size dir
-	arms = [(bx + (tx-bx)`div`2 + dir*(hy-by)`div`4,
-	    by + (hy-by)`div`2 - dir*(tx-bx)`div`4) | dir <- [-1,1]]
+rimmedCircleR v rad fillCol rimCol = void $ do
+    filledCircleR v rad fillCol
+    aaCircleR v rad $ opaquify rimCol
 
-	--from' = corner centre size $ hextant dir
-	--to' = corner centre size $ (hextant dir) - 1
+thickLineR :: (Functor m, MonadIO m) => FVec -> FVec -> Float -> Pixel -> RenderT m ()
+thickLineR from to thickness col =
+    let FVec dx dy = to -^ from
+        baseThickness = (1/16)
+	s = baseThickness * thickness / (sqrt $ dx^2 + dy^2)
+	perp = (s/2) **^ FVec dy (-dx)
+    in rimmedPolygonR
+        [ from +^ perp, to +^ perp
+        , to +^ neg perp, from +^ neg perp]
+	(dim col) (bright col)
 
-renderGlyph CollisionMarker centre@(SVec x y) size surf = void $ do
-    -- rimmedCircle surf centre (size`div`3) (bright purple) $ bright purple
-    aaLine surf `uncurry` start `uncurry` end $ col
-    circleAt surf centre rad col
-    where
-	[start,end] = map (corner centre (size`div`2)) [0,3]
-	rad = ysize size
-	col = dim purple
+thickLinesR verts thickness col =
+    sequence_ [ thickLineR v v' thickness col |
+	(v,v') <- zip (take (length verts - 1) verts) (drop 1 verts) ]
 
-renderGlyph (HollowGlyph col) centre size surf =
-    aaPolygon' surf corners $ opaquify col
-    where corners = map (corner centre size) [0..5]
-renderGlyph (HollowInnerGlyph col) centre size surf =
-    aaPolygon' surf corners $ opaquify col
-    where corners = [ innerCorner centre size dir | dir <- hexDirs ]
+thickPolygonR verts thickness col =
+    thickLinesR (verts ++ take 1 verts) thickness col
 
-renderGlyph (FilledHexGlyph col) centre size surf =
-    rimmedPolygon surf corners col $ brightish col
-    where corners = map (corner centre size) [0..5]
 
-renderGlyph (ButtonGlyph col) centre size surf =
-    renderGlyph (TileGlyph (BlockTile []) col) centre size surf
-
-renderGlyph (UseFiveColourButton using) centre size surf = do
-    mapM_ (\h -> renderGlyph (TileGlyph (BlockTile [])
-	    (dim $ colourWheel (if using then h`div`2 else 1)))
-	    (SVec `uncurry` corner centre (size`div`2) h) (size`div`2) surf)
-	[0,2,4]
-
-renderGlyph (ShowBlocksButton showing) centre size surf = do
-    renderGlyph (TileGlyph (BlockTile []) (dim red)) centre size surf
-    when (showing == ShowBlocksAll) $
-	renderGlyph (BlockedPush hu (bright orange)) centre size surf
-    when (showing /= ShowBlocksNone) $
-	renderGlyph (BlockedPush hw (bright purple)) centre size surf
-
-renderGlyph (ShowButtonTextButton showing) centre@(SVec x y) size surf = do
-    renderGlyph (ButtonGlyph (dim yellow)) (SVec `uncurry` edge centre (size`div`2) (neg hu)) (size`div`2) surf
-    when showing $
-	sequence_ [ pixel surf (fi $ x+size`div`3+(i*size`div`4)) (fi $ y - size`div`4) (bright white)
-	    | i <- [-1..1] ]
+ylen = 1 / sqrt 3
+ysize :: Int -> Int
+ysize = (map (\size -> round $ fi size * ylen) [0..] !!)
 
-renderGlyph (UseSoundsButton use) centre@(SVec x y) size surf = do
-    sequence [ arc surf (fi $ x - (2*size`div`3)) (fi y) r (-20) 20
-            (if use then bright green else dim red)
-        | r <- map fi $ map (*(size`div`3)) [1,2,3] ]
-    when (not use) $ void $ aaLine surf
-        `uncurry` (innerCorner centre size hw)
-        `uncurry` (innerCorner centre size $ neg hw) $ dim red
+corner :: Int -> FVec
+corner hextant = FVec x y
+    where
+	[x,y] = f hextant
+	f 0 = [1, -ylen]
+	f 1 = [0, -2*ylen]
+	f 2 = [-1, -ylen]
+	f n | n < 6 = let [x,y] = f (5-n) in [x,-y]
+	    | n < 0 = f (6-n)
+	    | otherwise = f (n`mod`6)
 
-renderGlyph (WhsButtonsButton Nothing) centre size surf =
-    renderGlyph (ButtonGlyph (dim red)) centre (size`div`3) surf
-    >> sequence_ [ renderGlyph (ButtonGlyph (dim purple))
-	(SVec `uncurry` edge centre (size`div`2) dir) (size`div`3) surf
-	| dir <- hexDirs ]
-renderGlyph (WhsButtonsButton (Just whs)) centre size surf = do
-    when (whs /= WHSHook) $
-	renderGlyph (TileGlyph (WrenchTile zero) col) (miniCentre 0) miniSize surf
-    when (whs /= WHSWrench) $ do
-	renderGlyph (TileGlyph HookTile col) (miniCentre 4) miniSize surf
-	renderGlyph (TileGlyph (ArmTile hv False) col) (miniCentre 2) miniSize surf
+innerCorner :: HexDir -> FVec
+innerCorner dir = FVec x y
     where
-	miniSize = size `div` 2
-	miniCentre h = SVec `uncurry` corner centre miniSize h
-	col = dim white
+	[x,y] = f dir
+	f dir
+	    | dir == hu = [2/3, 0]
+	    | dir == hv = [-1/3, -ylen]
+	    | dir == hw = [-1/3, ylen]
+	    | not (isHexDir dir) = error "innerCorner: not a hexdir"
+	    | otherwise = map (\z -> -z) $ f $ neg dir
 
-renderGlyph (FullscreenButton fs) centre size surf = do
-    thickPolygon surf corners 1 $ activeCol (not fs)
-    thickPolygon surf corners' 1 $ activeCol fs
+edge :: HexDir -> FVec
+edge dir = FVec x y
     where
-	activeCol True = opaquify $ dim green
-	activeCol False = opaquify $ dim red
-	size' = (2*size`div`3)
-	corners = [ (if dir `elem` [hu,neg hu] then edge else innerCorner) centre size' dir
-	    | dir <- hexDirs ]
-	corners' = map (corner centre size') [0..5]
+	[x,y] = f dir
+	f dir
+	    | dir == hu = [1, 0]
+	    | dir == hv = [-1/2, -3*ylen/2]
+	    | dir == hw = [-1/2, 3*ylen/2]
+	    | not (isHexDir dir) = error "edge: not a hexdir"
+	    | otherwise = map (\z -> -z) $ f $ neg dir
 
-renderGlyph (UnfreshGlyph) centre@(SVec x y) size surf = do
-    let col = bright red
-    renderGlyph (HollowInnerGlyph col) centre size surf
-    sequence_ [pixel surf (fi $ x+(i*size`div`4)) (fi y) col
-	| i <- [-1..1] ]
 
-playerGlyph col = FilledHexGlyph col
-
-cursorGlyph = HollowGlyph $ bright white
-
-ownedTileGlyph colouring highlight (owner,t) =
-    let col = colourOf colouring owner
-    in TileGlyph t $ (if owner `elem` highlight then bright else dim) col
-
-setPixelAlpha alpha (Pixel v) = Pixel $ v `div` 0x100 * 0x100 + alpha
-bright = setPixelAlpha 0xff
-brightish = setPixelAlpha 0xc0
-dim = setPixelAlpha 0xa0
-obscure = setPixelAlpha 0x80
-faint = setPixelAlpha 0x40
-invisible = setPixelAlpha 0x00
-
-pixelToRGBA (Pixel v) =
-    let (r,v') = divMod v 0x1000000
-	(g,v'') = divMod v' 0x10000
-	(b,a) = divMod v'' 0x100
-    in (r,g,b,a)
-rgbaToPixel (r,g,b,a) = Pixel $ a+0x100*(b+0x100*(g+0x100*r))
-opaquify p =
-    let (r,g,b,a) = pixelToRGBA p
-	[r',g',b'] = map (\v -> (v*a)`div`0xff) [r,g,b]
-    in rgbaToPixel (r',g',b',0xff)
-
 black = Pixel 0x01000000
 white = Pixel 0xffffff00
 orange = Pixel 0xff7f0000
@@ -464,123 +264,49 @@
 blue = colourWheel 4
 purple = colourWheel 5
 
+colourOf :: Ord i => Map i Int -> i -> Pixel
 colourOf colouring idx =
     case Map.lookup idx colouring of
 	    Nothing -> white
 	    Just n -> colourWheel n
 
-data SVec = SVec { cx, cy :: Int }
-    deriving (Eq, Ord, Show)
-instance Monoid SVec where
-    mempty = SVec 0 0
-    mappend (SVec x y) (SVec x' y') = SVec (x+x') (y+y')
-instance Grp SVec where
-    neg (SVec x y) = SVec (-x) (-y)
-type CCoord = PHS SVec
-
-hexVec2SVec :: Int -> HexVec -> SVec
-hexVec2SVec size (HexVec x y z) =
-    SVec ((x-z) * size) (-y * 3 * ysize size)
-
-sVec2dHV :: Int -> SVec -> (Double,Double,Double)
-sVec2dHV size (SVec sx sy) =
-    let sx',sy',size' :: Double
-	[sx',sy',size',ysize'] = map fi [sx,sy,size,ysize size]
-	y' = -sy' / ysize' / 3
-	x' = ((sx' / size') - y') / 2
-	z' = -((sx' / size') + y') / 2
-    in (x',y',z')
-
-sVec2HexVec :: Int -> SVec -> HexVec
-sVec2HexVec size sv =
-    let (x',y',z') = sVec2dHV size sv
-	unrounded = Map.fromList [(1,x'),(2,y'),(3,z')]
-	rounded = Map.map round unrounded
-	maxdiff = fst $ maximumBy (compare `on` snd) $
-	    [ (i, abs $ c'-c) | i <- [1..3],
-		let c' = unrounded Map.! i, let c = fi $ rounded Map.! i]
-	[x,y,z] = map snd $ Map.toList $
-	    Map.adjust (\x -> x - (sum $ Map.elems rounded)) maxdiff rounded
-    in HexVec x y z
-
-data RenderContext = RenderContext
-    { renderSurf :: Surface
-    , renderBGSurf :: Maybe Surface
-    , renderHCentre :: HexPos
-    , renderSCentre :: SVec
-    , renderSize :: Int
-    , renderFont :: Maybe TTF.Font
-    }
-type RenderM = ReaderT RenderContext (StateT CachedGlyphs IO)
-
-runRenderM :: RenderM a -> CachedGlyphs -> RenderContext -> IO (a,CachedGlyphs)
-runRenderM m cgs rc = runStateT (runReaderT m rc) cgs
-
-displaceRender :: SVec -> RenderM a -> RenderM a
-displaceRender disp = local displace
-    where displace rc = rc { renderSCentre = renderSCentre rc +^ disp }
-
-recentreAt :: HexVec -> RenderM a -> RenderM a
-recentreAt v m = do
-    size <- asks renderSize
-    displaceRender (hexVec2SVec size v) m
-
-rescaleRender :: RealFrac n => n -> RenderM a -> RenderM a
-rescaleRender r = local resize
-    where resize rc = rc { renderSize = round $ r * (fi $ renderSize rc) }
-
-withFont :: Maybe TTF.Font -> RenderM a -> RenderM a
-withFont font = local refont
-    where refont rc = rc { renderFont = font }
-
-erase :: RenderM ()
-erase = fillRectBG Nothing
-
-fillRectBG :: Maybe Rect -> RenderM ()
-fillRectBG mrect = do
-    surf <- asks renderSurf
-    mbgsurf <- asks renderBGSurf
-    void $ liftIO $ maybe
-	(fillRect surf mrect black)
-	(\bgsurf -> blitSurface bgsurf mrect surf mrect)
-	mbgsurf
-
-drawBasicBG :: Int -> RenderM ()
-drawBasicBG maxR = sequence_ [ drawAtRel (HollowGlyph $ colAt v) v | v <- hexDisc maxR ]
-    where
-	colAt v@(HexVec hx hy hz) = let
-		[r,g,b] = map (\h -> fi $ ((0xff*)$ 5 + abs h)`div`maxR) [hx,hy,hz]
-		a = fi $ (0x90 * (maxR - abs (hexLen v)))`div`maxR
-	    in rgbaToPixel (r,g,b,a)
-
-drawAt :: Glyph -> HexPos -> RenderM ()
-drawAt gl pos = do
-	centre <- asks renderHCentre
-	drawAtRel gl (pos -^ centre)
+setPixelAlpha alpha (Pixel v) = Pixel $ v `div` 0x100 * 0x100 + alpha
+bright = setPixelAlpha 0xff
+brightish = setPixelAlpha 0xc0
+dim = setPixelAlpha 0xa0
+obscure = setPixelAlpha 0x80
+faint = setPixelAlpha 0x40
+invisible = setPixelAlpha 0x00
 
-drawAtRel :: Glyph -> HexVec -> RenderM ()
-drawAtRel gl v = do
-	(surf, scrCentre, size) <- asks $ liftM3 (,,) renderSurf renderSCentre renderSize
-	let cpos = scrCentre +^ (hexVec2SVec size v)
-	renderGlyphCaching gl cpos size surf
+pixelToRGBA (Pixel v) =
+    let (r,v') = divMod v 0x1000000
+	(g,v'') = divMod v' 0x10000
+	(b,a) = divMod v'' 0x100
+    in (r,g,b,a)
+rgbaToPixel (r,g,b,a) = Pixel $ a+0x100*(b+0x100*(g+0x100*r))
+opaquify p =
+    let (r,g,b,a) = pixelToRGBA p
+	[r',g',b'] = map (\v -> (v*a)`div`0xff) [r,g,b]
+    in rgbaToPixel (r',g',b',0xff)
 
 messageCol = white
 dimWhiteCol = Pixel 0xa0a0a000
 buttonTextCol = white
 errorCol = red
 
+
 pixelToColor p =
     let (r,g,b,_) = pixelToRGBA p
     in Color (fi r) (fi g) (fi b)
 
-renderStrColAtLeft = renderStrColAt' False
+renderStrColAt,renderStrColAtLeft :: (Functor m, MonadIO m) => Pixel -> String -> HexVec -> RenderT m ()
 renderStrColAt = renderStrColAt' True
-renderStrColAt' :: Bool -> Pixel -> String -> HexVec -> RenderM ()
+renderStrColAtLeft = renderStrColAt' False
+renderStrColAt' :: (Functor m, MonadIO m) => Bool -> Pixel -> String -> HexVec -> RenderT m ()
 renderStrColAt' centred c str v = void $ runMaybeT $ do
     font <- MaybeT $ asks renderFont
     fsurf <- MaybeT $ liftIO $ TTF.tryRenderTextBlended font str $ pixelToColor c
-    (surf, scrCentre, size) <- lift $ asks $
-	liftM3 (,,) renderSurf renderSCentre renderSize
+    (surf, scrCentre, size) <- lift $ asks $ liftM3 (,,) renderSurf renderSCentre renderSize
     let SVec x y = scrCentre +^ (hexVec2SVec size v)
 	    +^ neg (SVec 0 ((surfaceGetHeight fsurf-1)`div`2) +^
 		if centred
@@ -588,56 +314,33 @@
 		    else SVec 0 0)
     void $ liftIO $ blitSurface fsurf Nothing surf (Just $ Rect x y 0 0)
 
+renderStrColAbove,renderStrColBelow :: (Functor m, MonadIO m) => Pixel -> String -> HexVec -> RenderT m ()
 renderStrColAbove = renderStrColVShifted True
 renderStrColBelow = renderStrColVShifted False
-renderStrColVShifted :: Bool -> Pixel -> String -> HexVec -> RenderM ()
-renderStrColVShifted up c str v = do
-    size <- asks renderSize
-    displaceRender (SVec size 0) $ renderStrColAt c str $ v +^ (if up then hv else hw)
+renderStrColVShifted :: (Functor m, MonadIO m) => Bool -> Pixel -> String -> HexVec -> RenderT m ()
+renderStrColVShifted up c str v =
+    displaceRender (FVec 1 0) $ renderStrColAt c str $ v +^ (if up then hv else hw)
 
+erase :: (Functor m, MonadIO m) => RenderT m ()
+erase = fillRectBG Nothing
+
+fillRectBG :: (Functor m, MonadIO m) => Maybe Rect -> RenderT m ()
+fillRectBG mrect = do
+    surf <- asks renderSurf
+    mbgsurf <- asks renderBGSurf
+    void $ liftIO $ maybe
+	(fillRect surf mrect black)
+	(\bgsurf -> blitSurface bgsurf mrect surf mrect)
+	mbgsurf
+
 blankRow v = do
-    (surf, scrCentre, size) <- asks $
-	liftM3 (,,) renderSurf renderSCentre renderSize
+    (surf, scrCentre, size) <- asks $ liftM3 (,,) renderSurf renderSCentre renderSize
     let SVec _ y = scrCentre +^ (hexVec2SVec size v)
 	w = surfaceGetWidth surf
 	h = ceiling $ fi (size * 3 `div` 2) * 2 / sqrt 3
     fillRectBG $ Just $ Rect 0 (y-h`div`2) w h
 
-drawCursorAt :: Maybe HexPos -> RenderM ()
-drawCursorAt (Just pos) = drawAt cursorGlyph pos
-drawCursorAt _ = return ()
-
-drawBlocked :: GameState -> PieceColouring -> Bool -> Force -> RenderM ()
-drawBlocked st colouring blocking (Torque idx dir) = do
-    let (pos,arms) = case getpp st idx of
-	    PlacedPiece pos (Pivot arms) -> (pos,arms)
-	    PlacedPiece pos (Hook arm _) -> (pos,[arm])
-	    _ -> (pos,[])
-	col = if blocking then bright $ purple else dim $ colourOf colouring idx
-    sequence_ [ drawAt (BlockedArm arm dir col) (arm +^ pos) |
-	arm <- arms ]
-drawBlocked st colouring blocking (Push idx dir) = do
-    let footprint = plPieceFootprint $ getpp st idx
-	fullfootprint = fullFootprint st idx
-	col = bright $ if blocking then purple else orange
-    sequence_ [ drawAt (BlockedPush dir col) pos
-	| pos <- footprint
-	, (dir+^pos) `notElem` fullfootprint ]
-    -- drawAt (blockedPush dir $ bright orange) $ placedPos $ getpp st idx
-
-drawApplied :: GameState -> PieceColouring -> Force -> RenderM ()
-drawApplied st colouring (Torque idx dir) = do
-    let (pos,arms) = case getpp st idx of
-	    PlacedPiece pos (Pivot arms) -> (pos,arms)
-	    PlacedPiece pos (Hook arm _) -> (pos,[arm])
-	    _ -> (pos,[])
-	col = dim $ colourOf colouring idx
-    sequence_ [ drawAt (TurnedArm arm dir col) (arm +^ pos) |
-	    arm <- arms ]
-drawApplied _ _ _ = return ()
-
-
-blitAt :: Surface -> HexVec -> RenderM ()
+blitAt :: (Functor m, MonadIO m) => Surface -> HexVec -> RenderT m ()
 blitAt surface v = do
     (surf, scrCentre, size) <- asks $ liftM3 (,,) renderSurf renderSCentre renderSize
     let SVec x y = scrCentre +^ (hexVec2SVec size v)
diff --git a/SDLUI.hs b/SDLUI.hs
--- a/SDLUI.hs
+++ b/SDLUI.hs
@@ -49,6 +49,7 @@
 import Mundanities
 import Metagame
 import SDLRender
+import SDLGlyph
 import InputMode
 import Maxlocksize
 import Util
@@ -163,8 +164,8 @@
 	    ++ [ singleButton tr CmdOpen 1 [("open", hu+^neg hw)] ]
 	IMReplay -> [ markGroup ]
 	IMMeta ->
-	    [ singleButton serverPos CmdSetServer 0 [("server",3*^hw)]
-	    , singleButton (serverPos+^neg hu) CmdToggleCacheOnly 0 [("cache",hv+^6*^neg hu),("only",hw+^5*^neg hu)]
+	    [ 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)]
 	    ]
@@ -705,7 +706,8 @@
     smallFont <- gets dispFontSmall
     renderToMain $ sequence_ $ concat [ [ do
 		drawAtRel (ButtonGlyph col) v
-		renderStrColAt buttonTextCol bdg v
+		(if length bdg > 2 then withFont smallFont else id) $
+                    renderStrColAt buttonTextCol bdg v
 		when showBT $
 		    withFont smallFont $ recentreAt v $ rescaleRender (1/4) $
 		    sequence_ [ renderStrColAtLeft white s dv | (s,dv) <- helps ]
diff --git a/SDLUIMInstance.hs b/SDLUIMInstance.hs
--- a/SDLUIMInstance.hs
+++ b/SDLUIMInstance.hs
@@ -48,6 +48,7 @@
 import Util
 import InputMode
 import SDLRender
+import SDLGlyph
 import SDLUI
 
 instance UIMonad (StateT UIState IO) where
@@ -123,7 +124,7 @@
 	    lift $ do
 		smallFont <- gets dispFontSmall
 		renderToMain $ withFont smallFont $ renderStrColAtLeft purple
-			(saddrStr saddr ++ if cOnly then " (cache only)" else "")
+			(saddrStr saddr ++ if cOnly then " (offline mode)" else "")
 		    $ serverPos +^ hu
 
 	    when (length names > 1) $ lift $ registerButton
@@ -164,7 +165,8 @@
 				    (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)]
-				    registerButton (interactButtonsPos+^hw) (CmdViewSolution Nothing) 1 [("view",hu+^neg hw),("soln",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
@@ -254,13 +256,20 @@
 
     reportAlerts = playAlertSounds
 
-    getChRaw = do
-	events <- liftIO getEvents
-	if not.null $ [ True | MouseButtonDown _ _ ButtonRight <- events ]
-	then return Nothing
-	else maybe getChRaw (return.Just) $ listToMaybe $ [ ch
-	    | KeyDown (Keysym _ _ ch) <- events
-	    , ch /= '\0' ]
+    getChRaw = resetMouseButtons >> getChRaw'
+        where
+            resetMouseButtons = modify $ \s -> s
+                { leftButtonDown = Nothing
+                , middleButtonDown = Nothing
+                , rightButtonDown = Nothing
+                }
+            getChRaw' = do
+                events <- liftIO getEvents
+                if not.null $ [ True | MouseButtonDown _ _ ButtonRight <- events ]
+                then return Nothing
+                else maybe getChRaw' (return.Just) $ listToMaybe $ [ ch
+                    | KeyDown (Keysym _ _ ch) <- events
+                    , ch /= '\0' ]
 
     setUIBinding mode cmd ch =
 	modify $ \s -> s { uiKeyBindings =
@@ -732,8 +741,8 @@
 drawNameWithCharAndCol :: String -> Pixel -> Char -> Pixel -> HexVec -> MainStateT UIM ()
 drawNameWithCharAndCol name charcol char col pos = do
     size <- fi.snd <$> lift getGeom
-    let up = SVec 0 $ - (ysize size - size`div`2)
-    let down = SVec 0 $ ysize size
+    let up = FVec 0 $ 1/2 - ylen
+    let down = FVec 0 $ ylen
     smallFont <- lift $ gets dispFontSmall
     lift.renderToMain $ do
 	drawAtRel (playerGlyph col) pos
@@ -786,7 +795,7 @@
 
     size <- snd <$> lift getGeom
     lift $ do
-	renderToMain $ displaceRender (SVec size 0) $ renderStrColAt (brightish white) "UNLOCKED BY" $ accessedByPos +^ hv
+	renderToMain $ displaceRender (FVec 1 0) $ renderStrColAt (brightish white) "UNLOCKED BY" $ accessedByPos +^ hv
 	registerSelectable (accessedByPos +^ hv) 0 SelPrivyHeader
 	registerSelectable (accessedByPos +^ hv +^ hu) 0 SelPrivyHeader
     if public lockinfo
@@ -829,7 +838,7 @@
 				renderToMain (drawAtRel (HollowGlyph $ dim green) pos)))
 
     lift $ do
-	renderToMain $ displaceRender (SVec size 0) $ renderStrColAt (brightish white) "SECURING" $ notesPos +^ hv
+	renderToMain $ displaceRender (FVec 1 0) $ renderStrColAt (brightish white) "SECURING" $ notesPos +^ hv
 	registerSelectable (notesPos +^ hv) 0 SelNotesHeader
 	registerSelectable (notesPos +^ hv +^ hu) 0 SelNotesHeader
     if null $ notesSecured lockinfo
diff --git a/Server.hs b/Server.hs
--- a/Server.hs
+++ b/Server.hs
@@ -8,6 +8,8 @@
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see http://www.gnu.org/licenses/.
 
+{-# LANGUAGE ScopedTypeVariables #-}
+
 module Main where
 
 import Network.Fancy
@@ -29,7 +31,7 @@
 import System.IO
 import System.FilePath
 import System.Directory (renameFile)
-import qualified Data.ByteString.Lazy as L
+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
@@ -49,6 +51,10 @@
 import Data.Time.Format
 import Data.Time.LocalTime
 
+import Crypto.Types.PubKey.RSA (PublicKey, PrivateKey)
+import Codec.Crypto.RSA (decrypt, generateKeyPair, RSAError)
+import Crypto.Random (newGenIO, SystemRandom)
+
 import qualified Text.Email.Validate
 import qualified Network.Mail.SMTP as SMTP
 
@@ -108,7 +114,7 @@
 	dbpath = fromMaybe "intricacydb" $ listToMaybe [ p | DBDir p <- opts ]
 	mfeedPath = listToMaybe [ p | FeedPath p <- opts ]
 	locksize = min maxlocksize $ fromMaybe 8 $ listToMaybe [ s | ServerLockSize s <- opts ]
-    withDB dbpath $ setDefaultServerInfo locksize
+    withDB dbpath $ setDefaultServerInfo locksize >> setKeyPair
     writeFile (lockFilePath dbpath) ""
     logh <- case listToMaybe [ f | LogFile f <- opts ] of
 	Nothing -> return stdout
@@ -120,6 +126,17 @@
     alreadySet <- recordExists RecServerInfo
     unless alreadySet $ putRecord RecServerInfo (RCServerInfo $ defaultServerInfo locksize)
 
+rsaKeyLength = 2048
+
+setKeyPair :: DBM ()
+setKeyPair = do
+    alreadySet <- recordExists RecPublicKey
+    unless alreadySet $ do
+        g <- liftIO newGenIO :: DBM SystemRandom
+        let (publicKey, secretKey, _) = generateKeyPair g rsaKeyLength
+        putRecord RecPublicKey $ RCPublicKey publicKey
+        putRecord RecSecretKey $ RCSecretKey secretKey
+
 -- | We lock the whole database during each request, using haskell's native
 -- file locking, meaning that we have at any time one writer *xor* any number
 -- of readers.
@@ -142,7 +159,7 @@
     handler' hdl addr
     where handler' hdl addr = do
 	    response <- handle (\e -> return $ ServerError $ show (e::SomeException)) $ do
-		request <- B.decode <$> L.hGetContents hdl
+		request <- B.decode <$> BL.hGetContents hdl
 		let hostname = case addr of
 			IP n _ -> n
 			IPv4 n _ -> n
@@ -156,7 +173,7 @@
 		now' <- liftIO getCurrentTime
 		logit logh $ show now' ++ ": " ++ hashedHostname ++ " <<< " ++ showResponse response
 		return response
-	    L.hPut hdl $ B.encode response
+	    BL.hPut hdl $ B.encode response
 
 showRequest :: ClientRequest -> String
 showRequest (ClientRequest ver mauth act) = show ver ++ " "
@@ -179,6 +196,7 @@
     let lockMode = case action of
 	    Authenticate -> ReadMode
 	    GetServerInfo -> ReadMode
+	    GetPublicKey -> ReadMode
 	    GetLock _ -> ReadMode
 	    GetUserInfo _ _ -> ReadMode
 	    GetRetired _ -> ReadMode
@@ -235,6 +253,7 @@
 		ResetPassword passwd -> resetPassword auth passwd >> return ServerAck
 		SetEmail address -> setEmail auth address >> return ServerAck
 		GetServerInfo -> ServedServerInfo <$> getServerInfo
+		GetPublicKey -> ServedPublicKey <$> getPublicKey
 		GetLock ls -> ServedLock <$> getLock ls
 		GetRetired name -> ServedRetired <$> getRetired name
 		GetUserInfo name mversion -> (do
@@ -342,6 +361,9 @@
 	getServerInfo = do
 	    RCServerInfo sinfo <- getRecordErrored $ RecServerInfo
 	    return sinfo
+	getPublicKey = do
+	    RCPublicKey publicKey <- getRecordErrored $ RecPublicKey
+	    return publicKey
 	getRetired name = do
 	    RCLockSpecs lss <- fromMaybe (RCLockSpecs []) <$> (erroredDB $ getRecord $ RecRetiredLocks name)
 	    return lss
@@ -361,25 +383,35 @@
 	    let Just (Auth name _) = auth
 	    getUserInfo name
 
+        decryptPassword :: String -> ExceptT String IO String
+        decryptPassword pw = do
+            RCSecretKey secretKey <- getRecordErrored RecSecretKey
+            liftIO $ evaluate (CS.unpack . BL.toStrict .
+                decrypt secretKey . BL.fromStrict . CS.pack $ pw)
+                -- <=intricacy-0.6.2 sends the hashed password unencrypted
+                `catch` \(e :: RSAError) -> return pw
 	checkAuth :: Maybe Auth -> ExceptT String IO ()
 	checkAuth Nothing = throwE "Authentication required"
 	checkAuth (Just (Auth name pw)) = do
 	    exists <- checkCodeName name
 	    unless exists $ throwE "No such user"
-	    RCPassword pw' <- getRecordErrored (RecPassword name)
-	    when (pw /= pw') $ throwE "Wrong password"
+	    RCPassword correctPw <- getRecordErrored (RecPassword name)
+            pw' <- decryptPassword pw
+            when (pw' /= correctPw) $ throwE "Wrong password"
 	newUser :: Maybe Auth -> ExceptT String IO ()
 	newUser Nothing = throwE "Require authentication"
 	newUser (Just (Auth name pw)) = do
 	    exists <- checkCodeName name
 	    when exists $ throwE "Codename taken"
-	    erroredDB $ putRecord (RecPassword name) (RCPassword pw)
+            pw' <- decryptPassword pw
+	    erroredDB $ putRecord (RecPassword name) (RCPassword pw')
 	    erroredDB $ putRecord (RecUserInfo name) (RCUserInfo $ (1,initUserInfo name))
 	    erroredDB $ putRecord (RecUserInfoLog name) (RCUserInfoDeltas [])
-	resetPassword Nothing pw = throwE "Authentication required"
+	resetPassword Nothing _ = throwE "Authentication required"
 	resetPassword auth@(Just (Auth name _)) newpw = do
 	    checkAuth auth
-	    erroredDB $ putRecord (RecPassword name) (RCPassword newpw)
+            newpw' <- decryptPassword newpw
+	    erroredDB $ putRecord (RecPassword name) (RCPassword newpw')
 	setEmail Nothing _ = throwE "Authentication required"
 	setEmail auth@(Just (Auth name _)) addressStr = do
 	    checkAuth auth
@@ -437,11 +469,11 @@
 	    addDelta name $ LockDelta idx $ SetPubNote note
 	    publified <- checkSuffPubNotes al
 	    unless publified $ do
-	    lock <- getCurrALock al
-	    accessorsOfNotesOnLock <- ((++ map noteAuthor (lockSolutions lock)).concat)
-		<$> (sequence
-		    [ accessedBy <$> getCurrALock behind | NoteInfo _ (Just behind) _ <- lockSolutions lock ] )
-	    forM_ accessorsOfNotesOnLock $ checkSuffReadNotes al
+                lock <- getCurrALock al
+                accessorsOfNotesOnLock <- ((++ map noteAuthor (lockSolutions lock)).concat)
+                    <$> (sequence
+                        [ accessedBy <$> getCurrALock behind | NoteInfo _ (Just behind) _ <- lockSolutions lock ] )
+                forM_ accessorsOfNotesOnLock $ checkSuffReadNotes al
 	checkSuffReadNotes target name = do
 	    info <- getCurrUserInfo name
 	    tlock <- getCurrALock target
@@ -449,8 +481,7 @@
 		when (countRead info tlock == notesNeeded) $
 		    accessLock name target tlock
 	checkSuffPubNotes al@(ActiveLock name idx) = do
-	    info <- getCurrUserInfo name
-	    let Just lock = userLocks info ! idx
+            lock <- getCurrALock al
 	    let countPub = fromIntegral $ length $
 		    filter (isNothing.noteBehind) $ lockSolutions lock
 	    if (countPub == notesNeeded)
diff --git a/Version.hs b/Version.hs
--- a/Version.hs
+++ b/Version.hs
@@ -11,4 +11,4 @@
 module Version where
 
 version :: String
-version = "0.6.2"
+version = "0.7"
diff --git a/intricacy.cabal b/intricacy.cabal
--- a/intricacy.cabal
+++ b/intricacy.cabal
@@ -1,5 +1,5 @@
 name:                intricacy
-version:             0.6.2
+version:             0.7
 synopsis:            A game of competitive puzzle-design
 homepage:            http://mbays.freeshell.org/intricacy
 license:             GPL-3
@@ -59,6 +59,7 @@
         , binary >=0.5, network-fancy >= 0.1.5
         , cryptohash >= 0.8
         , safe >= 0.2
+        , RSA >= 2.0, crypto-pubkey-types >= 0.2, crypto-api >= 0.10
       if flag(SDL)
           build-depends: SDL >=0.6.5, SDL-ttf >=0.6, SDL-gfx >=0.6
           if flag(Sound)
@@ -103,8 +104,8 @@
       CursesRender, CursesUI, CursesUIMInstance, CVec, Database, Debug,
       EditGameState, Frame, GameState, GameStateTypes, GraphColouring, Hex, Init,
       InputMode, Interact, InteractUtil, KeyBindings, Lock, MainState,
-      Maxlocksize, Metagame, Mundanities, Physics, Protocol, SDLRender, SDLUI,
-      SDLUIMInstance, ServerAddr, Util, Version
+      Maxlocksize, Metagame, Mundanities, Physics, Protocol, SDLGlyph,
+      SDLRender, SDLUI, SDLUIMInstance, ServerAddr, Util, Version
 
 executable intricacy-server
   if flag(Server)
@@ -116,6 +117,7 @@
         , array >=0.3, containers >=0.4, vector >=0.9
         , binary >=0.5, network-fancy >= 0.1.5
         , cryptohash >= 0.8
+        , RSA >= 2.0, crypto-pubkey-types >= 0.2, crypto-api >= 0.10
         , random >= 1.0, pipes >= 4
         , feed >= 0.3.1, xml >= 1.2.6
         , email-validate >= 1.0.0, text, smtp-mail >= 0.1.4.1