{-# LANGUAGE GADTs #-}
module Swarm.Game.World.Interpret (
interpBTerm,
interpConst,
interpReflect,
interpRot,
) where
import Control.Applicative (Applicative (..))
import Data.ByteString (ByteString)
import Data.Hash.Murmur (murmur3)
import Data.Tagged (unTagged)
import Numeric.Noise.Perlin (noiseValue, perlin)
import Swarm.Game.World.Abstract (BTerm (..))
import Swarm.Game.World.Coords (Coords (..))
import Swarm.Game.World.Gen (Seed)
import Swarm.Game.World.Syntax (Axis (..), Rot (..))
import Swarm.Game.World.Typecheck (Const (..), Empty (..), Over (..))
import Witch (from)
import Witch.Encoding qualified as Encoding
import Prelude hiding (Applicative (..))
interpBTerm :: Seed -> BTerm a -> a
interpBTerm :: forall a. Seed -> BTerm a -> a
interpBTerm Seed
seed (BApp BTerm (a1 -> a)
f BTerm a1
x) = forall a. Seed -> BTerm a -> a
interpBTerm Seed
seed BTerm (a1 -> a)
f (forall a. Seed -> BTerm a -> a
interpBTerm Seed
seed BTerm a1
x)
interpBTerm Seed
seed (BConst Const a
c) = forall a. Seed -> Const a -> a
interpConst Seed
seed Const a
c
interpConst :: Seed -> Const a -> a
interpConst :: forall a. Seed -> Const a -> a
interpConst Seed
seed = \case
CLit a
a -> a
a
CCell CellVal
c -> CellVal
c
Const a
CIf -> \Bool
b a1
t a1
e -> if Bool
b then a1
t else a1
e
Const a
CNot -> Bool -> Bool
not
Const a
CNeg -> forall a. Num a => a -> a
negate
Const a
CAbs -> forall a. Num a => a -> a
abs
Const a
CAnd -> Bool -> Bool -> Bool
(&&)
Const a
COr -> Bool -> Bool -> Bool
(||)
Const a
CAdd -> forall a. Num a => a -> a -> a
(+)
Const a
CSub -> (-)
Const a
CMul -> forall a. Num a => a -> a -> a
(*)
Const a
CDiv -> forall a. Fractional a => a -> a -> a
(/)
Const a
CIDiv -> forall a. Integral a => a -> a -> a
div
Const a
CMod -> forall a. Integral a => a -> a -> a
mod
Const a
CEq -> forall a. Eq a => a -> a -> Bool
(==)
Const a
CNeq -> forall a. Eq a => a -> a -> Bool
(/=)
Const a
CLt -> forall a. Ord a => a -> a -> Bool
(<)
Const a
CLeq -> forall a. Ord a => a -> a -> Bool
(<=)
Const a
CGt -> forall a. Ord a => a -> a -> Bool
(>)
Const a
CGeq -> forall a. Ord a => a -> a -> Bool
(>=)
Const a
CMask -> \World Bool
b World a1
x Coords
c -> if World Bool
b Coords
c then World a1
x Coords
c else forall e. Empty e => e
empty
Const a
CSeed -> forall a b. (Integral a, Num b) => a -> b
fromIntegral Seed
seed
CCoord Axis
ax -> \(Coords (Int32
x, Int32
y)) -> forall a b. (Integral a, Num b) => a -> b
fromIntegral (case Axis
ax of Axis
X -> Int32
x; Axis
Y -> Int32
y)
Const a
CHash -> \(Coords (Int32, Int32)
ix) -> forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> String
show forall a b. (a -> b) -> a -> b
$ (Int32, Int32)
ix
Const a
CPerlin -> \Integer
s Integer
o Double
k Double
p ->
let noise :: Perlin
noise = Seed -> Seed -> Double -> Double -> Perlin
perlin (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
s) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
o) Double
k Double
p
sample :: (Int32, Int32) -> Double
sample (Int32
i, Int32
j) = forall a. Noise a => a -> Point -> Double
noiseValue Perlin
noise (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i forall a. Fractional a => a -> a -> a
/ Double
2, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
j forall a. Fractional a => a -> a -> a
/ Double
2, Double
0)
in \(Coords (Int32, Int32)
ix) -> (Int32, Int32) -> Double
sample (Int32, Int32)
ix
CReflect Axis
ax -> \World a1
w -> World a1
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. Axis -> Coords -> Coords
interpReflect Axis
ax
CRot Rot
r -> \World a1
w -> World a1
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rot -> Coords -> Coords
interpRot Rot
r
Const a
CFI -> forall a. Num a => Integer -> a
fromInteger
Const a
COver -> forall m. Over m => m -> m -> m
(<!>)
Const a
K -> forall a b. a -> b -> a
const
Const a
S -> forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
Const a
I -> forall a. a -> a
id
Const a
B -> forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)
Const a
C -> forall a b c. (a -> b -> c) -> b -> a -> c
flip
Const a
Φ -> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
interpReflect :: Axis -> Coords -> Coords
interpReflect :: Axis -> Coords -> Coords
interpReflect Axis
ax (Coords (Int32
r, Int32
c)) = (Int32, Int32) -> Coords
Coords (case Axis
ax of Axis
X -> (Int32
r, -Int32
c); Axis
Y -> (-Int32
r, Int32
c))
interpRot :: Rot -> Coords -> Coords
interpRot :: Rot -> Coords -> Coords
interpRot Rot
rot (Coords (Int32, Int32)
crd) = (Int32, Int32) -> Coords
Coords (Rot -> (Int32, Int32) -> (Int32, Int32)
rotTuple Rot
rot (Int32, Int32)
crd)
where
rotTuple :: Rot -> (Int32, Int32) -> (Int32, Int32)
rotTuple = \case
Rot
Rot0 -> forall a. a -> a
id
Rot
Rot90 -> \(Int32
r, Int32
c) -> (-Int32
c, Int32
r)
Rot
Rot180 -> \(Int32
r, Int32
c) -> (-Int32
r, -Int32
c)
Rot
Rot270 -> \(Int32
r, Int32
c) -> (Int32
c, -Int32
r)