module Graphics.FreeGame.Util (
untick,
untickGame,
untickInfinite,
randomness,
degrees,
radians,
loadPictureFromFile,
loadBitmaps,
loadBitmapsWith) where
import Control.Monad
import Control.Monad.Free
import Control.Applicative
import Data.Char
import Graphics.FreeGame.Base
import Graphics.FreeGame.Data.Bitmap
import System.Random
import Language.Haskell.TH
import System.Directory
import System.FilePath
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
loadBitmapsWith :: Name -> 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 (varE getFullPath) (litE $ StringL fp))
(varE '(>>=))
(varE 'loadBitmapFromFile)
loadBitmaps :: FilePath -> Q [Dec]
loadBitmaps = loadBitmapsWith 'canonicalizePath
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 = '_'