Add seed option to CLI (#170)

- adds CLI option `--seed` and propagates it to `testWorld2` (Closes #14)
- moves the base in the tree shade (Closes #90)
- makes the `random` command depend on initial seed (Closes #13)

TUTORIAL.md

@@ -46,7 +46,8 @@ looks something like this:
 
 ![](images/initial.png)
 
-The little white `Ω` in the middle represents your base.  Start by
+In the world view, you see the default [*World 0*](./TUTORIAL.md#world-generation)
+and the little white `Ω` in the middle represents your base. Start by
 using the Tab key to cycle through the three panels (the REPL, the
 info panel, and the world panel), and read about the various devices
 installed on your base.
@@ -307,6 +308,24 @@ you want to reload the definitions.  Eventually, there will be a way
 to both save and load commands, but this is better than nothing for
 now.
 
+World generation
+----------------
+
+If you do not like the starting place of the base, there is a way
+to start somewhere else. *In a different world!*
+
+```bash
+$ swarm --seed $RANDOM
+```
+
+You can specify the *world seed* leading to radically different
+starting conditions. You can start next to a copper patch, between
+lakes or in the middle of a plain. Either way, you have established
+your base in the shade of what you assume is a tree and now can
+send out robots to explore!
+
+![World generated with seed 16](./images/world16.png)
+
 Creative Mode
 -------------
 

app/Main.hs

@@ -14,7 +14,7 @@ import Swarm.Language.Pipeline (processTerm)
 import System.Exit
 
 data CLI
-  = Run
+  = Run Int
   | Format Input
   | LSP
 
@@ -24,16 +24,24 @@ cliParser =
     ( command "format" (info (format <**> helper) (progDesc "Format a file"))
         <> command "lsp" (info (pure LSP) (progDesc "Start the LSP"))
     )
-    <|> pure Run
+    <|> Run <$> seed
  where
+  format :: Parser CLI
   format =
     (Format Stdin <$ switch (long "stdin" <> help "Read code from stdin"))
       <|> (Format . File <$> strArgument (metavar "FILE"))
+  seed :: Parser Int
+  seed = option auto (long "seed" <> short 's' <> value 0 <> help "Seed for world generation")
 
 cliInfo :: ParserInfo CLI
-cliInfo = info (cliParser <**> helper) (fullDesc <> header "Swarm game")
+cliInfo =
+  info
+    (cliParser <**> helper)
+    ( header "Swarm game - pre-alpha version"
+        <> progDesc "To play the game simply run without any command."
+        <> fullDesc
+    )
 
--- | Utility function to validate and format swarm-lang code
 data Input = Stdin | File FilePath
 
 getInput :: Input -> IO Text
@@ -44,6 +52,7 @@ showInput :: Input -> Text
 showInput Stdin = "(input)"
 showInput (File fp) = pack fp
 
+-- | Utility function to validate and format swarm-lang code
 formatFile :: Input -> IO ()
 formatFile input = do
   content <- getInput input
@@ -59,6 +68,6 @@ main :: IO ()
 main = do
   cli <- execParser cliInfo
   case cli of
-    Run -> appMain
+    Run seed -> appMain seed
     Format fo -> formatFile fo
     LSP -> lspMain

bench/Benchmark.hs

@@ -40,8 +40,8 @@ mkTreeBot :: V2 Int64 -> Integer -> Integer -> Robot
 mkTreeBot loc rn1 rn2 =
   mkRobot "tree" loc (V2 0 0) machine []
     & systemRobot .~ True
-  where
-    machine = initMachine (treeProgram rn1 rn2) Context.empty
+ where
+  machine = initMachine (treeProgram rn1 rn2) Context.empty
 
 -- | Creates a GameState with numTrees trees with random growing rates.
 mkTrees :: Int -> IO GameState
@@ -49,7 +49,7 @@ mkTrees numTrees = do
   rn1s <- replicateM numTrees (randomRIO (0, 99))
   rn2s <- replicateM numTrees (randomRIO (0, 99))
   let robots = zipWith3 mkTreeBot [V2 x 0 | x <- [0 ..]] rn1s rn2s
-  Right initState <- runExceptT initGameState
+  Right initState <- runExceptT (initGameState 0)
   execStateT (mapM_ addRobot robots) initState
 
 -- | Runs numGameTicks ticks of the game.
@@ -67,8 +67,8 @@ main = do
   defaultMain
     [ bgroup
         "run 1000 game ticks"
-        [ bench "10 trees" $ whnfIO (runGame 1000 trees10),
-          bench "20 trees" $ whnfIO (runGame 1000 trees20),
-          bench "30 trees" $ whnfIO (runGame 1000 trees30)
+        [ bench "10 trees" $ whnfIO (runGame 1000 trees10)
+        , bench "20 trees" $ whnfIO (runGame 1000 trees20)
+        , bench "30 trees" $ whnfIO (runGame 1000 trees30)
         ]
-    ]
+    ]

src/Swarm/App.hs

@@ -38,9 +38,9 @@ app =
 
 -- | The main @IO@ computation which initializes the state, sets up
 --   some communication channels, and runs the UI.
-appMain :: IO ()
-appMain = do
-  res <- runExceptT initAppState
+appMain :: Seed -> IO ()
+appMain seed = do
+  res <- runExceptT $ initAppState seed
   case res of
     Left errMsg -> T.putStrLn errMsg
     Right s -> do

src/Swarm/Game/State.hs

@@ -21,6 +21,7 @@ module Swarm.Game.State (
   REPLStatus (..),
   RunStatus (..),
   GameState,
+  Seed,
   initGameState,
 
   -- ** GameState fields
@@ -29,6 +30,7 @@ module Swarm.Game.State (
   paused,
   robotMap,
   gensym,
+  randGen,
   entityMap,
   recipesOut,
   recipesIn,
@@ -71,9 +73,10 @@ import Swarm.Game.Recipe
 import Swarm.Game.Robot
 import Swarm.Game.Value
 import qualified Swarm.Game.World as W
-import Swarm.Game.WorldGen (findGoodOrigin, testWorld2)
+import Swarm.Game.WorldGen (Seed, findGoodOrigin, testWorld2)
 import Swarm.Language.Types
 import Swarm.Util
+import System.Random (StdGen, mkStdGen)
 
 -- | The 'ViewCenterRule' specifies how to determine the center of the
 --   world viewport.
@@ -126,6 +129,7 @@ data GameState = GameState
   , _runStatus :: RunStatus
   , _robotMap :: Map Text Robot
   , _gensym :: Int
+  , _randGen :: StdGen
   , _entityMap :: EntityMap
   , _recipesOut :: IntMap [Recipe Entity]
   , _recipesIn :: IntMap [Recipe Entity]
@@ -163,6 +167,9 @@ robotMap :: Lens' GameState (Map Text Robot)
 -- | A counter used to generate globally unique IDs.
 gensym :: Lens' GameState Int
 
+-- | Pseudorandom generator initialized at start.
+randGen :: Lens' GameState StdGen
+
 -- | The catalog of all entities that the game knows about.
 entityMap :: Lens' GameState EntityMap
 
@@ -304,8 +311,8 @@ addRobot r = do
 
 -- | Create an initial game state record, first loading entities and
 --   recipies from disk.
-initGameState :: ExceptT Text IO GameState
-initGameState = do
+initGameState :: Seed -> ExceptT Text IO GameState
+initGameState seed = do
   liftIO $ putStrLn "Loading entities..."
   entities <- loadEntities >>= (`isRightOr` id)
   liftIO $ putStrLn "Loading recipes..."
@@ -322,6 +329,7 @@ initGameState = do
       baseDevices = mapMaybe (`lookupEntityName` entities) baseDeviceNames
 
   let baseName = "base"
+  liftIO $ putStrLn ("Using seed... " <> show seed)
 
   return $
     GameState
@@ -329,11 +337,15 @@ initGameState = do
       , _runStatus = Running
       , _robotMap = M.singleton baseName (baseRobot baseDevices)
       , _gensym = 0
+      , _randGen = mkStdGen seed
       , _entityMap = entities
       , _recipesOut = outRecipeMap recipes
       , _recipesIn = inRecipeMap recipes
       , _world =
-          W.newWorld . fmap ((lkup entities <$>) . first fromEnum) . findGoodOrigin $ testWorld2
+          W.newWorld
+            . fmap ((lkup entities <$>) . first fromEnum)
+            . findGoodOrigin
+            $ testWorld2 seed
       , _viewCenterRule = VCRobot baseName
       , _viewCenter = V2 0 0
       , _needsRedraw = False

src/Swarm/Game/Step.hs

@@ -34,7 +34,7 @@ import qualified Data.Set as S
 import Data.Text (Text)
 import qualified Data.Text as T
 import Linear
-import System.Random (randomRIO)
+import System.Random (uniformR)
 import Witch
 import Prelude hiding (lookup)
 
@@ -716,7 +716,9 @@ execConst c vs k = do
       _ -> badConst
     Random -> case vs of
       [VInt hi] -> do
-        n <- randomRIO (0, hi -1)
+        rand <- lift . lift $ use randGen
+        let (n, g) = uniformR (0, hi -1) rand
+        lift . lift $ randGen .= g
         return $ Out (VInt n) k
       _ -> badConst
     Say -> case vs of

src/Swarm/Game/WorldGen.hs

@@ -42,10 +42,11 @@ testWorld1 (Coords (i, j))
 data Size = Small | Big deriving (Eq, Ord, Show, Read)
 data Hardness = Soft | Hard deriving (Eq, Ord, Show, Read)
 data Origin = Natural | Artificial deriving (Eq, Ord, Show, Read)
+type Seed = Int
 
 -- | A more featureful test world.
-testWorld2 :: WorldFun TerrainType Text
-testWorld2 (Coords ix@(r, c)) =
+testWorld2 :: Seed -> WorldFun TerrainType Text
+testWorld2 baseSeed (Coords ix@(r, c)) =
   genBiome
     (bool Small Big (sample ix pn0 > 0))
     (bool Soft Hard (sample ix pn1 > 0))
@@ -84,23 +85,28 @@ testWorld2 (Coords ix@(r, c)) =
   sample (i, j) noise = noiseValue noise (fromIntegral i / 2, fromIntegral j / 2, 0)
 
   pn :: Int -> Perlin
-  pn seed = perlin seed 6 0.05 0.6
+  pn seed = perlin (seed + baseSeed) 6 0.05 0.6
 
   pn0 = pn 0
   pn1 = pn 1
   pn2 = pn 2
 
   clumps :: Int -> Perlin
-  clumps seed = perlin seed 4 0.08 0.5
+  clumps seed = perlin (seed + baseSeed) 4 0.08 0.5
 
   cl0 = clumps 0
 
--- | Offset the world so the base starts on a tree.
+-- | Offset the world so the base starts on empty spot next to tree and grass.
 findGoodOrigin :: WorldFun t Text -> WorldFun t Text
 findGoodOrigin f = \(Coords (r, c)) -> f (Coords (r + rOffset, c + cOffset))
  where
   int' :: Enumeration Int64
   int' = fromIntegral <$> int
   (rOffset, cOffset) = fromMaybe (error "the impossible happened, no offsets were found") offsets
-  offsets = find isTree (enumerate (int' >< int'))
-  isTree = (== Just "tree") . snd . f . Coords
+  offsets = find isGoodPlace (enumerate (int' >< int'))
+  hasEntity mayE = (== mayE) . snd . f . Coords
+  isGoodPlace cs =
+    hasEntity Nothing cs
+      && any (hasEntity (Just "tree")) (neighbors cs)
+      && all (\c -> hasEntity (Just "tree") c || hasEntity Nothing c) (neighbors cs)
+  neighbors (x, y) = (,) <$> [x, x - 1, x + 1] <*> [y, y - 1, y + 1]

src/Swarm/TUI/Model.hs

@@ -67,6 +67,7 @@ module Swarm.TUI.Model (
 
   -- ** Initialization
   initAppState,
+  Seed,
 ) where
 
 import Control.Lens
@@ -356,8 +357,8 @@ gameState :: Lens' AppState GameState
 uiState :: Lens' AppState UIState
 
 -- | Initialize the 'AppState'.
-initAppState :: ExceptT Text IO AppState
-initAppState = AppState <$> initGameState <*> initUIState
+initAppState :: Seed -> ExceptT Text IO AppState
+initAppState seed = AppState <$> initGameState seed <*> initUIState
 
 ------------------------------------------------------------
 --