{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module      :  Swarm.Game.WorldGen
-- Copyright   :  Brent Yorgey
-- Maintainer  :  byorgey@gmail.com
--
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Procedural world generation via coherent noise.
module Swarm.Game.WorldGen where

import Control.Lens (view)
import Data.Array.IArray
import Data.Bifunctor (second)
import Data.Bool
import Data.ByteString (ByteString)
import Data.Enumeration
import Data.Hash.Murmur
import Data.Int (Int64)
import Data.List (find)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Set qualified as S
import Data.Tagged
import Data.Text (Text)
import Data.Text qualified as T
import Numeric.Noise.Perlin
import Swarm.Game.Entity
import Swarm.Game.Terrain
import Swarm.Game.World
import Witch
import Witch.Encoding qualified as Encoding

-- | A simple test world used for a while during early development.
testWorld1 :: Coords -> (TerrainType, Maybe Text)
testWorld1 :: Coords -> (TerrainType, Maybe Text)
testWorld1 (Coords (-5, Int64
3)) = (TerrainType
StoneT, forall a. a -> Maybe a
Just Text
"flerb")
testWorld1 (Coords (Int64
2, -1)) = (TerrainType
GrassT, forall a. a -> Maybe a
Just Text
"elephant")
testWorld1 (Coords (Int64
i, Int64
j))
  | forall a. Noise a => a -> Point -> Double
noiseValue Perlin
pn1 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
j, Double
0) forall a. Ord a => a -> a -> Bool
> Double
0 = (TerrainType
DirtT, forall a. a -> Maybe a
Just Text
"tree")
  | forall a. Noise a => a -> Point -> Double
noiseValue Perlin
pn2 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
j, Double
0) forall a. Ord a => a -> a -> Bool
> Double
0 = (TerrainType
StoneT, forall a. a -> Maybe a
Just Text
"rock")
  | Bool
otherwise = (TerrainType
GrassT, forall a. Maybe a
Nothing)
 where
  pn1, pn2 :: Perlin
  pn1 :: Perlin
pn1 = Seed -> Seed -> Double -> Double -> Perlin
perlin Seed
0 Seed
5 Double
0.05 Double
0.5
  pn2 :: Perlin
pn2 = Seed -> Seed -> Double -> Double -> Perlin
perlin Seed
0 Seed
5 Double
0.05 Double
0.75

data Size = Small | Big deriving (Size -> Size -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Size -> Size -> Bool
$c/= :: Size -> Size -> Bool
== :: Size -> Size -> Bool
$c== :: Size -> Size -> Bool
Eq, Eq Size
Size -> Size -> Bool
Size -> Size -> Ordering
Size -> Size -> Size
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Size -> Size -> Size
$cmin :: Size -> Size -> Size
max :: Size -> Size -> Size
$cmax :: Size -> Size -> Size
>= :: Size -> Size -> Bool
$c>= :: Size -> Size -> Bool
> :: Size -> Size -> Bool
$c> :: Size -> Size -> Bool
<= :: Size -> Size -> Bool
$c<= :: Size -> Size -> Bool
< :: Size -> Size -> Bool
$c< :: Size -> Size -> Bool
compare :: Size -> Size -> Ordering
$ccompare :: Size -> Size -> Ordering
Ord, Seed -> Size -> ShowS
[Size] -> ShowS
Size -> [Char]
forall a.
(Seed -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Size] -> ShowS
$cshowList :: [Size] -> ShowS
show :: Size -> [Char]
$cshow :: Size -> [Char]
showsPrec :: Seed -> Size -> ShowS
$cshowsPrec :: Seed -> Size -> ShowS
Show, ReadPrec [Size]
ReadPrec Size
Seed -> ReadS Size
ReadS [Size]
forall a.
(Seed -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Size]
$creadListPrec :: ReadPrec [Size]
readPrec :: ReadPrec Size
$creadPrec :: ReadPrec Size
readList :: ReadS [Size]
$creadList :: ReadS [Size]
readsPrec :: Seed -> ReadS Size
$creadsPrec :: Seed -> ReadS Size
Read)
data Hardness = Soft | Hard deriving (Hardness -> Hardness -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hardness -> Hardness -> Bool
$c/= :: Hardness -> Hardness -> Bool
== :: Hardness -> Hardness -> Bool
$c== :: Hardness -> Hardness -> Bool
Eq, Eq Hardness
Hardness -> Hardness -> Bool
Hardness -> Hardness -> Ordering
Hardness -> Hardness -> Hardness
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Hardness -> Hardness -> Hardness
$cmin :: Hardness -> Hardness -> Hardness
max :: Hardness -> Hardness -> Hardness
$cmax :: Hardness -> Hardness -> Hardness
>= :: Hardness -> Hardness -> Bool
$c>= :: Hardness -> Hardness -> Bool
> :: Hardness -> Hardness -> Bool
$c> :: Hardness -> Hardness -> Bool
<= :: Hardness -> Hardness -> Bool
$c<= :: Hardness -> Hardness -> Bool
< :: Hardness -> Hardness -> Bool
$c< :: Hardness -> Hardness -> Bool
compare :: Hardness -> Hardness -> Ordering
$ccompare :: Hardness -> Hardness -> Ordering
Ord, Seed -> Hardness -> ShowS
[Hardness] -> ShowS
Hardness -> [Char]
forall a.
(Seed -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Hardness] -> ShowS
$cshowList :: [Hardness] -> ShowS
show :: Hardness -> [Char]
$cshow :: Hardness -> [Char]
showsPrec :: Seed -> Hardness -> ShowS
$cshowsPrec :: Seed -> Hardness -> ShowS
Show, ReadPrec [Hardness]
ReadPrec Hardness
Seed -> ReadS Hardness
ReadS [Hardness]
forall a.
(Seed -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Hardness]
$creadListPrec :: ReadPrec [Hardness]
readPrec :: ReadPrec Hardness
$creadPrec :: ReadPrec Hardness
readList :: ReadS [Hardness]
$creadList :: ReadS [Hardness]
readsPrec :: Seed -> ReadS Hardness
$creadsPrec :: Seed -> ReadS Hardness
Read)
data Origin = Natural | Artificial deriving (Origin -> Origin -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Origin -> Origin -> Bool
$c/= :: Origin -> Origin -> Bool
== :: Origin -> Origin -> Bool
$c== :: Origin -> Origin -> Bool
Eq, Eq Origin
Origin -> Origin -> Bool
Origin -> Origin -> Ordering
Origin -> Origin -> Origin
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Origin -> Origin -> Origin
$cmin :: Origin -> Origin -> Origin
max :: Origin -> Origin -> Origin
$cmax :: Origin -> Origin -> Origin
>= :: Origin -> Origin -> Bool
$c>= :: Origin -> Origin -> Bool
> :: Origin -> Origin -> Bool
$c> :: Origin -> Origin -> Bool
<= :: Origin -> Origin -> Bool
$c<= :: Origin -> Origin -> Bool
< :: Origin -> Origin -> Bool
$c< :: Origin -> Origin -> Bool
compare :: Origin -> Origin -> Ordering
$ccompare :: Origin -> Origin -> Ordering
Ord, Seed -> Origin -> ShowS
[Origin] -> ShowS
Origin -> [Char]
forall a.
(Seed -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Origin] -> ShowS
$cshowList :: [Origin] -> ShowS
show :: Origin -> [Char]
$cshow :: Origin -> [Char]
showsPrec :: Seed -> Origin -> ShowS
$cshowsPrec :: Seed -> Origin -> ShowS
Show, ReadPrec [Origin]
ReadPrec Origin
Seed -> ReadS Origin
ReadS [Origin]
forall a.
(Seed -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Origin]
$creadListPrec :: ReadPrec [Origin]
readPrec :: ReadPrec Origin
$creadPrec :: ReadPrec Origin
readList :: ReadS [Origin]
$creadList :: ReadS [Origin]
readsPrec :: Seed -> ReadS Origin
$creadsPrec :: Seed -> ReadS Origin
Read)
type Seed = Int

-- | A list of entities available in the initial world.
testWorld2Entites :: S.Set Text
testWorld2Entites :: Set Text
testWorld2Entites =
  forall a. Ord a => [a] -> Set a
S.fromList
    [ Text
"mountain"
    , Text
"boulder"
    , Text
"LaTeX"
    , Text
"tree"
    , Text
"rock"
    , Text
"lodestone"
    , Text
"sand"
    , Text
"wavy water"
    , Text
"water"
    , Text
"flower"
    , Text
"bit (0)"
    , Text
"bit (1)"
    , Text
"Linux"
    , Text
"lambda"
    , Text
"pixel (R)"
    , Text
"pixel (G)"
    , Text
"pixel (B)"
    , Text
"copper ore"
    ]

-- | Look up an entity name in an entity map, when we know the entity
--   must exist.  This is only used for entities which are named in
--   'testWorld2'.
readEntity :: EntityMap -> Text -> Entity
readEntity :: EntityMap -> Text -> Entity
readEntity EntityMap
em Text
name =
  forall a. a -> Maybe a -> a
fromMaybe
    (forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown entity name in WorldGen: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Text
name)
    (Text -> EntityMap -> Maybe Entity
lookupEntityName Text
name EntityMap
em)

-- | The main world of the classic game, for historical reasons named
--   'testWorld2'.  If new entities are added, you SHOULD ALSO UPDATE
--   'testWorld2Entities'.
testWorld2 :: EntityMap -> Seed -> WorldFun TerrainType Entity
testWorld2 :: EntityMap -> Seed -> WorldFun TerrainType Entity
testWorld2 EntityMap
em Seed
baseSeed = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (EntityMap -> Text -> Entity
readEntity EntityMap
em) (forall t e. (Coords -> (t, Maybe e)) -> WorldFun t e
WF Coords -> (TerrainType, Maybe Text)
tw2)
 where
  tw2 :: Coords -> (TerrainType, Maybe Text)
  tw2 :: Coords -> (TerrainType, Maybe Text)
tw2 (Coords ix :: (Int64, Int64)
ix@(Int64
r, Int64
c)) =
    Size -> Hardness -> Origin -> (TerrainType, Maybe Text)
genBiome
      (forall a. a -> a -> Bool -> a
bool Size
Small Size
Big (forall {a} {a} {a}.
(Noise a, Integral a, Integral a) =>
(a, a) -> a -> Double
sample (Int64, Int64)
ix Perlin
pn0 forall a. Ord a => a -> a -> Bool
> Double
0))
      (forall a. a -> a -> Bool -> a
bool Hardness
Soft Hardness
Hard (forall {a} {a} {a}.
(Noise a, Integral a, Integral a) =>
(a, a) -> a -> Double
sample (Int64, Int64)
ix Perlin
pn1 forall a. Ord a => a -> a -> Bool
> Double
0))
      (forall a. a -> a -> Bool -> a
bool Origin
Natural Origin
Artificial (forall {a} {a} {a}.
(Noise a, Integral a, Integral a) =>
(a, a) -> a -> Double
sample (Int64, Int64)
ix Perlin
pn2 forall a. Ord a => a -> a -> Bool
> Double
0))
   where
    h :: Word32
h = Word32 -> ByteString -> Word32
murmur3 Word32
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (s :: k) b. Tagged s b -> b
unTagged forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall source target. From source target => source -> target
from @String @(Encoding.UTF_8 ByteString) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ (Int64, Int64)
ix

    genBiome :: Size -> Hardness -> Origin -> (TerrainType, Maybe Text)
genBiome Size
Big Hardness
Hard Origin
Natural
      | forall {a} {a} {a}.
(Noise a, Integral a, Integral a) =>
(a, a) -> a -> Double
sample (Int64, Int64)
ix Perlin
cl0 forall a. Ord a => a -> a -> Bool
> Double
0.5 = (TerrainType
StoneT, forall a. a -> Maybe a
Just Text
"mountain")
      | Word32
h forall a. Integral a => a -> a -> a
`mod` Word32
30 forall a. Eq a => a -> a -> Bool
== Word32
0 = (TerrainType
StoneT, forall a. a -> Maybe a
Just Text
"boulder")
      | forall {a} {a} {a}.
(Noise a, Integral a, Integral a) =>
(a, a) -> a -> Double
sample (Int64, Int64)
ix Perlin
cl0 forall a. Ord a => a -> a -> Bool
> Double
0 =
        case Word32
h forall a. Integral a => a -> a -> a
`mod` Word32
30 of
          Word32
1 -> (TerrainType
DirtT, forall a. a -> Maybe a
Just Text
"LaTeX")
          Word32
_ -> (TerrainType
DirtT, forall a. a -> Maybe a
Just Text
"tree")
      | Bool
otherwise = (TerrainType
GrassT, forall a. Maybe a
Nothing)
    genBiome Size
Small Hardness
Hard Origin
Natural
      | Word32
h forall a. Integral a => a -> a -> a
`mod` Word32
100 forall a. Eq a => a -> a -> Bool
== Word32
0 = (TerrainType
StoneT, forall a. a -> Maybe a
Just Text
"lodestone")
      | Word32
h forall a. Integral a => a -> a -> a
`mod` Word32
10 forall a. Eq a => a -> a -> Bool
== Word32
0 = (TerrainType
StoneT, forall a. a -> Maybe a
Just Text
"rock")
      | Bool
otherwise = (TerrainType
StoneT, forall a. Maybe a
Nothing)
    genBiome Size
Big Hardness
Soft Origin
Natural
      | forall a. Num a => a -> a
abs (forall {a} {a} {a}.
(Noise a, Integral a, Integral a) =>
(a, a) -> a -> Double
sample (Int64, Int64)
ix Perlin
pn1) forall a. Ord a => a -> a -> Bool
< Double
0.1 = (TerrainType
DirtT, forall a. a -> Maybe a
Just Text
"sand")
      | forall a. Integral a => a -> Bool
even (Int64
r forall a. Num a => a -> a -> a
+ Int64
c) = (TerrainType
DirtT, forall a. a -> Maybe a
Just Text
"wavy water")
      | Bool
otherwise = (TerrainType
DirtT, forall a. a -> Maybe a
Just Text
"water")
    genBiome Size
Small Hardness
Soft Origin
Natural
      | Word32
h forall a. Integral a => a -> a -> a
`mod` Word32
20 forall a. Eq a => a -> a -> Bool
== Word32
0 = (TerrainType
GrassT, forall a. a -> Maybe a
Just Text
"flower")
      | Word32
h forall a. Integral a => a -> a -> a
`mod` Word32
20 forall a. Eq a => a -> a -> Bool
== Word32
10 = (TerrainType
GrassT, forall a. a -> Maybe a
Just Text
"cotton")
      | Bool
otherwise = (TerrainType
GrassT, forall a. Maybe a
Nothing)
    genBiome Size
Small Hardness
Soft Origin
Artificial
      | Word32
h forall a. Integral a => a -> a -> a
`mod` Word32
10 forall a. Eq a => a -> a -> Bool
== Word32
0 = (TerrainType
GrassT, forall a. a -> Maybe a
Just ([Text] -> Text
T.concat [Text
"bit (", forall source target. From source target => source -> target
from (forall a. Show a => a -> [Char]
show ((Int64
r forall a. Num a => a -> a -> a
+ Int64
c) forall a. Integral a => a -> a -> a
`mod` Int64
2)), Text
")"]))
      | Bool
otherwise = (TerrainType
GrassT, forall a. Maybe a
Nothing)
    genBiome Size
Big Hardness
Soft Origin
Artificial
      | Word32
h forall a. Integral a => a -> a -> a
`mod` Word32
5000 forall a. Eq a => a -> a -> Bool
== Word32
0 = (TerrainType
DirtT, forall a. a -> Maybe a
Just Text
"Linux")
      | forall {a} {a} {a}.
(Noise a, Integral a, Integral a) =>
(a, a) -> a -> Double
sample (Int64, Int64)
ix Perlin
cl0 forall a. Ord a => a -> a -> Bool
> Double
0.5 = (TerrainType
GrassT, forall a. Maybe a
Nothing)
      | Bool
otherwise = (TerrainType
DirtT, forall a. Maybe a
Nothing)
    genBiome Size
Small Hardness
Hard Origin
Artificial
      | Word32
h forall a. Integral a => a -> a -> a
`mod` Word32
120 forall a. Eq a => a -> a -> Bool
== Word32
1 = (TerrainType
StoneT, forall a. a -> Maybe a
Just Text
"lambda")
      | Word32
h forall a. Integral a => a -> a -> a
`mod` Word32
50 forall a. Eq a => a -> a -> Bool
== Word32
0 = (TerrainType
StoneT, forall a. a -> Maybe a
Just ([Text] -> Text
T.concat [Text
"pixel (", forall source target. From source target => source -> target
from [[Char]
"RGB" forall a. [a] -> Seed -> a
!! forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int64
r forall a. Num a => a -> a -> a
+ Int64
c) forall a. Integral a => a -> a -> a
`mod` Int64
3)], Text
")"]))
      | Bool
otherwise = (TerrainType
StoneT, forall a. Maybe a
Nothing)
    genBiome Size
Big Hardness
Hard Origin
Artificial
      | forall {a} {a} {a}.
(Noise a, Integral a, Integral a) =>
(a, a) -> a -> Double
sample (Int64, Int64)
ix Perlin
cl0 forall a. Ord a => a -> a -> Bool
> Double
0.85 = (TerrainType
StoneT, forall a. a -> Maybe a
Just Text
"copper ore")
      | Bool
otherwise = (TerrainType
StoneT, forall a. Maybe a
Nothing)

    sample :: (a, a) -> a -> Double
sample (a
i, a
j) a
noise = forall a. Noise a => a -> Point -> Double
noiseValue a
noise (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i forall a. Fractional a => a -> a -> a
/ Double
2, forall a b. (Integral a, Num b) => a -> b
fromIntegral a
j forall a. Fractional a => a -> a -> a
/ Double
2, Double
0)

    pn :: Int -> Perlin
    pn :: Seed -> Perlin
pn Seed
seed = Seed -> Seed -> Double -> Double -> Perlin
perlin (Seed
seed forall a. Num a => a -> a -> a
+ Seed
baseSeed) Seed
6 Double
0.05 Double
0.6

    pn0 :: Perlin
pn0 = Seed -> Perlin
pn Seed
0
    pn1 :: Perlin
pn1 = Seed -> Perlin
pn Seed
1
    pn2 :: Perlin
pn2 = Seed -> Perlin
pn Seed
2

    -- alternative noise function
    -- rg :: Int -> Ridged
    -- rg seed = ridged seed 6 0.05 1 2

    clumps :: Int -> Perlin
    clumps :: Seed -> Perlin
clumps Seed
seed = Seed -> Seed -> Double -> Double -> Perlin
perlin (Seed
seed forall a. Num a => a -> a -> a
+ Seed
baseSeed) Seed
4 Double
0.08 Double
0.5

    cl0 :: Perlin
cl0 = Seed -> Perlin
clumps Seed
0

-- | Create a world function from a finite array of specified cells
--   plus a seed to randomly generate the rest.
testWorld2FromArray :: EntityMap -> Array (Int64, Int64) (TerrainType, Maybe Entity) -> Seed -> WorldFun TerrainType Entity
testWorld2FromArray :: EntityMap
-> Array (Int64, Int64) (TerrainType, Maybe Entity)
-> Seed
-> WorldFun TerrainType Entity
testWorld2FromArray EntityMap
em Array (Int64, Int64) (TerrainType, Maybe Entity)
arr Seed
seed = forall t e. (Coords -> (t, Maybe e)) -> WorldFun t e
WF forall a b. (a -> b) -> a -> b
$ \co :: Coords
co@(Coords (Int64
r, Int64
c)) ->
  if forall a. Ix a => (a, a) -> a -> Bool
inRange ((Int64, Int64), (Int64, Int64))
bnds (Int64
r, Int64
c)
    then Array (Int64, Int64) (TerrainType, Maybe Entity)
arr forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Int64
r, Int64
c)
    else forall t e. WorldFun t e -> Coords -> (t, Maybe e)
runWF WorldFun TerrainType Entity
tw2 Coords
co
 where
  tw2 :: WorldFun TerrainType Entity
tw2 = EntityMap -> Seed -> WorldFun TerrainType Entity
testWorld2 EntityMap
em Seed
seed
  bnds :: ((Int64, Int64), (Int64, Int64))
bnds = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds Array (Int64, Int64) (TerrainType, Maybe Entity)
arr

-- | Offset a world by a multiple of the @skip@ in such a way that it
--   satisfies the given predicate.
findOffset :: Integer -> ((Coords -> (t, Maybe e)) -> Bool) -> WorldFun t e -> WorldFun t e
findOffset :: forall t e.
Integer
-> ((Coords -> (t, Maybe e)) -> Bool)
-> WorldFun t e
-> WorldFun t e
findOffset Integer
skip (Coords -> (t, Maybe e)) -> Bool
isGood (WF Coords -> (t, Maybe e)
f) = forall t e. (Coords -> (t, Maybe e)) -> WorldFun t e
WF Coords -> (t, Maybe e)
f'
 where
  offset :: Enumeration Int64
  offset :: Enumeration Int64
offset = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer
skip forall a. Num a => a -> a -> a
*) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Enumeration Integer
int

  f' :: Coords -> (t, Maybe e)
f' =
    forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"the impossible happened, no offsets were found!")
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Coords -> (t, Maybe e)) -> Bool
isGood
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Int64, Int64) -> Coords -> (t, Maybe e)
shift
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enumeration a -> [a]
enumerate
      forall a b. (a -> b) -> a -> b
$ Enumeration Int64
offset forall a b. Enumeration a -> Enumeration b -> Enumeration (a, b)
>< Enumeration Int64
offset

  shift :: (Int64, Int64) -> Coords -> (t, Maybe e)
shift (Int64
dr, Int64
dc) (Coords (Int64
r, Int64
c)) = Coords -> (t, Maybe e)
f ((Int64, Int64) -> Coords
Coords (Int64
r forall a. Num a => a -> a -> a
- Int64
dr, Int64
c forall a. Num a => a -> a -> a
- Int64
dc))

-- | Offset the world so the base starts in a 32x32 patch containing at least one
--   of each of a list of required entities.
findPatchWith :: [Text] -> WorldFun t Entity -> WorldFun t Entity
findPatchWith :: forall t. [Text] -> WorldFun t Entity -> WorldFun t Entity
findPatchWith [Text]
reqs = forall t e.
Integer
-> ((Coords -> (t, Maybe e)) -> Bool)
-> WorldFun t e
-> WorldFun t e
findOffset Integer
32 forall {a}. (Coords -> (a, Maybe Entity)) -> Bool
isGoodPatch
 where
  patchCoords :: [(Int64, Int64)]
patchCoords = [(Int64
r, Int64
c) | Int64
r <- [-Int64
16 .. Int64
16], Int64
c <- [-Int64
16 .. Int64
16]]
  isGoodPatch :: (Coords -> (a, Maybe Entity)) -> Bool
isGoodPatch Coords -> (a, Maybe Entity)
f = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Ord a => a -> Set a -> Bool
`S.member` Set Text
es) [Text]
reqs
   where
    es :: Set Text
es = forall a. Ord a => [a] -> Set a
S.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Entity Text
entityName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coords -> (a, Maybe Entity)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64, Int64) -> Coords
Coords) forall a b. (a -> b) -> a -> b
$ [(Int64, Int64)]
patchCoords

-- | Offset the world so the base starts on empty spot next to tree and grass.
findTreeOffset :: WorldFun t Entity -> WorldFun t Entity
findTreeOffset :: forall t. WorldFun t Entity -> WorldFun t Entity
findTreeOffset = forall t e.
Integer
-> ((Coords -> (t, Maybe e)) -> Bool)
-> WorldFun t e
-> WorldFun t e
findOffset Integer
1 forall {a}. (Coords -> (a, Maybe Entity)) -> Bool
isGoodPlace
 where
  isGoodPlace :: (Coords -> (a, Maybe Entity)) -> Bool
isGoodPlace Coords -> (a, Maybe Entity)
f =
    Maybe Text -> (Int64, Int64) -> Bool
hasEntity forall a. Maybe a
Nothing (Int64
0, Int64
0)
      Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe Text -> (Int64, Int64) -> Bool
hasEntity (forall a. a -> Maybe a
Just Text
"tree")) [(Int64, Int64)]
neighbors
      Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(Int64, Int64)
c -> Maybe Text -> (Int64, Int64) -> Bool
hasEntity (forall a. a -> Maybe a
Just Text
"tree") (Int64, Int64)
c Bool -> Bool -> Bool
|| Maybe Text -> (Int64, Int64) -> Bool
hasEntity forall a. Maybe a
Nothing (Int64, Int64)
c) [(Int64, Int64)]
neighbors
   where
    hasEntity :: Maybe Text -> (Int64, Int64) -> Bool
hasEntity Maybe Text
mayE = (forall a. Eq a => a -> a -> Bool
== Maybe Text
mayE) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Entity Text
entityName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coords -> (a, Maybe Entity)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64, Int64) -> Coords
Coords

  neighbors :: [(Int64, Int64)]
neighbors = [(Int64
r, Int64
c) | Int64
r <- [-Int64
1 .. Int64
1], Int64
c <- [-Int64
1 .. Int64
1]]

-- | Offset the world so the base starts in a good patch (near
--   necessary items), next to a tree.
findGoodOrigin :: WorldFun t Entity -> WorldFun t Entity
findGoodOrigin :: forall t. WorldFun t Entity -> WorldFun t Entity
findGoodOrigin = forall t. WorldFun t Entity -> WorldFun t Entity
findTreeOffset forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. [Text] -> WorldFun t Entity -> WorldFun t Entity
findPatchWith [Text
"tree", Text
"copper ore", Text
"bit (0)", Text
"bit (1)", Text
"rock", Text
"lambda", Text
"water", Text
"sand"]