{-# LANGUAGE OverloadedStrings #-}
module Swarm.Game.WorldGen where
import Control.Lens (view)
import Data.Array.IArray
import Data.Bifunctor (second)
import Data.Bool
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.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
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
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"
]
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)
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 target source. From source target => source -> target
into 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
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
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
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))
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
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]]
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"]