module Graphics.FreeGame.Util (untick, untickGame, untickInfinite, randomness, degrees, radians, loadPictureFromFile, loadBitmaps) where
import Control.Monad
import Control.Monad.Free
import Data.Char
import Graphics.FreeGame.Base
import Graphics.FreeGame.Data.Bitmap
import System.Random
import Language.Haskell.TH
import System.Directory
import System.IO.Unsafe
import Data.Void
untickGame :: MonadFree GameAction m => Free GameAction a -> m (Free GameAction a)
untickGame (Pure a) = return (Pure a)
untickGame (Free (Tick cont)) = return cont
untickGame (Free fm) = wrap $ fmap untickGame fm
untick :: MonadFree GameAction m => Free GameAction a -> m (Either (Free GameAction a) a)
untick (Pure a) = return (Right a)
untick (Free (Tick cont)) = return (Left cont)
untick (Free f) = wrap $ fmap untick f
untickInfinite :: MonadFree GameAction m => Free GameAction Void -> m (Free GameAction Void)
untickInfinite = liftM (either id absurd) . untick
randomness :: (Random r, MonadFree GameAction m) => (r, r) -> m r
randomness r = embedIO $ randomRIO r
degrees :: Float -> Float
degrees x = x / pi * 180
radians :: Float -> Float
radians x = x / 180 * pi
loadPictureFromFile :: MonadFree GameAction m => FilePath -> m Picture
loadPictureFromFile = embedIO . fmap Bitmap . loadBitmapFromFile
loadBitmaps :: FilePath -> Q [Dec]
loadBitmaps path = do
paths <- runIO $ getFileList path
forM paths $ \p -> let name = pathToName p
in funD (mkName name) [clause [] (normalB $ load name $ path ++ '/' : p) []]
where
load name fp = do
runIO $ putStrLn $ "Defined: " ++ fp ++ " as `" ++ name ++ "'"
appE (varE 'unsafePerformIO) $ appE (varE 'loadBitmapFromFile) (litE $ StringL fp)
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
p </> q = p ++ '/' : q
pathToName :: FilePath -> String
pathToName = ('_':) . map p where
p c | isAlphaNum c = c
| otherwise = '_'