packages feed

piyo (empty) → 0.1.0.0

raw patch · 20 files changed

+907/−0 lines, 20 filesdep +basedep +extradep +piyosetup-changed

Dependencies added: base, extra, piyo, sdl2, sdl2-gfx, sdl2-image, sdl2-mixer, sdl2-ttf, text

Files

+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for piyo++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2018 peus++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,81 @@+# Piyo🐤++Haskell game engine like fantasy console.+Inspired by PICO-8.++![](pictures/piyo.png)++NOTE: UNDER DEVELOPMENT++## Feature++- minimum but simple api+- pure update funciton+- japanease bitmap font support++It supports PICO-8 like drawing api.++## Assuming Specification++For now below.++- display: 192x192+- sprite size: 12x12+- map size: 16x16++## Requirements++SDL2 needed.++### For OS X++Install middle wares with homebrew.+```+brew install sdl2 sdl2_gfx sdl2_image sdl2_mixer sdl2_ttf+```++### For others++It may work ..!++## Minimal code++```haskell+import Piyo++instance Game () where+    draw _ =+        [ cls Yellow+        , txt Black "Hello, World！" 48 48+        ]++main :: IO ()+main = piyo () Nothing+```++![](pictures/demo.png)++## Data Flow Schematic++Functions are called in order update, draw, sound every frame.++![](pictures/flow.svg)++## Indexing++Index number starts with 0. Not 1.++## Examples++Sample working code at [Examples](examples)++## Development in the future++- Redesign assets format+- Enrich sound api+- Add useful state update functions+- FPS management+- Support ore key action+- Sprite and map editor+- Export function for distribution+- etc...
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,25 @@+module Main where++import           Piyo+import           System.Environment             ( getArgs )+import           Data.Maybe                     ( listToMaybe )+++newtype Arg = Arg { unTag :: Maybe String }++instance Game Arg where+    draw s =+        [ cls Yellow+        , txt Black str 48 48+        ]+        where+            str = case unTag s of+                    Just arg -> arg+                    Nothing -> "Hello, World!"++-- print first argument in the game window +main :: IO ()+main = do+    args <- getArgs+    let s = Arg $ listToMaybe args+    piyo s Nothing
+ assets/fonts/JF-Dot-K12.ttf view

file too large to diff

+ assets/fonts/JF-Dot-K12B.ttf view

file too large to diff

+ piyo.cabal view
@@ -0,0 +1,98 @@+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: c20a5643221412b3bb584ecb66fd486d4cf830267ee205edec582cdab993a592++name:           piyo+version:        0.1.0.0+synopsis:       Haskell game engine like fantasy console.+description:    Please see the README on GitHub at <https://github.com/opyapeus/piyo#readme>+category:       Game+homepage:       https://github.com/opyapeus/piyo#readme+bug-reports:    https://github.com/opyapeus/piyo/issues+author:         peus+maintainer:     opyapeus@gmail.com+copyright:      2018 peus+license:        MIT+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10+extra-source-files:+    ChangeLog.md+    README.md+data-files:+    fonts/JF-Dot-K12.ttf+    fonts/JF-Dot-K12B.ttf+data-dir:       assets++source-repository head+  type: git+  location: https://github.com/opyapeus/piyo++library+  exposed-modules:+      Piyo+      Piyo.Game+      Piyo.Asset+      Piyo.Types+      Piyo.Draw+      Piyo.Sound+  other-modules:+      Piyo.Internal.Common+      Piyo.Internal.Config+      Piyo.Internal.Constants+      Piyo.Internal.InputState+      Piyo.Internal.Types+      Paths_piyo+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , extra+    , sdl2+    , sdl2-gfx+    , sdl2-image+    , sdl2-mixer+    , sdl2-ttf+    , text+  default-language: Haskell2010++executable piyo-exe+  main-is: Main.hs+  other-modules:+      Paths_piyo+  hs-source-dirs:+      app+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , extra+    , piyo+    , sdl2+    , sdl2-gfx+    , sdl2-image+    , sdl2-mixer+    , sdl2-ttf+    , text+  default-language: Haskell2010++test-suite piyo-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_piyo+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , extra+    , piyo+    , sdl2+    , sdl2-gfx+    , sdl2-image+    , sdl2-mixer+    , sdl2-ttf+    , text+  default-language: Haskell2010
+ src/Piyo.hs view
@@ -0,0 +1,94 @@+{-|+Module      : Piyo+Description : Haskell game engine like fantasy console.+Copyright   : (c) peus, 2018+License     : MIT+Maintainer  : opyapeus@gmail.com+Stability   : experimental+Portability : POSIX++Please see the README on GitHub at <https://github.com/opyapeus/piyo#readme>++Minimal working code is below. ++@+import Piyo++instance Game () where+    draw _ =+        [ cls Yellow+        , txt Black "Hello, World！" 48 48+        ]++main :: IO ()+main = piyo () Nothing+@++-}+module Piyo+  ( piyo+  , module Piyo.Game+  , module Piyo.Asset+  , module Piyo.Types+  , module Piyo.Draw+  , module Piyo.Sound+  )+where++import           Control.Monad.Extra            ( loopM )+import qualified SDL+import           Data.IORef+import           Data.Foldable                  ( toList )+import           Piyo.Internal.Common+import           Piyo.Internal.InputState+import           Piyo.Internal.Types+import           Piyo.Game+import           Piyo.Asset+import           Piyo.Types+import           Piyo.Draw+import           Piyo.Sound++-- | Start up game function.+-- First argument is state that user can flexibly define.+-- Second argument is asset (sprite, map, sound).+piyo :: Game s => s -> Maybe Asset -> IO ()+piyo initialState mAsset =+  withSDL+    $ withWindow+    $ \w -> withRenderer w $ \r ->+        withSound snds $ \chnks -> withImage img r $ \mTxtr ->+          withFont $ \font -> do+            let ra = RenderAsset r font mTxtr mapData++            -- clear screen+            cls Black ra+            -- init inputsRef+            inputsRef <- newIORef []++            loopM+              (\s -> do+                mEvent <- SDL.pollEvent+                let act = mkAction mEvent++                case act of+                  KeyInput km -> modifyIORef inputsRef (updateInputs km) -- update inputsRef+                  _           -> return ()+                -- read inputsRef+                inputs <- readIORef inputsRef++                case act of+                  Quit -> return $ Right ()+                  _    -> do+                    let ns       = update inputs s+                        drawOps  = draw ns+                        soundOps = sound ns+                    sequence_ $ drawOps <*> [ra]+                    sequence_ $ soundOps <*> [chnks]+                    SDL.present r+                    return $ Left ns+              )+              initialState+ where+  img     = mAsset >>= image+  snds    = toList mAsset >>= sounds+  mapData = toList mAsset >>= imap
+ src/Piyo/Asset.hs view
@@ -0,0 +1,11 @@+-- | Asset for draw and sound.+module Piyo.Asset+    ( defaultAsset+    )+where++import           Piyo.Internal.Types++-- | Empty asset.+defaultAsset :: Asset+defaultAsset = Asset {sounds = [], image = Nothing, imap = []}
+ src/Piyo/Draw.hs view
@@ -0,0 +1,197 @@+-- | Draw functions.+-- Last two arguments -> X -> Y is the drawing origin.+module Piyo.Draw+    ( cls+    , dot+    , line+    , rect+    , rectfill+    , circ+    , circfill+    , tri+    , trifill+    , spr+    , sprn+    , sprc+    , txt+    , txtb+    , mp+    )+where++import           Control.Monad.IO.Class         ( MonadIO )+import           Control.Monad+import           Foreign.C.Types                ( CInt )+import           SDL                            ( ($=) )+import qualified SDL+import qualified SDL.Primitive+import qualified SDL.Image+import qualified SDL.Font+import           Piyo.Internal.Types+import           Piyo.Internal.Constants+import           Data.Word                      ( Word8 )+import           Data.Text                      ( pack )+++-- | Clear the screen with given color.+cls :: MonadIO m => Color -> DrawOp m+cls c ra = setColor c ra >> SDL.clear (renderer ra)++-- | Draw rectangle with given color.+-- Origin is left-top.+rect :: MonadIO m => Color -> Width -> Height -> X -> Y -> DrawOp m+rect = rectF SDL.Primitive.rectangle++rectfill :: MonadIO m => Color -> Width -> Height -> X -> Y -> DrawOp m+rectfill = rectF SDL.Primitive.fillRectangle++rectF f c w h x y = \ra -> f (renderer ra) pa pb col+  where+    pa  = makePos x y+    pb  = makePos (x + w) (y + h)+    col = colorCode c++dot :: MonadIO m => Color -> X -> Y -> DrawOp m+dot c x y = \ra -> SDL.Primitive.pixel (renderer ra) p col+  where+    p   = makePos x y+    col = colorCode c++line :: MonadIO m => Color -> X -> Y -> X -> Y -> DrawOp m+line c xa ya xb yb = \ra -> SDL.Primitive.line (renderer ra) pa pb col+  where+    pa  = makePos xa ya+    pb  = makePos xb yb+    col = colorCode c++-- | Draw circle with given color.+-- Origin is center.+circ :: MonadIO m => Color -> Radius -> X -> Y -> DrawOp m+circ = circF SDL.Primitive.circle++circfill :: MonadIO m => Color -> Radius -> X -> Y -> DrawOp m+circfill = circF SDL.Primitive.fillCircle++circF f c r x y = \ra -> f (renderer ra) p r' col+  where+    p   = makePos x y+    r'  = fromIntegral r+    col = colorCode c++tri :: MonadIO m => Color -> X -> Y -> X -> Y -> X -> Y -> DrawOp m+tri = triF SDL.Primitive.triangle++trifill :: MonadIO m => Color -> X -> Y -> X -> Y -> X -> Y -> DrawOp m+trifill = triF SDL.Primitive.fillTriangle++triF f c xa ya xb yb xc yc = \ra -> f (renderer ra) pa pb pc col+  where+    pa  = makePos xa ya+    pb  = makePos xb yb+    pc  = makePos xc yc+    col = colorCode c++-- | Draw sprite.+-- Origin is left-top.+spr :: MonadIO m => IdX -> IdY -> X -> Y -> DrawOp m+spr xId yId = sprn xId yId 1 1++-- | Draw sprite for large size.+sprn :: MonadIO m => IdX -> IdY -> CntX -> CntY -> X -> Y -> DrawOp m+sprn xId yId bw bh = sprc x' y' w h+  where+    x' = boxSize * xId+    y' = boxSize * yId+    w  = boxSize * bw+    h  = boxSize * bh++-- | Draw sprite for any size.+sprc :: MonadIO m => X -> Y -> Width -> Height -> X -> Y -> DrawOp m+sprc xs ys w h xt yt ra = case mTxtr of+    Just txtr -> SDL.copy rdr txtr (Just rs) (Just rt)+    Nothing   -> return ()+  where+    mTxtr = mImage ra+    rdr   = renderer ra+    rs    = makeRect xs ys w h+    rt    = makeRect xt yt w h++-- | Draw text with given color.+-- Font is JF-Dot-K12.+-- Origin is left-top.+txt :: MonadIO m => Color -> String -> X -> Y -> DrawOp m+txt = txtF plain++-- | Draw bold text with given color.+-- Font is JF-Dot-K12B.+-- Origin is left-top.+txtb :: MonadIO m => Color -> String -> X -> Y -> DrawOp m+txtb = txtF bold++txtF f c t x y ra = do+    sfc    <- SDL.Font.solid font' col t'+    txtr   <- SDL.createTextureFromSurface rdr sfc+    (w, h) <- SDL.Font.size font' t'+    let rt = makeRect x y w h in SDL.copy rdr txtr Nothing (Just rt)+    SDL.freeSurface sfc+    SDL.destroyTexture txtr+  where+    t'    = pack t+    font' = f $ font ra+    rdr   = renderer ra+    col   = colorCode c++-- | Draw map (a set of sprites).+-- Origin is left-top.+mp :: MonadIO m => IdX -> IdY -> CntX -> CntY -> X -> Y -> DrawOp m+mp mx my mw mh x y ra = forM_+    im+    (\(vrt, il) -> forM_+        il+        (\(hr, (nx, ny)) -> do+            let w  = boxSize+                h  = boxSize+                xs = w * nx+                ys = h * ny+                xt = x + w * (mx + hr)+                yt = y + h * (my + vrt)+            unless (hr > mw || vrt > mh) $ sprc xs ys w h xt yt ra+        )+    )+  where+    m  = imageMap ra+    l  = zip [0 ..]+    im = l $ (map l) m+++setColor :: MonadIO m => Color -> DrawOp m+setColor c ra = SDL.rendererDrawColor (renderer ra) $= colorCode c++colorCode :: Color -> SDL.V4 Word8+colorCode Black      = SDL.V4 0 0 0 maxBound+colorCode DarkBlue   = SDL.V4 29 43 83 maxBound+colorCode DarkPurple = SDL.V4 126 37 83 maxBound+colorCode DarkGreen  = SDL.V4 0 135 81 maxBound+colorCode Brown      = SDL.V4 171 82 54 maxBound+colorCode DarkGray   = SDL.V4 95 87 79 maxBound+colorCode LightGray  = SDL.V4 194 195 199 maxBound+colorCode White      = SDL.V4 maxBound 241 232 maxBound+colorCode Red        = SDL.V4 maxBound 0 77 maxBound+colorCode Orange     = SDL.V4 maxBound 163 0 maxBound+colorCode Yellow     = SDL.V4 maxBound 236 39 maxBound+colorCode Green      = SDL.V4 0 228 54 maxBound+colorCode Blue       = SDL.V4 41 173 maxBound maxBound+colorCode Indigo     = SDL.V4 131 118 156 maxBound+colorCode Pink       = SDL.V4 maxBound 119 168 maxBound+colorCode Peach      = SDL.V4 maxBound 204 170 maxBound++makePos :: Int -> Int -> SDL.V2 CInt+makePos x y = SDL.V2 x' y' where (x', y') = (fromIntegral x, fromIntegral y)++makeRect :: Int -> Int -> Int -> Int -> SDL.Rectangle CInt+makeRect x y w h = SDL.Rectangle o z+  where+    (x', y', w', h') =+        (fromIntegral x, fromIntegral y, fromIntegral w, fromIntegral h)+    o = SDL.P (SDL.V2 x' y')+    z = SDL.V2 w' h'
+ src/Piyo/Game.hs view
@@ -0,0 +1,28 @@+-- | Game class.+-- Functions are called in order of update, draw, sound every frame.+module Piyo.Game+    ( Game(..)+    )+where++import           Control.Monad.IO.Class         ( MonadIO )+import           Piyo.Internal.Types++-- | Game class.+-- s is a state that user can flexibly define.+class Game s where+    -- | Update state.+    -- The state next frame is determined by keyboard input and previous state. +    -- There is no side effect in this function.+    update :: [Input] -> s -> s+    update _ = id++    -- | Draw.+    -- Oprations are determined by state.+    draw :: MonadIO m => s -> [DrawOp m]+    draw _ = []++    -- | Sound.+    -- Oprations are determined by state.+    sound :: MonadIO m => s -> [SoundOp m]+    sound _ = []
+ src/Piyo/Internal/Common.hs view
@@ -0,0 +1,80 @@+module Piyo.Internal.Common+    ( withSDL+    , withWindow+    , withRenderer+    , withSound+    , withImage+    , withFont+    )+where++import           Paths_piyo+import qualified SDL+import           SDL                            ( ($=) )+import qualified SDL.Font+import qualified SDL.Mixer+import qualified SDL.Image+import           Control.Monad                  ( void )+import           Control.Monad.IO.Class         ( MonadIO )+import           Data.Traversable               ( forM )+import           Data.Foldable                  ( forM_ )+import           Piyo.Internal.Types+import           Piyo.Internal.Constants+import           Piyo.Internal.Config+import           Piyo.Game+++withSDL :: (MonadIO m) => m a -> m ()+withSDL op = do+    SDL.initialize []+    void op+    SDL.quit++withWindow :: (MonadIO m) => (SDL.Window -> m a) -> m ()+withWindow op = do+    w <- SDL.createWindow title windowConfig+    SDL.windowMinimumSize w $= SDL.windowInitialSize windowConfig+    SDL.showWindow w+    void $ op w+    SDL.destroyWindow w++withRenderer :: (MonadIO m) => SDL.Window -> (SDL.Renderer -> m a) -> m ()+withRenderer w op = do+    r  <- SDL.createRenderer w (-1) rendererConfig+    ws <- SDL.get $ SDL.windowSize w+    SDL.rendererLogicalSize r $= Just ws+    void $ op r+    SDL.destroyRenderer r++withSound :: [FilePath] -> SoundOp IO -> IO ()+withSound []     op = void $ op []+withSound sounds op = SDL.Mixer.withAudio audioConfig chunkSize $ do+    SDL.Mixer.initialize audioFlugs+    chnks <- forM sounds SDL.Mixer.load+    void $ op chnks+    forM_ chnks SDL.Mixer.free+    SDL.Mixer.quit++withImage+    :: MonadIO m+    => Maybe FilePath+    -> SDL.Renderer+    -> (Maybe SDL.Texture -> m ())+    -> m ()+withImage (Just path) r op = do+    txtr <- SDL.Image.loadTexture r path+    void $ op (Just txtr)+    SDL.destroyTexture txtr+withImage Nothing r op = void $ op Nothing++withFont :: (Font -> IO ()) -> IO ()+withFont op = do+    SDL.Font.initialize+    fontPath'  <- Paths_piyo.getDataFileName fontPath+    fontBPath' <- Paths_piyo.getDataFileName fontBPath+    fontPlain  <- SDL.Font.load fontPath' fontSize+    fontBold   <- SDL.Font.load fontBPath' fontSize+    void $ op $ Font {plain = fontPlain, bold = fontBold}+    SDL.Font.free fontPlain+    SDL.Font.free fontBold+    SDL.Font.quit
+ src/Piyo/Internal/Config.hs view
@@ -0,0 +1,42 @@+module Piyo.Internal.Config+    ( windowConfig+    , rendererConfig+    , audioConfig+    , audioFlugs+    )+where++import qualified SDL+import qualified SDL.Mixer+import Piyo.Internal.Constants+++windowConfig :: SDL.WindowConfig+windowConfig = SDL.defaultWindow+    { SDL.windowInitialSize = makeV2 windowSize+    , SDL.windowResizable   = True+    }+    where+        makeV2 (x, y) = SDL.V2 (fromIntegral x) (fromIntegral y)++rendererConfig :: SDL.RendererConfig+rendererConfig = SDL.RendererConfig+    { SDL.rendererType          = SDL.AcceleratedVSyncRenderer+    , SDL.rendererTargetTexture = False+    }++audioConfig :: SDL.Mixer.Audio+audioConfig = SDL.Mixer.Audio+    { SDL.Mixer.audioFrequency = sampleFrequency+    , SDL.Mixer.audioFormat    = SDL.Mixer.FormatS16_Sys -- NOTE: output sample format+    , SDL.Mixer.audioOutput    = SDL.Mixer.Stereo+    }++audioFlugs :: [SDL.Mixer.InitFlag]+audioFlugs =+    [ SDL.Mixer.InitMOD+    , SDL.Mixer.InitOGG+    -- , SDL.Mixer.InitMP3+    -- , SDL.Mixer.InitFLAC+    ]+
+ src/Piyo/Internal/Constants.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}++module Piyo.Internal.Constants+    ( windowSize+    , title+    , fontPath+    , fontBPath+    , fontSize+    , boxSize+    , chunkSize+    , sampleFrequency+    )+where++import           Data.Text+++windowSize :: (Int, Int)+windowSize = (192, 192)++title :: Text+title = "PIYO"++fontPath :: FilePath+fontPath = "fonts/JF-Dot-K12.ttf"++fontBPath :: FilePath+fontBPath = "fonts/JF-Dot-K12B.ttf"++fontSize :: Int+fontSize = 12++boxSize :: Int+boxSize = 12++-- TODO: adjust+chunkSize :: Int+chunkSize = 16++sampleFrequency :: Int+sampleFrequency = 44100
+ src/Piyo/Internal/InputState.hs view
@@ -0,0 +1,52 @@+module Piyo.Internal.InputState+    ( updateInputs+    , mkAction+    , extractPayload+    , payloadToAction+    , getKey+    )+where++import qualified SDL+import           Data.List+import           Piyo.Internal.Common+import           Piyo.Internal.Types+++updateInputs :: KeyMotion -> [Input] -> [Input]+updateInputs (Pressed  i) is = union is [i]+updateInputs (Released i) is = is \\ [i]++mkAction :: Maybe SDL.Event -> Action+mkAction = maybe Idle (payloadToAction . extractPayload)++extractPayload :: SDL.Event -> SDL.EventPayload+extractPayload (SDL.Event _ p) = p++payloadToAction :: SDL.EventPayload -> Action+payloadToAction SDL.QuitEvent         = Quit+payloadToAction (SDL.KeyboardEvent k) = getKey k+payloadToAction _                     = Idle++getKey :: SDL.KeyboardEventData -> Action+getKey (SDL.KeyboardEventData _ SDL.Pressed False keysym) =+    case SDL.keysymKeycode keysym of+        SDL.KeycodeEscape -> Quit+        SDL.KeycodeUp     -> KeyInput (Pressed BtnUp)+        SDL.KeycodeDown   -> KeyInput (Pressed BtnDown)+        SDL.KeycodeLeft   -> KeyInput (Pressed BtnLeft)+        SDL.KeycodeRight  -> KeyInput (Pressed BtnRight)+        SDL.KeycodeZ      -> KeyInput (Pressed BtnA)+        SDL.KeycodeX      -> KeyInput (Pressed BtnB)+        _                 -> Idle+getKey (SDL.KeyboardEventData _ SDL.Released False keysym) =+    case SDL.keysymKeycode keysym of+        SDL.KeycodeEscape -> Quit+        SDL.KeycodeUp     -> KeyInput (Released BtnUp)+        SDL.KeycodeDown   -> KeyInput (Released BtnDown)+        SDL.KeycodeLeft   -> KeyInput (Released BtnLeft)+        SDL.KeycodeRight  -> KeyInput (Released BtnRight)+        SDL.KeycodeZ      -> KeyInput (Pressed BtnA)+        SDL.KeycodeX      -> KeyInput (Pressed BtnB)+        _                 -> Idle+getKey _ = Idle
+ src/Piyo/Internal/Types.hs view
@@ -0,0 +1,70 @@+module Piyo.Internal.Types where++import qualified SDL+import qualified SDL.Font+import qualified SDL.Mixer+++data Action = KeyInput KeyMotion | Idle | Quit+  deriving Show++data KeyMotion+  = Pressed Input+  | Released Input+  deriving Show++-- | Keyboard input patterns.+data Input = BtnUp | BtnDown | BtnLeft | BtnRight | BtnA | BtnB+  deriving (Show, Eq)++-- | Color patterns.+-- Same as PICO-8 color palette.+data Color+  = Black | DarkBlue | DarkPurple | DarkGreen+  | Brown | DarkGray | LightGray | White+  | Red | Orange | Yellow | Green+  | Blue | Indigo | Pink | Peach+  deriving (Show, Eq)++-- | Asset data for draw and sound.+data Asset = Asset+  { sounds :: [FilePath]+  , image :: Maybe FilePath+  , imap :: ImageMap+  }+  deriving Show++-- | 2d nested list.+-- The value means sprite indices.+type ImageMap = [[(IdX, IdY)]]++data RenderAsset = RenderAsset+  { renderer :: SDL.Renderer+  , font :: Font+  , mImage :: Maybe SDL.Texture+  , imageMap :: ImageMap+  }++data Font = Font+  { plain :: SDL.Font.Font+  , bold :: SDL.Font.Font+  }+  deriving Show++type DrawOp m = RenderAsset -> m ()++type SoundOp m = [SDL.Mixer.Chunk] -> m ()++-- | Posision value.+type X = Int+type Y = Int+-- | Length.+type Width = Int+type Height = Int+type Radius = Int+-- | Index number.+type IdX = Int+type IdY = Int+-- | Count number.+type CntX = Int+type CntY = Int
+ src/Piyo/Sound.hs view
@@ -0,0 +1,40 @@+-- | Sound functions.+-- It may be more development.+module Piyo.Sound+    ( ply+    , hlt+    , hltall+    )+where++import           Control.Monad.IO.Class         ( MonadIO )+import           Control.Monad+import qualified SDL.Mixer+import           Piyo.Internal.Types+import           Piyo.Internal.Config+++-- | Play sound on given channel.+-- Specify the sound by given index.+-- If the channel is already taken, halt previous then play.+ply :: MonadIO m => SDL.Mixer.Channel -> Int -> SoundOp m+ply ch n []    = return ()+ply ch n chnks = do+    hlt ch chnks+    forM_ chnk (SDL.Mixer.playOn ch SDL.Mixer.Once)+    where chnk = sliceOne n chnks++-- | Halt sound on given channel.+-- If the channel is already halted, do nothing.+hlt :: MonadIO m => SDL.Mixer.Channel -> SoundOp m+hlt ch [] = return ()+hlt ch _  = do+    isPlaying <- SDL.Mixer.playing ch+    when isPlaying $ SDL.Mixer.halt ch++-- | Halt sounds on all channels.+hltall :: MonadIO m => SoundOp m+hltall = return $ SDL.Mixer.halt SDL.Mixer.AllChannels++sliceOne i xs = take 1 $ drop i xs+
+ src/Piyo/Types.hs view
@@ -0,0 +1,20 @@+-- | Types.+-- Type synonyms are used for readability for now.+module Piyo.Types+    ( Input(..)+    , Color(..)+    , Asset(..)+    , ImageMap+    , X+    , Y+    , Width+    , Height+    , Radius+    , IdX+    , IdY+    , CntX+    , CntY+    )+where++import           Piyo.Internal.Types
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"