call 0.0 → 0.0.1

raw patch · 6 files changed

+107/−9 lines, 6 filesdep ~transformers

Dependency ranges changed: transformers

Files

call.cabal +3/−2
src/Call.hs +11/−5
src/Call/Data/Bitmap.hs +1/−1
src/Call/Internal/PortAudio.hs +89/−0
src/Call/Picture.hs +3/−0
src/Call/System.hs +0/−1

call.cabal view

@@ -1,5 +1,5 @@ name:                call
-version:             0.0
+version:             0.0.1
 synopsis:            The call game engine
 description:         Call is a minimalistic game engine which supports 2D graphics and sounds.
 homepage:            https://github.com/fumieval/call
@@ -23,6 +23,7 @@     Call.Component
     Call.Component.Deck
     Call.Internal.GLFW
+    Call.Internal.PortAudio
     Call.Data.Wave
     Call.Data.Font
     Call.Data.Bitmap
@@ -31,7 +32,7 @@   other-extensions:    Rank2Types, DeriveFunctor, DeriveFoldable, DeriveTraversable, DeriveDataTypeable, TemplateHaskell, CPP, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeSynonymInstances, ScopedTypeVariables, FlexibleInstances, FlexibleContexts, KindSignatures, TypeFamilies, BangPatterns, ViewPatterns, LambdaCase, DataKinds, GADTs
   build-depends:
     base >=4.5 && <5,
-    transformers >=0.4 && <0.5,
+    transformers >=0.3 && <0.5,
     control-bool >=0.2 && <0.3,
     colors >=0.1 && <0.2,
     linear >=1.10 && <1.11,

src/Call.hs view

@@ -19,22 +19,28 @@     KeyEvent(..),
     MouseEvent(..),
     -- * Concrete types
+    Vec2,
     WindowMode(..),
     BoundingBox2,
     Box(..),
     isInside,
     Picture(..),
-    Bitmap,
-    readBitmap,
     Affine(..),
     Picture2D(..),
-    Source(..),
-    readWAVE,
+    opacity,
+    BlendMode(..),
     Key(..),
     charToKey,
+    -- * Bitmap
+    Bitmap,
+    readBitmap,
+    clipBitmap,
+    loadBitmapsWith,
+    -- * Sound
+    Source(..),
+    readWAVE,
     -- * IO
     liftIO,
-    loadBitmapsWith,
     -- * Reexports
     module Control.Monad,
     module Control.Applicative,

src/Call/Data/Bitmap.hs view

@@ -34,7 +34,7 @@ import Control.Applicative
 import Data.Hashable
 
-data Bitmap = Bitmap (C.Image C.PixelRGBA8) Int
+data Bitmap = Bitmap { bitmapImage :: C.Image C.PixelRGBA8, bitmapHash :: Int }
 
 -- | Get the size of the 'Bitmap'.
 bitmapSize :: Bitmap -> (Int, Int)

+ src/Call/Internal/PortAudio.hs view

@@ -0,0 +1,89 @@+{-# LANGUAGE ViewPatterns, FlexibleContexts #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+module Call.Internal.PortAudio(Error(..), with) where
+
+import Bindings.PortAudio
+import Foreign.C.Types
+import Foreign hiding (with)
+import Control.Monad.IO.Class
+import Control.Monad
+import Linear
+import Control.Exception
+import Data.Typeable
+data Error = NotInitialized
+  | UnanticipatedHostError
+  | InvalidChannelCount
+  | InvalidSampleRate
+  | InvalidDevice
+  | InvalidFlag
+  | SampleFormatNotSupported
+  | BadIODeviceCombination
+  | InsufficientMemory
+  | BufferTooBig
+  | BufferTooSmall
+  | NullCallback
+  | BadStreamPtr
+  | TimedOut
+  | InternalError
+  | DeviceUnavailable
+  | IncompatibleHostApiSpecificStreamInfo
+  | StreamIsStopped
+  | StreamIsNotStopped
+  | InputOverflowed
+  | OutputUnderflowed
+  | HostApiNotFound
+  | InvalidHostApi
+  | CanNotReadFromACallbackStream
+  | CanNotWriteToACallbackStream
+  | CanNotReadFromAnOutputOnlyStream
+  | CanNotWriteToAnInputOnlyStream
+  | IncompatibleStreamHostApi
+  | BadBufferPtr
+  deriving (Show, Eq, Ord, Enum, Typeable)
+
+instance Exception Error
+
+fromErrorCode :: CInt -> Error
+fromErrorCode n = toEnum (fromIntegral n + 10000)
+{-
+data Host = Host Int String
+
+getHostApis :: MonadIO m => m [Host]
+getHostApis = liftIO $ do
+    n <- c'Pa_GetHostApiCount
+    forM [0..n - 1] $ \i -> do
+      info <- c'Pa_GetHostApiInfo i >>= peek
+      name <- peekCAString $ c'PaHostApiInfo'name info
+      return (Host (fromIntegral i) name)
+-}
+callback :: (Int -> IO [V2 Float]) -> Ptr () -> Ptr () -> CULong -> x -> y -> z -> IO CUInt
+callback f (castPtr -> _) (castPtr -> pout) (fromIntegral -> n) _ _ _ = do
+  f n >>= pokeArray pout
+  return c'paContinue
+
+with :: MonadIO m => Double -> Int -> (Int -> IO [V2 Float]) -> m a -> m a
+with rate buf f m = do
+    w c'Pa_Initialize
+    cb <- liftIO $ mk'PaStreamCallback $ callback f
+    
+    ps <- liftIO malloc
+    w $ c'Pa_OpenDefaultStream ps
+        0
+        2
+        1 -- Float
+        (realToFrac rate)
+        (fromIntegral buf)
+        cb
+        nullPtr
+    s <- liftIO $ peek ps
+
+    w $ c'Pa_StartStream s
+    r <- m
+    w $ c'Pa_StopStream s
+    w $ c'Pa_CloseStream s
+    w $ c'Pa_Terminate
+    return r
+    where
+      w n = do
+        r <- liftIO n
+        unless (r == 0) $ liftIO $ throwIO $ fromErrorCode r

src/Call/Picture.hs view

@@ -50,6 +50,9 @@     color :: Color -> p a -> p a
     blendMode :: BlendMode -> p a -> p a
 
+opacity :: Picture2D p => Float -> p a -> p a
+opacity a = color (Color 1 1 1 a)
+
 newtype Picture a = Picture { runPicture :: forall m. (Applicative m, Monad m, Picture2D m) => m a }
 
 instance Functor Picture where

src/Call/System.hs view

@@ -14,7 +14,6 @@ {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 -----------------------------------------------------------------------------