packages feed

free-game (empty) → 0.2.0.0

raw patch · 10 files changed

+744/−0 lines, 10 filesdep +JuicyPixels-repadep +arraydep +basesetup-changed

Dependencies added: JuicyPixels-repa, array, base, containers, filepath, free, mtl, parallel-io, random, repa, stb-truetype

Files

+ Graphics/FreeGame.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE CPP #-}
+module Graphics.FreeGame (
+    module Graphics.FreeGame.Base
+    ,module Graphics.FreeGame.Bitmap
+    ,module Graphics.FreeGame.Sound
+    ,module Graphics.FreeGame.Input
+    ,module Graphics.FreeGame.Util
+    ,runGame
+) where
+
+import Graphics.FreeGame.Base
+import Graphics.FreeGame.Bitmap
+import Graphics.FreeGame.Sound
+import Graphics.FreeGame.Input
+import Graphics.FreeGame.Util
+
+#ifdef mingw32_HOST_OS
+import qualified Graphics.FreeGame.Backends.DXFI as DXFI
+#endif
+
+
+-- | Run the 'Game'.
+runGame :: GameParam     
+    -> Game a
+    -> IO (Maybe a)
+
+#ifdef mingw32_HOST_OS
+runGame = DXFI.runGame
+#else
+runGame = undefined
+#endif
+ Graphics/FreeGame/Backends/DXFI.hs view
@@ -0,0 +1,315 @@+{-# LANGUAGE ForeignFunctionInterface #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Graphics.FreeGame.Backends.DXFI
+-- Copyright   :  (C) 2012 Fumiaki Kinoshita
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Fumiaki Kinsohita <fumiexcel@gmail.com>
+-- Stability   :  provisional
+-- Portability :  non-portable
+--
+-- DirectX Backend
+----------------------------------------------------------------------------
+module Graphics.FreeGame.Backends.DXFI (runGame) where
+import Graphics.FreeGame.Base
+import Graphics.FreeGame.Bitmap
+import Graphics.FreeGame.Input
+import Graphics.FreeGame.Sound
+import Control.Concurrent.ParallelIO.Local
+import Control.Monad.Trans
+import Control.Monad.State
+import Control.Monad.Free
+import Data.Bits
+import Data.Unique
+import Data.Word
+import Data.Array.Repa
+import qualified Data.IntMap as IM
+import Foreign.Ptr
+import Foreign.C.Types
+import Foreign.C.String
+import Foreign.Marshal.Alloc
+import Foreign.Storable
+import Codec.Picture.Repa
+import System.FilePath.Windows
+import System.Random
+import GHC.Conc
+
+type Handle = CInt
+foreign import ccall "DXFI_LoadImage" dxfi_LoadImage :: CWString -> IO Handle
+foreign import ccall "DXFI_LoadImageMatrix" dxfi_LoadImageMatrix :: CWString -> Int -> Int -> Int -> Int -> Int -> Ptr Handle -> IO ()
+foreign import ccall "DXFI_CropImage" dxfi_CropImage :: Int -> Int -> Int -> Int -> Handle -> IO Handle
+foreign import ccall unsafe "DXFI_DrawImage" dxfi_DrawImage :: Int -> Int -> Handle -> Bool -> IO ()
+foreign import ccall unsafe "DXFI_DrawImageScaledWithAngle" dxfi_DrawImageBy :: Int -> Int -> Double -> Double -> Handle -> Bool -> Bool -> IO ()
+foreign import ccall "DXFI_IsKeyPressed" dxfi_IsKeyPressed :: Int -> IO Bool
+foreign import ccall "DXFI_Initialize" dxfi_Initialize :: IO ()
+foreign import ccall "DXFI_Release" dxfi_Release :: IO ()
+foreign import ccall "DXFI_GetTickCount" dxfi_GetTickCount :: Bool -> IO Int
+foreign import ccall "DXFI_SetLogging" dxfi_SetLogging :: Bool -> IO ()
+foreign import ccall "DXFI_SetWindowMode" dxfi_SetWindowMode :: Bool -> IO ()
+foreign import ccall "DXFI_SetWindowSize" dxfi_SetWindowSize :: Int -> Int -> IO ()
+foreign import ccall "DXFI_SetWindowCaption" dxfi_SetWindowCaption :: CWString -> IO ()
+foreign import ccall "DXFI_SetDrawingDestination" dxfi_SetDrawingDestination :: Int -> IO ()
+foreign import ccall "DXFI_Wait" dxfi_Wait :: Int -> IO ()
+foreign import ccall "DXFI_ClearScreen" dxfi_ClearScreen :: Ptr () -> IO ()
+foreign import ccall "DXFI_SetBackgroundColor" dxfi_setBackgroundColor :: Int -> Int -> Int -> IO ()
+foreign import ccall "DXFI_FlipScreen" dxfi_FlipScreen :: IO ()
+foreign import ccall "DXFI_AcceptMessage" processMessage  :: IO Int
+foreign import ccall "DXFI_SetSoundVolumeOnce" dxfi_SetSoundVolumeOnce :: Int -> Handle -> IO ()
+foreign import ccall "DXFI_SetSoundPanOnce" dxfi_SetSoundPanOnce :: Int -> Handle -> IO ()
+foreign import ccall "DXFI_LoadSound" dxfi_LoadSound :: CWString -> Int -> Int -> IO Handle
+foreign import ccall "DXFI_PlaySound" dxfi_PlaySound :: Handle -> Int -> Bool -> IO ()
+foreign import ccall "DXFI_IsPlayingSound" dxfi_IsPlayingSound :: Handle -> IO Bool
+foreign import ccall "DXFI_CreateARGB8ColorBaseImage" dxfi_CreateARGB8ColorBaseImage :: Int -> Int -> Ptr a -> IO ()
+foreign import ccall unsafe "DXFI_SetPixelBaseImage" dxfi_SetPixelBaseImage :: Ptr a -> Int -> Int -> Word8 -> Word8 -> Word8 -> Word8 -> IO ()
+foreign import ccall "DXFI_ReleaseBaseImage" dxfi_ReleaseBaseImage :: Ptr a -> IO ()
+foreign import ccall "DXFI_CreateGraphFromBaseImage" dxfi_CreateGraphFromBaseImage :: Ptr a -> IO Handle
+foreign import ccall "DXFI_Helper_SizeOfBaseImage" dxfi_Helper_SizeOfBaseImage :: IO Int
+foreign import ccall "DXFI_DeleteImage" dxfi_DeleteImage :: Handle -> IO ()
+foreign import ccall "DXFI_DeleteSound" dxfi_DeleteSound :: Handle -> IO ()
+foreign import ccall "DXFI_GetMouseInput" dxfi_GetMouseInput :: IO Int
+foreign import ccall "DXFI_GetMouseWheelRotVol" dxfi_GetMouseWheelRotVol :: IO Int
+foreign import ccall "DXFI_GetMousePoint" dxfi_GetMousePoint :: Ptr CInt -> Ptr CInt -> IO ()
+
+loadImage :: Bitmap -> IO Handle
+loadImage bmp = do
+    let img = bitmapData bmp
+    let Z :. height :. width :. _ = extent img
+    bimg <- dxfi_Helper_SizeOfBaseImage >>= mallocBytes
+    dxfi_CreateARGB8ColorBaseImage width height bimg
+    withPool numCapabilities $ \pool -> parallel_ pool [
+        forM_ [0..width-1] $ \x ->
+            let r = (img !) $ Z :. y :. x :. 3
+                g = (img !) $ Z :. y :. x :. 2
+                b = (img !) $ Z :. y :. x :. 1
+                a = (img !) $ Z :. y :. x :. 0
+                in dxfi_SetPixelBaseImage bimg x y r g b a
+        | y <- [0..height-1]]
+    h <- dxfi_CreateGraphFromBaseImage bimg
+    dxfi_ReleaseBaseImage bimg
+    free bimg
+    return h
+
+unloadImage :: Handle -> IO ()
+unloadImage = dxfi_DeleteImage
+
+drawPicture' :: IM.IntMap Handle -> Picture -> IO ()
+drawPicture' m picture = forM_ (trans picture) $ \(_, (x, y), s, a, h) -> dxfi_DrawImageBy (floor x) (floor y) s a h True False where
+    trans (Image u) = [(False, (0,0), 1, 0, m IM.! hashUnique u)]
+    trans (Transform pic) = [(True, (x, y), s, a, h) | (_, (x, y), s, a, h) <- trans pic]
+    trans (NoTransform pic) = [(False, (x, y), s, a, h) | (_, (x, y), s, a, h) <- trans pic]
+    trans (Translate (dx, dy) pic) = [(f, (x + dx, y + dy), s, a, h) | (f, (x, y), s, a, h) <- trans pic]
+    trans (Rotate t pic) = [(f, (x * cos t - y * sin t, x * sin t + y * cos t), s, if f then a + t else a, h) | (f, (x, y), s, a, h) <- trans pic]
+    trans (Scale k pic) = [(f, (k * x, k * y), if f then k * s else s, a, h) | (f, (x, y), s, a, h) <- trans pic]
+    trans (Pictures ps) = concatMap trans ps
+    
+loadSound' :: FilePath -> IO Handle
+loadSound' path = withCWString path $ \x -> dxfi_LoadSound x 3 (-1)
+
+playSound' :: IM.IntMap Handle -> Sound -> IO ()
+playSound' m (Wave u) = do
+    let h = m IM.! hashUnique u
+    dxfi_PlaySound h 1 True
+
+unloadSound :: Handle -> IO ()
+unloadSound = dxfi_DeleteSound
+
+data SystemState = SystemState
+    {
+        sysLoadedImages :: IM.IntMap Handle
+        ,sysLoadedSounds :: IM.IntMap Handle
+        ,sysStartTime :: Int
+        ,sysFrameCount :: Int
+        ,sysRandomGen :: StdGen
+        ,sysTimeCriteria :: Int
+    }
+
+runGame :: GameParam -> Game a -> IO (Maybe a)
+runGame param game = do
+    dxfi_SetWindowMode (windowed param)
+    uncurry dxfi_SetWindowSize (windowSize param)
+    dxfi_SetLogging False
+    withCWString (windowTitle param) dxfi_SetWindowCaption
+    
+    dxfi_Initialize
+    dxfi_SetDrawingDestination (-2)
+    
+    time <- dxfi_GetTickCount False
+    gen <- maybe getStdGen (return . mkStdGen) $ randomSeed param
+    result <- run [] [] game `evalStateT` SystemState IM.empty IM.empty time 0 gen time
+    
+    dxfi_Release
+    
+    return result
+    where        
+        run :: [Int] -> [Int] -> Game a -> StateT SystemState IO (Maybe a)
+        run is ss (Pure a) = do
+            st <- get
+            lift $ forM_ is $ unloadImage . (sysLoadedImages st IM.!)
+            lift $ forM_ ss $ unloadSound . (sysLoadedSounds st IM.!)
+            put $ st { sysLoadedImages = foldr IM.delete (sysLoadedImages st) is
+                     , sysLoadedSounds = foldr IM.delete (sysLoadedSounds st) ss }
+            return (Just a)
+        
+        run is ss (Free x) = case x of
+        
+            DrawPicture pic cont -> do
+                st <- get
+                lift $ drawPicture' (sysLoadedImages st) pic
+                run is ss cont
+            
+            PlaySound sound cont -> do
+                st <- get
+                lift $ playSound' (sysLoadedSounds st) sound
+                run is ss cont
+            
+            AskInput key cont -> lift (isPressed key) >>= run is ss . cont
+            
+            Randomness r cont -> do
+                st <- get
+                let (v, g) = randomR r (sysRandomGen st)
+                put $ st {sysRandomGen = g}
+                run is ss $ cont v
+            
+            LoadPicture path cont -> do
+                st <- get
+                h <- lift $ loadImage path
+                u <- lift $ newUnique
+                put $ st { sysLoadedImages = IM.insert (hashUnique u) h (sysLoadedImages st) }
+                run (hashUnique u:is) ss $ cont (Image u)
+            
+            LoadSound path cont -> do
+                st <- get
+                h <- lift $ loadSound' path
+                u <- lift $ newUnique
+                put $ st { sysLoadedSounds = IM.insert (hashUnique u) h (sysLoadedSounds st) }
+                run is (hashUnique u:ss) $ cont (Wave u)
+            
+            GetMouseState cont -> do
+                (x, y) <- lift $ alloca $ \px -> alloca $ \py ->
+                    dxfi_GetMousePoint px py >> (,) `liftM` peek px `ap` peek py
+                b <- lift $ dxfi_GetMouseInput
+                w <- lift $ dxfi_GetMouseWheelRotVol
+                run is ss $ cont $ MouseState (fromIntegral x, fromIntegral y) (testBit b 0) (testBit b 2) (testBit b 1) w
+
+            EmbedIO m -> lift m >>= run is ss
+            
+            Bracket m -> run is ss m >>= maybe (return Nothing) (run is ss)
+            
+            GetRealTime cont -> lift (dxfi_GetTickCount False) >>= run is ss . cont . (/1000) . fromIntegral
+
+            ResetRealTime cont -> do
+                st <- get
+                t <- lift $ dxfi_GetTickCount False
+                put $ st { sysTimeCriteria = t }
+                run is ss cont
+
+            Tick cont -> do
+                lift dxfi_FlipScreen
+                
+                time <- lift $ dxfi_GetTickCount False
+                st@(SystemState _ _ startTime frameCount _ _) <- get
+                lift $ dxfi_Wait $ (frameCount * 1000) `div` framePerSecond param - time + startTime
+                
+                if time - startTime >= 1000
+                    then put $ st {sysStartTime　= time, sysFrameCount = 0}
+                    else put $ st {sysFrameCount = succ frameCount}
+                
+                p <- lift processMessage
+
+                if (p == 0)
+                    then pre >> run is ss cont
+                    else return Nothing
+                where
+                    pre = do
+                        lift (dxfi_ClearScreen nullPtr)
+                        lift $ dxfi_setBackgroundColor 255 255 255
+
+isPressed = dxfi_IsKeyPressed . k
+    where
+        k KeyEsc = 0x01
+        k (KeyChar '1') = 0x02
+        k (KeyChar '2') = 0x03
+        k (KeyChar '3') = 0x04
+        k (KeyChar '4') = 0x05
+        k (KeyChar '5') = 0x06
+        k (KeyChar '6') = 0x07
+        k (KeyChar '7') = 0x08
+        k (KeyChar '8') = 0x09
+        k (KeyChar '9') = 0x0A
+        k (KeyChar '0') = 0x0B
+        k (KeyChar '-') = 0x0C
+        k KeyBackspace  = 0x0E
+        k KeyTab = 0x0F
+        k (KeyChar 'Q') = 0x10
+        k (KeyChar 'W') = 0x11
+        k (KeyChar 'E') = 0x12
+        k (KeyChar 'R') = 0x13
+        k (KeyChar 'T') = 0x14
+        k (KeyChar 'Y') = 0x15
+        k (KeyChar 'U') = 0x16
+        k (KeyChar 'I') = 0x17
+        k (KeyChar 'O') = 0x18
+        k (KeyChar 'P') = 0x19
+        k (KeyChar '[') = 0x1A
+        k (KeyChar ']') = 0x1B
+        k KeyEnter = 0x1C
+        k KeyLeftControl = 0x1D
+        k (KeyChar 'A') = 0x1E
+        k (KeyChar 'S') = 0x1F
+        k (KeyChar 'D') = 0x20
+        k (KeyChar 'F') = 0x21
+        k (KeyChar 'G') = 0x22
+        k (KeyChar 'H') = 0x23
+        k (KeyChar 'J') = 0x24
+        k (KeyChar 'K') = 0x25
+        k (KeyChar 'L') = 0x26
+        k (KeyChar ';') = 0x27
+        k KeyLeftShift = 0x2A
+        k (KeyChar '\\') = 0x2B
+        k (KeyChar 'Z') = 0x2C
+        k (KeyChar 'X') = 0x2D
+        k (KeyChar 'C') = 0x2E
+        k (KeyChar 'V') = 0x2F
+        k (KeyChar 'B') = 0x30
+        k (KeyChar 'N') = 0x31
+        k (KeyChar 'M') = 0x32
+        k (KeyChar ',') = 0x33
+        k (KeyChar '.') = 0x34
+        k (KeyChar '/') = 0x35
+        k KeyRightShift = 0x36
+        k KeySpace = 0x39
+        k KeyF1 = 0x3B
+        k KeyF2 = 0x3C
+        k KeyF3 = 0x3D
+        k KeyF4 = 0x3E
+        k KeyF5 = 0x3F
+        k KeyF6 = 0x40
+        k KeyF7 = 0x41
+        k KeyF8 = 0x42
+        k KeyF9 = 0x43
+        k KeyF10 = 0x44
+        k KeyNumLock = 0x45
+        k KeyPad7 = 0x47
+        k KeyPad8 = 0x48
+        k KeyPad9 = 0x49
+        k KeyPad4 = 0x4B
+        k KeyPad5 = 0x4C
+        k KeyPad6 = 0x4D
+        k KeyPad1 = 0x4F
+        k KeyPad2 = 0x50
+        k KeyPad3 = 0x51
+        k KeyPad0 = 0x52
+        k KeyF11 = 0x57
+        k KeyF12 = 0x58
+        k KeyF13 = 0x64
+        k KeyF14 = 0x65
+        k KeyF15 = 0x66
+        k KeyHome = 0xC7
+        k KeyUp = 0xC8
+        k KeyLeft = 0xCB
+        k KeyRight = 0xCD
+        k KeyEnd = 0xCF
+        k KeyDown = 0xD0
+        k KeyInsert = 0xD2
+        k KeyDelete = 0xD3
+ Graphics/FreeGame/Base.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE ExistentialQuantification, FlexibleContexts, FlexibleInstances #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Graphics.FreeGame.Base
+-- Copyright   :  (C) 2012 Fumiaki Kinoshita
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Fumiaki Kinsohita <fumiexcel@gmail.com>
+-- Stability   :  provisional
+-- Portability :  non-portable
+--
+-- Abstract structure that represents user interfaces
+----------------------------------------------------------------------------
+
+module Graphics.FreeGame.Base (
+    Game
+    ,GameAction(..)
+    ,GameParam(..)
+    ,Picture(..)
+    ,transPicture
+    ,defaultGameParam
+    ,tick
+    ,playSound
+    ,drawPicture
+    ,loadPicture
+    ,askInput
+    ,loadSound
+    ,embedIO
+    ,bracket
+    ,getRealTime
+    ,resetRealTime
+    ,randomness
+) where
+
+import Control.Monad.Free
+import Control.Monad.Trans.Free (FreeT)
+import Control.Monad
+import Graphics.FreeGame.Bitmap
+import Graphics.FreeGame.Input
+import Graphics.FreeGame.Sound
+import System.Random
+import Data.Unique
+
+type Game = Free GameAction
+
+data GameAction cont
+    = Tick cont
+    | EmbedIO (IO cont)
+    | Bracket (Game cont)
+
+    | DrawPicture Picture cont
+    | LoadPicture Bitmap (Picture -> cont) 
+
+    | PlaySound Sound cont
+    | LoadSound FilePath (Sound -> cont)
+
+    | AskInput Key (Bool -> cont)
+    | GetMouseState (MouseState -> cont)
+
+    | GetRealTime (Float -> cont)
+    | ResetRealTime cont
+
+    | forall a. Random a => Randomness (a, a) (a -> cont)
+
+instance Functor GameAction where
+    fmap f (DrawPicture a cont) = DrawPicture a (f cont)
+    fmap f (LoadPicture a cont) = LoadPicture a (f . cont)
+    fmap f (PlaySound a cont)   = PlaySound a (f cont)
+    fmap f (LoadSound a cont)   = LoadSound a (f . cont)
+    fmap f (AskInput a cont)    = AskInput a (f . cont)
+    fmap f (Randomness a cont)  = Randomness a (f . cont)
+    fmap f (EmbedIO m) = EmbedIO (fmap f m)
+    fmap f (Bracket m) = Bracket (fmap f m)
+    fmap f (GetRealTime cont) = GetRealTime (f . cont)
+    fmap f (ResetRealTime cont) = ResetRealTime (f cont)
+    fmap f (Tick cont) = Tick (f cont)
+
+-- | Finalize the current frame and refresh the screen.
+tick :: MonadFree GameAction m => m ()
+tick = wrap $ Tick (return ())
+
+-- | Embed arbitrary 'IO' actions into a 'Game' monad.
+embedIO :: MonadFree GameAction m => IO a -> m a
+embedIO m = wrap $ EmbedIO $ liftM return m
+
+-- | Run a Game monad in the Game monad. resources (pictures, sounds) will be released when inner computation is done.
+bracket :: MonadFree GameAction m => Game a -> m a
+bracket m = wrap $ Bracket $ liftM return m
+
+-- | Draw a 'Picture'.
+drawPicture :: MonadFree GameAction m => Picture -> m ()
+drawPicture pic = wrap $ DrawPicture pic (return ())
+
+-- | Create 'Picture' from 'Bitmap'.
+loadPicture :: MonadFree GameAction m => Bitmap -> m Picture
+loadPicture img = wrap $ LoadPicture img return
+
+-- | Play 'Sound'.
+playSound :: MonadFree GameAction m => Sound -> m ()
+playSound sound = wrap $ PlaySound sound (return ())
+
+-- | Create 'Sound' from file.
+loadSound :: MonadFree GameAction m => FilePath -> m Sound
+loadSound path = wrap $ LoadSound path return
+
+-- | Is the specified key is pressed?
+askInput :: MonadFree GameAction m => Key -> m Bool
+askInput key = wrap $ AskInput key return
+
+-- | Get the mouse's state.
+getMouseState :: MonadFree GameAction m => m MouseState
+getMouseState = wrap $ GetMouseState return
+
+-- | Get elapsed time since program began or 'resetRealTime' was called.
+getRealTime :: MonadFree GameAction m => m Float
+getRealTime = wrap $ GetRealTime return
+
+-- | Reset the elapsed time.
+resetRealTime :: MonadFree GameAction m => m ()
+resetRealTime = wrap $ ResetRealTime (return ())
+
+-- | Get random value from specified range.
+randomness :: (Random r, MonadFree GameAction m) => (r, r) -> m r
+randomness r = wrap $ Randomness r return
+
+-- | Apply the function to all pictures in 'DrawPicture'.
+transPicture :: (Picture -> Picture) -> GameAction cont -> GameAction cont
+transPicture f (DrawPicture p cont) = DrawPicture (f p) cont
+transPicture _ x = x
+
+-- | A 2D Picture.
+data Picture
+    -- | An abstract image object.
+    = Image Unique
+    -- | Allow image transforming at Rotate/Scale.
+    | Transform Picture
+    -- | Don't allow image transforming at Rotate/Scale.
+    | NoTransform Picture
+    -- | Combined picture from some pictures.
+    | Pictures [Picture]
+    -- | Rotated picture counterclockwise by the given angle (in radians).
+    | Rotate Double Picture
+    -- | Scaled picture.
+    | Scale Double Picture
+    -- | A picture moved by the given coordinate.
+    | Translate (Double, Double) Picture
+
+
+-- | Parameters of the application.
+data GameParam = GameParam {
+        framePerSecond :: Int
+        ,windowSize :: (Int, Int)
+        ,windowTitle :: String
+        ,windowed :: Bool
+        ,randomSeed :: Maybe Int
+    }
+
+defaultGameParam :: GameParam
+defaultGameParam = GameParam 60 (640,480) "free-game" True Nothing
+ Graphics/FreeGame/Bitmap.hs view
@@ -0,0 +1,53 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Graphics.FreeGame.Bitmap
+-- Copyright   :  (C) 2012 Fumiaki Kinoshita
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Fumiaki Kinsohita <fumiexcel@gmail.com>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Manipulating bitmaps
+----------------------------------------------------------------------------
+
+module Graphics.FreeGame.Bitmap (Bitmap, bitmapData, loadBitmapFromFile, cropBitmap) where
+
+import Control.Applicative
+import Codec.Picture.Repa
+import Data.Array.Repa as R
+import Data.Word
+import qualified Data.Array.Repa.Repr.ForeignPtr as RF
+import Data.Array.IArray as A
+import qualified Graphics.Rendering.TrueType.STB as TT
+
+newtype Bitmap = Bitmap { bitmapData :: R.Array D DIM3 Word8 }
+
+-- | Create 'Bitmap' from given path.
+loadBitmapFromFile :: FilePath -> IO Bitmap
+loadBitmapFromFile path = Bitmap <$> delay <$> imgData <$> either error id <$> (readImageRGBA path)
+
+-- | Extract bitmap from the specified range.
+cropBitmap :: Bitmap -- ^original bitmap
+    -> (Int, Int) -- ^width and height
+    -> (Int, Int) -- ^x and y
+    -> Bitmap -- ^result
+cropBitmap (Bitmap img) (w, h) (x, y) = Bitmap $ extract (Z :. y :. x :. 0) (Z :. h :. w :. 4) img
+
+newtype Font = Font TT.BitmapCache
+
+loadFontFromFile :: FilePath -> (Float, Float) -> IO Font
+loadFontFromFile path sc = do
+    tt <- TT.loadTTF path
+    o <- head <$> TT.enumerateFonts tt
+    font <- TT.initFont tt o
+    Font <$> TT.newBitmapCache font False sc
+
+charToBitmap :: Font -> Char -> IO (Maybe (Bitmap, Float))
+charToBitmap (Font cache) ch = do
+    r <- TT.getCachedBitmap cache ch
+    case r of
+        Just (TT.CBM bmp@(TT.Bitmap (w,h) _) _ (TT.HMetrics adv _)) -> do
+            ar <- TT.bitmapArray bmp
+            return $ Just (Bitmap $ fromFunction (Z :. h :. w :. 4) (\(Z:.y:.x:._) -> ar A.! (y, x)), adv)
+        Nothing -> return Nothing
+ Graphics/FreeGame/Input.hs view
@@ -0,0 +1,78 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Graphics.FreeGame.Base
+-- Copyright   :  (C) 2012 Fumiaki Kinoshita
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Fumiaki Kinsohita <fumiexcel@gmail.com>
+-- Stability   :  provisional
+-- Portability :  non-portable
+--
+-- Common key and mouse inputs
+----------------------------------------------------------------------------
+
+module Graphics.FreeGame.Input where
+
+data MouseState = MouseState { position :: (Double, Double)
+        , leftButton :: Bool
+        , middleButton :: Bool
+        , rightButton :: Bool
+        , mouseWheel :: Int
+        } deriving (Eq, Ord, Show)
+
+data Key
+        = KeyChar Char
+        | KeySpace
+        | KeyEsc
+        | KeyF1
+        | KeyF2
+        | KeyF3
+        | KeyF4
+        | KeyF5
+        | KeyF6
+        | KeyF7
+        | KeyF8
+        | KeyF9
+        | KeyF10
+        | KeyF11
+        | KeyF12
+        | KeyF13
+        | KeyF14
+        | KeyF15
+        | KeyLeftShift
+        | KeyRightShift
+        | KeyLeftControl
+        | KeyRightControl
+        | KeyUp
+        | KeyDown
+        | KeyLeft
+        | KeyRight
+        | KeyTab
+        | KeyEnter
+        | KeyBackspace
+        | KeyInsert
+        | KeyNumLock
+        | KeyBegin
+        | KeyDelete
+        | KeyPageUp
+        | KeyPageDown
+        | KeyHome
+        | KeyEnd
+        | KeyPad0
+        | KeyPad1
+        | KeyPad2
+        | KeyPad3
+        | KeyPad4
+        | KeyPad5
+        | KeyPad6
+        | KeyPad7
+        | KeyPad8
+        | KeyPad9
+        | KeyPadDivide
+        | KeyPadMultiply
+        | KeyPadSubtract
+        | KeyPadAdd
+        | KeyPadDecimal
+        | KeyPadEqual
+        | KeyPadEnter
+        deriving (Show, Eq, Ord)
+ Graphics/FreeGame/Sound.hs view
@@ -0,0 +1,5 @@+module Graphics.FreeGame.Sound where
+
+import Data.Unique
+
+data Sound = Wave Unique
+ Graphics/FreeGame/Util.hs view
@@ -0,0 +1,23 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Graphics.FreeGame.Util
+-- Copyright   :  (C) 2012 Fumiaki Kinoshita
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Fumiaki Kinsohita <fumiexcel@gmail.com>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Transforming Game monads
+----------------------------------------------------------------------------
+
+module Graphics.FreeGame.Util where
+import Control.Monad.Free
+import qualified Control.Monad.Trans.Free as T
+import Graphics.FreeGame.Base
+
+-- | Run 'Game' as one frame.
+untickGame :: Game a -> Game (Game a)
+untickGame (Pure a) = Pure (Pure a)
+untickGame (Free (Tick cont)) = Pure cont
+untickGame (Free fm) = Free $ fmap untickGame fm
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2012, Fumiaki Kinoshita
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Fumiaki Kinoshita nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain
+ free-game.cabal view
@@ -0,0 +1,48 @@+name:                free-game
+version:             0.2.0.0
+synopsis:            Create graphical applications for free.
+description:
+    Create something graphical with useful free monads.
+    .
+    /Small instruction/
+    .
+    * load your image by loadBitmapFromFile, embedIO, and loadPicture.
+    .
+    * describe an application using drawPicture, askInput, tick, and so on, in Game monad.
+    .
+    * apply `runGame defaultGameParam` to run.
+    .
+    * That's all!
+    .
+    In windows, free-game requires DXFI.dll. You can obtain it from <http://botis.org/shared/dist/DXFI-0.2.dll>.
+
+homepage:            https://github.com/fumieval/free-game
+license:             BSD3
+license-file:        LICENSE
+author:              Fumiaki Kinoshita
+maintainer:          fumiexcel@gmail.com
+copyright:           Copyright (C) 2012 Fumiaki Kinoshita
+category:            Graphics
+build-type:          Simple
+cabal-version:       >=1.8
+
+library
+  exposed-modules:     Graphics.FreeGame
+    , Graphics.FreeGame.Util
+    , Graphics.FreeGame.Sound
+    , Graphics.FreeGame.Input
+    , Graphics.FreeGame.Bitmap
+    , Graphics.FreeGame.Base
+    , Graphics.FreeGame.Backends.DXFI
+  -- other-modules:       
+  build-depends: base == 4.5.*
+    , mtl >= 2.1
+    , containers >= 0.4
+    , free == 3.*
+    , random == 1.*
+    , repa >= 3.2
+    , JuicyPixels-repa >= 0.4
+    , array >= 0.3
+    , filepath >= 1.3
+    , parallel-io >= 0.3
+    , stb-truetype >= 0.1