MainState.hs

   1 -- This file is part of Intricacy
   2 -- Copyright (C) 2013 Martin Bays <mbays@sdf.org>
   3 --
   4 -- This program is free software: you can redistribute it and/or modify
   5 -- it under the terms of version 3 of the GNU General Public License as
   6 -- published by the Free Software Foundation, or any later version.
   7 --
   8 -- You should have received a copy of the GNU General Public License
   9 -- along with this program.  If not, see http://www.gnu.org/licenses/.
  10
  11 module MainState where
  12
  13 import Control.Monad.State
  14 import Control.Applicative
  15 import qualified Data.Vector as Vector
  16 import qualified Data.Map as Map
  17 import Data.Map (Map)
  18 import Control.Monad.Writer
  19 import Control.Monad.Trans.Maybe
  20 import Data.Maybe
  21 import Data.Char
  22 import Data.List
  23 import Control.Concurrent.STM
  24 import Control.Concurrent
  25 import System.Directory
  26 import System.FilePath
  27 import Data.Time.Clock
  28 import Data.Array
  29 import Data.Function (on)
  30 import Safe
  31
  32 import Hex
  33 import Mundanities
  34 import AsciiLock
  35 import GameStateTypes
  36 import Physics
  37 import Command
  38 import Frame
  39 import Lock
  40 import Cache
  41 import Database
  42 import Protocol
  43 import Metagame
  44 import ServerAddr
  45 import InputMode
  46 import Util
  47
  48 class (Applicative m, MonadIO m) => UIMonad m where
  49     runUI :: m a -> IO a
  50     initUI :: m Bool
  51     endUI :: m ()
  52     drawMainState :: MainStateT m ()
  53     reportAlerts :: GameState -> [Alert] -> m ()
  54     drawMessage :: String -> m ()
  55     drawPrompt :: Bool -> String -> m ()
  56     endPrompt :: m ()
  57     drawError :: String -> m ()
  58     showHelp :: InputMode -> HelpPage -> m Bool
  59     getInput :: InputMode -> m [ Command ]
  60     getChRaw :: m ( Maybe Char )
  61     unblockInput :: m (IO ())
  62     setUIBinding :: InputMode -> Command -> Char -> m ()
  63     getUIBinding :: InputMode -> Command -> m String
  64     impatience :: Int -> m Bool
  65     toggleColourMode :: m ()
  66     warpPointer :: HexPos -> m ()
  67     getUIMousePos :: m (Maybe HexPos)
  68     setYNButtons :: m ()
  69     onNewMode :: InputMode -> m ()
  70     withNoBG :: m () -> m ()
  71     suspend,redraw :: m ()
  72
  73     doUI :: m a -> IO (Maybe a)
  74     doUI m = runUI $ do
  75         ok <- initUI
  76         if ok then m >>= (endUI >>).return.Just else return Nothing
  77
  78 -- | this could be neatened using GADTs
  79 data MainState
  80     = PlayState
  81         { psCurrentState::GameState
  82         , psFrame::Frame
  83         , psLastAlerts::[Alert]
  84         , wrenchSelected::Bool
  85         , psSolved::Bool
  86         , psGameStateMoveStack::[(GameState, PlayerMove)]
  87         , psUndoneStack::[(GameState, PlayerMove)]
  88         , psTitle::Maybe String
  89         , psIsTut::Bool
  90         , psIsSub::Bool
  91         , psSaved::Bool
  92         , psMarks::Map Char MainState
  93         }
  94     | ReplayState
  95         { rsCurrentState::GameState
  96         , rsLastAlerts::[Alert]
  97         , rsMoveStack::[PlayerMove]
  98         , rsGameStateMoveStack::[(GameState, PlayerMove)]
  99         , rsTitle::Maybe String
 100         , rsMarks::Map Char MainState
 101         }
 102     | EditState
 103         { esGameStateStack::[GameState]
 104         , esUndoneStack::[GameState]
 105         , esFrame::Frame
 106         , esPath::Maybe FilePath
 107         , esTested::Maybe (GameState,Solution)
 108         , lastSavedState::Maybe (GameState, Bool)
 109         , selectedPiece::Maybe PieceIdx
 110         , selectedPos::HexPos
 111         , lastModPos::HexPos
 112         , esMarks::Map Char GameState
 113         }
 114     | MetaState
 115         { curServer :: ServerAddr
 116         , undeclareds :: [Undeclared]
 117         , partialSolutions :: PartialSolutions
 118         , tutProgress :: TutProgress
 119         , cacheOnly :: Bool
 120         , curAuth :: Maybe Auth
 121         , codenameStack :: [Codename]
 122         , newAsync :: TVar Bool
 123         , asyncCount :: TVar Int
 124         , asyncError :: TVar (Maybe String)
 125         , asyncInvalidate :: TVar (Maybe Codenames)
 126         , randomCodenames :: TVar [Codename]
 127         , userInfoTVs :: Map Codename (TVar FetchedRecord, UTCTime)
 128         , indexedLocks :: Map LockSpec (TVar FetchedRecord)
 129         , retiredLocks :: Maybe [LockSpec]
 130         , curLockPath :: FilePath
 131         , curLock :: Maybe (Lock,Maybe Solution)
 132         , listOffset :: Int
 133         }
 134
 135 type MainStateT = StateT MainState
 136
 137 data HelpPage = HelpPageInput | HelpPageGame | HelpPageInitiated | HelpPageFirstEdit
 138     deriving (Eq, Ord, Show, Enum)
 139
 140 ms2im :: MainState -> InputMode
 141 ms2im mainSt = case mainSt of
 142     PlayState {} -> IMPlay
 143     ReplayState {} -> IMReplay
 144     EditState {} -> IMEdit
 145     MetaState {} -> IMMeta
 146
 147 newPlayState (frame,st) title isTut sub saved = PlayState st frame [] False False [] [] title isTut sub saved Map.empty
 148 newReplayState st soln title = ReplayState st [] soln [] title Map.empty
 149 newEditState (frame,st) msoln mpath = EditState [st] [] frame mpath
 150     ((\s->(st,s))<$>msoln) (Just (st, isJust msoln)) Nothing (PHS zero) (PHS zero) Map.empty
 151 initMetaState = do
 152     flag <- atomically $ newTVar False
 153     errtvar <- atomically $ newTVar Nothing
 154     invaltvar <- atomically $ newTVar Nothing
 155     rnamestvar <- atomically $ newTVar []
 156     counttvar <- atomically $ newTVar 0
 157     (saddr', auth, path) <- confFilePath "metagame.conf" >>=
 158         liftM (fromMaybe (defaultServerAddr, Nothing, "")) . readReadFile
 159     let saddr = updateDefaultSAddr saddr'
 160     let names = maybeToList $ authUser <$> auth
 161     (undecls,partials,tut) <- readServerSolns saddr
 162     mlock <- fullLockPath path >>= readLock
 163     return $ MetaState saddr undecls partials tut False auth names flag counttvar errtvar invaltvar rnamestvar Map.empty Map.empty Nothing path mlock 0
 164
 165 type PartialSolutions = Map LockSpec SavedPlayState
 166 type TutProgress = (Int,Maybe SavedPlayState)
 167 data SavedPlayState = SavedPlayState [PlayerMove] (Map Char [PlayerMove])
 168     deriving (Eq, Ord, Show, Read)
 169
 170 savePlayState :: MainState -> SavedPlayState
 171 savePlayState ps = SavedPlayState (getMoves ps) $ Map.map getMoves $ psMarks ps
 172     where getMoves = reverse . map snd . psGameStateMoveStack
 173
 174 restorePlayState :: SavedPlayState -> Lock -> (Maybe String) -> Bool -> Bool -> Bool -> MainState
 175 restorePlayState (SavedPlayState pms markPMs) (frame,st) title isTut sub saved =
 176     (stateAfterMoves pms) { psMarks = Map.map stateAfterMoves markPMs }
 177     where
 178         stateAfterMoves pms = let (stack,st') = applyMoves st pms
 179             in (newPlayState (frame, st') title isTut sub saved) { psGameStateMoveStack = stack }
 180         applyMoves st pms = foldl tick ([],st) pms
 181         tick :: ([(GameState,PlayerMove)],GameState) -> PlayerMove -> ([(GameState,PlayerMove)],GameState)
 182         tick (stack,st) pm = ((st,pm):stack,fst . runWriter $ physicsTick pm st)
 183
 184 readServerSolns :: ServerAddr -> IO ([Undeclared],PartialSolutions,TutProgress)
 185 readServerSolns saddr = if nullSaddr saddr then return ([],Map.empty,(1,Nothing)) else do
 186     undecls <- confFilePath ("undeclared" ++ [pathSeparator] ++ saddrPath saddr) >>=
 187         liftM (fromMaybe []) . readReadFile
 188     partials <- confFilePath ("partialSolutions" ++ [pathSeparator] ++ saddrPath saddr) >>=
 189         liftM (fromMaybe Map.empty) . readReadFile
 190     tut <- confFilePath "tutProgress" >>=
 191         liftM (fromMaybe (1,Nothing)) . readReadFile
 192     return (undecls,partials,tut)
 193
 194 writeServerSolns saddr ms@(MetaState { undeclareds=undecls,
 195 partialSolutions=partials, tutProgress=tut }) = unless (nullSaddr saddr) $ do
 196     confFilePath ("undeclared" ++ [pathSeparator] ++ saddrPath saddr) >>= flip writeReadFile undecls
 197     confFilePath ("partialSolutions" ++ [pathSeparator] ++ saddrPath saddr) >>= flip writeReadFile partials
 198     confFilePath ("tutProgress") >>= flip writeReadFile tut
 199
 200 readLock :: FilePath -> IO (Maybe (Lock, Maybe Solution))
 201 readLock path = runMaybeT $ msum
 202         [ (\l->(l,Nothing)) <$> (MaybeT $ readReadFile path)
 203         , do
 204             (mlock,msoln) <- lift $ readAsciiLockFile path
 205             lock <- liftMaybe mlock
 206             return $ (lock,msoln) ]
 207 -- writeLock :: FilePath -> Lock -> IO ()
 208 -- writeLock path lock = fullLockPath path >>= flip writeReadFile lock
 209
 210 writeMetaState ms@(MetaState { curServer=saddr, curAuth=auth, curLockPath=path }) = do
 211     confFilePath "metagame.conf" >>= flip writeReadFile (saddr, auth, path)
 212     writeServerSolns saddr ms
 213
 214 getTitle :: UIMonad uiM => MainStateT uiM (Maybe String)
 215 getTitle = ms2im <$> get >>= \im -> case im of
 216     IMEdit -> do
 217         mpath <- gets esPath
 218         unsaved <- editStateUnsaved
 219         isTested <- isJust <$> getCurTestSoln
 220         return $ Just $ "editing " ++ fromMaybe "[unnamed lock]" mpath ++
 221             (if isTested then " (Tested)" else "") ++
 222             (if unsaved then " [+]" else "    ")
 223     IMPlay -> gets psTitle
 224     IMReplay -> gets rsTitle
 225     _ -> return Nothing
 226
 227 editStateUnsaved :: UIMonad uiM => MainStateT uiM Bool
 228 editStateUnsaved = (isNothing <$>) $ runMaybeT $ do
 229     (sst,tested) <- MaybeT $ gets lastSavedState
 230     st <- MaybeT $ gets $ headMay.esGameStateStack
 231     guard $ sst == st
 232     nowTested <- isJust <$> lift getCurTestSoln
 233     guard $ tested == nowTested
 234
 235 getCurTestSoln :: UIMonad uiM => MainStateT uiM (Maybe Solution)
 236 getCurTestSoln = runMaybeT $ do
 237     (st',soln) <- MaybeT $ gets esTested
 238     st <- MaybeT $ gets $ headMay.esGameStateStack
 239     guard $ st == st'
 240     return soln
 241
 242 mgetOurName :: (UIMonad uiM) => MaybeT (MainStateT uiM) Codename
 243 mgetOurName = MaybeT $ (authUser <$>) <$> gets curAuth
 244 mgetCurName :: (UIMonad uiM) => MaybeT (MainStateT uiM) Codename
 245 mgetCurName = MaybeT $ listToMaybe <$> gets codenameStack
 246
 247 getUInfoFetched :: UIMonad uiM => Integer -> Codename -> MainStateT uiM FetchedRecord
 248 getUInfoFetched staleTime name = do
 249     uinfott <- gets (Map.lookup name . userInfoTVs)
 250     ($uinfott) $ maybe set $ \(tvar,time) -> do
 251         now <- liftIO getCurrentTime
 252         if floor (diffUTCTime now time) > staleTime
 253             then set
 254             else liftIO $ atomically $ readTVar tvar
 255     where
 256         set = do
 257             now <- liftIO getCurrentTime
 258             tvar <- getRecordCachedFromCur True $ RecUserInfo name
 259             modify $ \ms -> ms {userInfoTVs = Map.insert name (tvar, now) $ userInfoTVs ms}
 260             liftIO $ atomically $ readTVar tvar
 261
 262 mgetUInfo :: UIMonad uiM => Codename -> MaybeT (MainStateT uiM) UserInfo
 263 mgetUInfo name = do
 264     RCUserInfo (_,uinfo) <- MaybeT $ (fetchedRC <$>) $ getUInfoFetched defaultStaleTime name
 265     return uinfo
 266     where defaultStaleTime = 300
 267
 268
 269 invalidateUInfo :: UIMonad uiM => Codename -> MainStateT uiM ()
 270 invalidateUInfo name =
 271     modify $ \ms -> ms {userInfoTVs = Map.delete name $ userInfoTVs ms}
 272
 273 invalidateAllUInfo :: UIMonad uiM => MainStateT uiM ()
 274 invalidateAllUInfo =
 275     modify $ \ms -> ms {userInfoTVs = Map.empty}
 276
 277 data Codenames = AllCodenames | SomeCodenames [Codename]
 278
 279 invalidateUInfos :: UIMonad uiM => Codenames -> MainStateT uiM ()
 280 invalidateUInfos AllCodenames = invalidateAllUInfo
 281 invalidateUInfos (SomeCodenames names) = mapM_ invalidateUInfo names
 282
 283
 284 mgetLock :: UIMonad uiM => LockSpec -> MaybeT (MainStateT uiM) Lock
 285 mgetLock ls = do
 286     tvar <- msum [ MaybeT $ (Map.lookup ls) <$> gets indexedLocks
 287         , lift $ do
 288             tvar <- getRecordCachedFromCur True $ RecLock ls
 289             modify $ \ms -> ms { indexedLocks = Map.insert ls tvar $ indexedLocks ms }
 290             return tvar ]
 291     RCLock lock <- MaybeT $ (fetchedRC<$>) $ liftIO $ atomically $ readTVar tvar
 292     return $ reframe lock
 293
 294 invalidateAllIndexedLocks :: UIMonad uiM => MainStateT uiM ()
 295 invalidateAllIndexedLocks =
 296     modify $ \ms -> ms { indexedLocks = Map.empty }
 297
 298 refreshUInfoUI :: (UIMonad uiM) => MainStateT uiM ()
 299 refreshUInfoUI = void.runMaybeT $ do
 300     modify $ \ms -> ms { listOffset = 0 }
 301     mourNameSelected >>? getRandomNames
 302     lift $ modify $ \ms -> ms {retiredLocks = Nothing}
 303     --lift.lift $ drawMessage ""
 304     where
 305         getRandomNames = do
 306             rnamestvar <- gets randomCodenames
 307             liftIO $ atomically $ writeTVar rnamestvar []
 308             flag <- gets newAsync
 309             saddr <- gets curServer
 310             void $ liftIO $ forkIO $ do
 311                 resp <- makeRequest saddr $
 312                     ClientRequest protocolVersion Nothing $ GetRandomNames 19
 313                 case resp of
 314                     ServedRandomNames names -> atomically $ do
 315                             writeTVar rnamestvar names
 316                             writeTVar flag True
 317                     _ -> return ()
 318
 319 mourNameSelected :: (UIMonad uiM) => MaybeT (MainStateT uiM) Bool
 320 mourNameSelected = liftM2 (==) mgetCurName mgetOurName
 321
 322 purgeInvalidUndecls :: (UIMonad uiM) => MainStateT uiM ()
 323 purgeInvalidUndecls = do
 324     undecls' <- gets undeclareds >>= filterM ((not<$>).invalid)
 325     modify $ \ms -> ms { undeclareds = undecls' }
 326     where
 327         invalid (Undeclared _ ls (ActiveLock name idx)) =
 328             (fromMaybe False <$>) $ runMaybeT $ do
 329                 uinfo <- mgetUInfo name
 330                 ourName <- mgetOurName
 331                 (`mplus` return True) $ do
 332                     linfo <- liftMaybe $ userLocks uinfo ! idx
 333                     return $ public linfo
 334                         || ourName `elem` accessedBy linfo
 335                         || lockSpec linfo /= ls
 336
 337
 338 curServerAction :: UIMonad uiM => Protocol.Action -> MainStateT uiM ServerResponse
 339 curServerAction act = do
 340     saddr <- gets curServer
 341     auth <- gets curAuth
 342     cOnly <- gets cacheOnly
 343     if cOnly then return $ ServerError "Can't contact server in cache-only mode"
 344         else (fromMaybe (ServerError "Request aborted") <$>) $
 345             lift $ withImpatience $ makeRequest saddr $ ClientRequest protocolVersion auth act
 346
 347 curServerActionAsyncThenInvalidate :: UIMonad uiM => Protocol.Action -> Maybe Codenames -> MainStateT uiM ()
 348 curServerActionAsyncThenInvalidate act names = do
 349     saddr <- gets curServer
 350     auth <- gets curAuth
 351     flag <- gets newAsync
 352     count <- gets asyncCount
 353     errtvar <- gets asyncError
 354     invaltvar <- gets asyncInvalidate
 355     cOnly <- gets cacheOnly
 356     void $ liftIO $ forkIO $ do
 357         atomically $ modifyTVar count (+1)
 358         resp <- if cOnly then return $ ServerError "Can't contact server in cache-only mode"
 359                 else makeRequest saddr $ ClientRequest protocolVersion auth act
 360         case resp of
 361             ServerError err -> atomically $ writeTVar errtvar $ Just err
 362             _ -> atomically $ writeTVar invaltvar names
 363         atomically $ writeTVar flag True
 364         atomically $ modifyTVar count (+(-1))
 365
 366 checkAsync :: UIMonad uiM => MainStateT uiM ()
 367 checkAsync = do
 368     void.runMaybeT $ do
 369         errtvar <- lift $ gets asyncError
 370         err <- MaybeT $ liftIO $ atomically $
 371                 readTVar errtvar <* writeTVar errtvar Nothing
 372         lift.lift $ drawError err
 373     void.runMaybeT $ do
 374         invaltvar <- lift $ gets asyncInvalidate
 375         names <- MaybeT $ liftIO $ atomically $
 376                 readTVar invaltvar <* writeTVar invaltvar Nothing
 377         lift $ invalidateUInfos names >> refreshUInfoUI
 378
 379 getRecordCachedFromCur :: UIMonad uiM => Bool -> Record -> MainStateT uiM (TVar FetchedRecord)
 380 getRecordCachedFromCur flagIt rec = do
 381     saddr <- gets curServer
 382     auth <- gets curAuth
 383     cOnly <- gets cacheOnly
 384     flag <- gets newAsync
 385     liftIO $ getRecordCached saddr auth
 386         (if flagIt then Just flag else Nothing) cOnly rec
 387
 388 getFreshRecBlocking :: UIMonad uiM => Record -> MainStateT uiM (Maybe RecordContents)
 389 getFreshRecBlocking rec = do
 390     tvar <- getRecordCachedFromCur False rec
 391     cOnly <- gets cacheOnly
 392     mfetched <- lift $ withImpatience $ atomically $ do
 393         fetched@(FetchedRecord fresh _ _) <- readTVar tvar
 394         check $ fresh || cOnly
 395         return fetched
 396     case mfetched of
 397         Nothing -> lift (drawError "Request aborted") >> return Nothing
 398         Just fetched ->
 399             case fetchError fetched of
 400                 Nothing -> return $ fetchedRC fetched
 401                 Just err -> lift (drawError err) >> return Nothing
 402
 403 -- |indicate waiting for server, and allow cancellation
 404 withImpatience :: UIMonad uiM => IO a -> uiM (Maybe a)
 405 withImpatience m = do
 406     finishedTV <- liftIO $ atomically $ newTVar Nothing
 407     id <- liftIO $ forkIO $ m >>= atomically . writeTVar finishedTV . Just
 408     let waitImpatiently ticks = do
 409         finished <- liftIO $ atomically $ readTVar finishedTV
 410         if isJust finished
 411             then return finished
 412             else do
 413                 abort <- impatience ticks
 414                 if abort
 415                     then liftIO $ killThread id >> return Nothing
 416                     else waitImpatiently $ ticks+1
 417     waitImpatiently 0
 418
 419
 420 getRelScore :: (UIMonad uiM) => Codename -> MainStateT uiM (Maybe Int)
 421 getRelScore name = (fst<$>) <$> getRelScoreDetails name
 422 getRelScoreDetails name = runMaybeT $ do
 423     ourName <- mgetOurName
 424     guard $ ourName /= name
 425     uinfo <- mgetUInfo name
 426     ourUInfo <- mgetUInfo ourName
 427     let (neg,pos) = (countPoints ourUInfo uinfo, countPoints uinfo ourUInfo)
 428     return $ (pos-neg,(pos,neg))
 429     where
 430         countPoints mugu masta = length $ filter (maybe False winsPoint) $ getAccessInfo mugu masta
 431
 432 accessedAL :: (UIMonad uiM) => ActiveLock -> MainStateT uiM Bool
 433 accessedAL (ActiveLock name idx) = (isJust <$>) $ runMaybeT $ do
 434     ourName <- mgetOurName
 435     guard $ ourName /= name
 436     uinfo <- mgetUInfo name
 437     ourUInfo <- mgetUInfo ourName
 438     guard $ isJust $ getAccessInfo uinfo ourUInfo !! idx
 439
 440 getNotesReadOn :: UIMonad uiM => LockInfo -> MainStateT uiM [NoteInfo]
 441 getNotesReadOn lockinfo = (fromMaybe [] <$>) $ runMaybeT $ do
 442     ourName <- mgetOurName
 443     ourUInfo <- mgetUInfo ourName
 444     return $ filter (\n -> isNothing (noteBehind n)
 445             || n `elem` notesRead ourUInfo) $ lockSolutions lockinfo
 446
 447 testAuth :: UIMonad uiM => MainStateT uiM ()
 448 testAuth = isJust <$> gets curAuth >>? do
 449     resp <- curServerAction $ Authenticate
 450     case resp of
 451         ServerMessage msg -> (lift $ drawMessage $ "Server: " ++ msg)
 452         ServerError err -> do
 453             lift $ drawMessage err
 454             modify $ \ms -> ms {curAuth = Nothing}
 455         _ -> return ()
 456
 457 metagameHelpText :: [String]
 458 metagameHelpText =
 459     [ "By ruthlessly guarded secret arrangement, the council's agents can pick any lock in the city."
 460     , "A secret guild produces the necessary locks - apparently secure, but with fatal hidden flaws."
 461     , "A ritual game is played to determine the best designs."
 462     , "To master it, you must build locks which can be picked only by one who knows the secret,"
 463     , "and you must discover the secret flaws in the locks designed by your colleagues."
 464     , ""
 465     , "You may put forward up to three prototype locks. They will guard the secrets you discover."
 466     , "If you pick a colleague's lock, the rules require that a note is written on your solution."
 467     , "A note proves that a solution was found, while revealing no more details than necessary."
 468     --, "Composing notes is a tricky and ritual-bound art of its own, performed by independent experts."
 469     , "To declare your solution, you must secure your note behind a lock of your own."
 470     , "If you are able to unlock a lock, you automatically read all the notes it secures."
 471     , "If you read three notes on a lock, you will piece together the secrets of unlocking that lock."
 472     , ""
 473     , "The game judges players relative to each of their peers. There are no absolute rankings."
 474     , "You win a point of esteem against another player for each of their locks for which either:"
 475     , "you have solved the lock and declared a note which the lock's owner has not read, or"
 476     , "you have read three notes on the lock."
 477     , "You also win a point for each empty lock slot if you can unlock all full slots."
 478     , "Relative esteem is the points you win minus the points they win; +3 is best, -3 is worst."
 479     , ""
 480     , "If the secrets to one of your locks become widely disseminated, you may wish to replace it."
 481     , "However: once replaced, a lock is \"retired\", and the notes it secured are read by everyone."
 482     ]
 483
 484 initiationHelpText :: [String]
 485 initiationHelpText =
 486     [ ""
 487     , ""
 488     , "So."
 489     , ""
 490     , "You have exhibited a level of manual and mental dexterity adequate for the picking of locks."
 491     , ""
 492     , "Whether you also possess the deviousness required for their design, remains to be seen."
 493     , ""
 494     , "Nonetheless, we welcome you to our number. For reasons that doubtless require no elaboration,"
 495     , "our members are known exclusively by pseudonyms - by tradition, a triplet of letters or symbols."
 496     , "I am eager to hear what codename you will choose for yourself."
 497     , ""
 498     , "But first, let us remind you of the purpose and rules of our game here..."
 499     ]
 500
 501 firstEditHelpText :: [String]
 502 firstEditHelpText =
 503     [ "Design a lock to protect your secrets."
 504     , "It must be possible to pick your lock by pulling a sprung bolt from the hole in the top-right,"
 505     , "but you should place blocks, springs, pivots, and balls to make this as difficult as possible."
 506     , ""
 507     , "Place pieces with keyboard or mouse. Springs must be set next to blocks, and arms next to pivots."
 508     , "Repeatedly placing a piece in the same hex cycles through ways it can relate to its neighbours."
 509     , ""
 510     , "Use Test to prove your lock is solvable, or Play to alternate between testing and editing."
 511     , "When you are done, Write your lock, then Quit from editing and Place your lock in a slot."
 512     , "You will then be able to Declare locks you solve, and others will attempt to solve your lock."
 513     , ""
 514     , "Your first lock is unlikely to stand for long against your more experienced peers;"
 515     , "examine their solutions to spot flaws in your design, and study their locks for ideas."
 516     ]