module FreeGame.Util (
tick,
foreverTick,
foreverFrame,
untick,
untickInfinite,
randomness,
degrees,
radians,
unitV2,
angleV2,
loadPictureFromFile,
loadBitmaps,
loadBitmapsWith
) where
import Control.Applicative
import Control.Monad
import Control.Monad.Free.Class
import Control.Monad.Trans.Iter
import Control.Monad.Trans
import Control.Monad.Free.Church
import Data.Char
import Data.Void
import FreeGame.Data.Bitmap
import FreeGame.Class
import Language.Haskell.TH
import Linear
import System.Directory
import System.FilePath
import System.IO.Unsafe
import System.Random
import System.Environment
tick :: (Monad f, MonadFree f m) => m ()
tick = delay (return ())
foreverTick :: (Monad f, MonadFree f m) => m a -> m any
foreverTick m = let m' = foreverTick m in m >> wrap (return m')
foreverFrame :: (Monad f, Monad m, MonadTrans t, MonadFree f (t m)) => m a -> t m any
foreverFrame m = foreverTick (lift m)
untick :: (Functor f, MonadFree f m) => IterT (F f) a -> m (Either (IterT (F f) a) a)
untick = liftM (either Right Left) . iterM wrap . runIterT where
untickInfinite :: (Functor f, MonadFree f m) => IterT (F f) Void -> m (IterT (F f) Void)
untickInfinite = liftM (either absurd id) . iterM wrap . runIterT where
unitV2 :: Floating a => a -> V2 a
unitV2 t = V2 (cos t) (sin t)
angleV2 :: RealFloat a => V2 a -> a
angleV2 (V2 a b) = atan2 b a
randomness :: (Random r, FromFinalizer m) => (r, r) -> m r
randomness r = embedIO $ randomRIO r
degrees :: Floating a => a -> a
degrees x = x / pi * 180
radians :: Floating a => a -> a
radians x = x / 180 * pi
loadPictureFromFile :: (Picture2D p, FromFinalizer m) => FilePath -> m (p ())
loadPictureFromFile = embedIO . fmap bitmap . readBitmap
loadBitmapsWith :: ExpQ -> FilePath -> Q [Dec]
loadBitmapsWith getFullPath path = do
loc <- (</>path) <$> takeDirectory <$> loc_filename <$> location
paths <- runIO $ getFileList loc
sequence $ do
p <- paths
let name = pathToName p
[ return $ SigD (mkName name) (ConT ''Bitmap)
, funD (mkName name) [clause [] (normalB $ load name $ loc </> p) []]
]
where
load name fp = do
runIO $ putStrLn $ "Defined: " ++ fp ++ " as `" ++ name ++ "'"
appE (varE 'unsafePerformIO) $ uInfixE (appE getFullPath $ litE $ StringL fp)
(varE '(>>=))
(varE 'readBitmap)
loadBitmaps :: FilePath -> Q [Dec]
loadBitmaps path = do
v <- newName "v"
loadBitmapsWith (lamE [varP v] $
appsE [varE 'fmap, uInfixE
(infixE Nothing (varE '(</>)) (Just (varE v)))
(varE '(.))
(varE 'takeDirectory)
, varE 'getExecutablePath]) path
getFileList :: FilePath -> IO [FilePath]
getFileList path = do
allContents <- filter notHidden `fmap` getDirectoryContents path
files <- filterM (doesFileExist . (path</>)) allContents
dirs <- filterM (doesDirectoryExist . (path</>)) allContents
fmap ((files++).concat) $ forM dirs $ \i -> map (i</>) `fmap` getFileList (path</>i)
where
notHidden ('.':_) = False
notHidden _ = True
pathToName :: FilePath -> String
pathToName = ('_':) . map p where
p c | isAlphaNum c = c
| otherwise = '_'