{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TypeFamilies #-}
module Apecs.Util (
runGC, global,
EntityCounter(..), nextEntity, newEntity,
quantize, flatten, inbounds, region, flatten',
) where
import Control.Applicative (liftA2)
import Control.Monad.Reader
import Data.Monoid
import Data.Semigroup
import System.Mem (performMajorGC)
import Apecs.Core
import Apecs.Stores
import Apecs.Stores.Extra
import Apecs.System
global :: Entity
global = Entity (-1)
newtype EntityCounter = EntityCounter {getCounter :: Sum Int} deriving (Semigroup, Monoid, Eq, Show)
instance Component EntityCounter where
type Storage EntityCounter = ReadOnly (Global EntityCounter)
{-# INLINE nextEntity #-}
nextEntity :: (MonadIO m, Get w m EntityCounter) => SystemT w m Entity
nextEntity = do EntityCounter n <- get global
setReadOnly global (EntityCounter $ n+1)
return (Entity . getSum $ n)
{-# INLINE newEntity #-}
newEntity :: (MonadIO m, Set w m c, Get w m EntityCounter)
=> c -> SystemT w m Entity
newEntity c = do ety <- nextEntity
set ety c
return ety
runGC :: System w ()
runGC = lift performMajorGC
{-# INLINE quantize #-}
quantize :: (Fractional (v a), Integral b, RealFrac a, Functor v)
=> v a
-> v a
-> v b
quantize cell vec = floor <$> vec/cell
{-# INLINE flatten #-}
flatten :: (Applicative v, Integral a, Foldable v)
=> v a
-> v a -> Maybe a
flatten size vec = if inbounds size vec then Just (flatten' size vec) else Nothing
{-# INLINE inbounds #-}
inbounds :: (Num a, Ord a, Applicative v, Foldable v)
=> v a
-> v a -> Bool
inbounds size vec = and (liftA2 (\v s -> v >= 0 && v <= s) vec size)
{-# INLINE region #-}
region :: (Enum a, Applicative v, Traversable v)
=> v a
-> v a
-> [v a]
region a b = sequence $ liftA2 enumFromTo a b
{-# INLINE flatten' #-}
flatten' :: (Applicative v, Integral a, Foldable v)
=> v a
-> v a -> a
flatten' size vec = foldr (\(n,x) acc -> n*acc + x) 0 (liftA2 (,) size vec)