module Graphics.UI.FreeGame.Util (
notF,
(<&&>),
(<||>),
foreverTick,
untick,
untickInfinite,
randomness,
degrees,
radians,
unitV2,
angleV2,
sinCos,
loadPictureFromFile,
loadBitmaps,
loadBitmapsWith
) where
import Control.Applicative
import Control.Monad
import Control.Monad.Free
import Data.Char
import Data.Void
import Graphics.UI.FreeGame.Base
import Graphics.UI.FreeGame.Data.Bitmap
import Language.Haskell.TH
import Linear
import System.Directory
import System.FilePath
import System.IO.Unsafe
import System.Random
foreverTick :: MonadFree (UI n) m => m a -> m any
foreverTick m = m >> (tick >> foreverTick m)
notF :: Functor f => f Bool -> f Bool
notF = fmap not
(<&&>) :: Applicative f => f Bool -> f Bool -> f Bool
(<&&>) = liftA2 (&&)
(<||>) :: Applicative f => f Bool -> f Bool -> f Bool
(<||>) = liftA2 (||)
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
sinCos :: Floating a => a -> V2 a
sinCos = unitV2
untick :: (Functor n, MonadFree (UI n) m) => Free (UI n) a -> m (Either (Free (UI n) a) a)
untick (Pure a) = return (Right a)
untick (Free (Tick cont)) = return (Left cont)
untick (Free f) = wrap $ fmap untick f
untickInfinite :: (Functor n, MonadFree (UI n) m) => Free (UI n) Void -> m (Free (UI n) Void)
untickInfinite = liftM (either id absurd) . untick
randomness :: (Random r, MonadFree (UI n) m) => (r, r) -> m r
randomness = embedIO . randomRIO
degrees :: Float -> Float
degrees x = x / pi * 180
radians :: Float -> Float
radians x = x / 180 * pi
loadPictureFromFile :: (Picture2D p, MonadFree (UI n) m) => FilePath -> m (p ())
loadPictureFromFile = embedIO . fmap fromBitmap . 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 = '_'