Permalink
Browse files

Generalize mkTexture to PrimMonad m

  • Loading branch information...
1 parent 832e19c commit 9993021c2787f50c6c44eb7f2d2672e222fc19a9 @kfish committed Nov 23, 2011
Showing with 12 additions and 6 deletions.
  1. +8 −4 Graphics/TextureSynthesis.hs
  2. +4 −2 texture-synthesis.cabal
@@ -10,6 +10,7 @@ module Graphics.TextureSynthesis (
, flattenTexture
) where
+import Control.Monad.Primitive (PrimMonad, PrimState)
import Control.Parallel
import Data.Map (Map)
import qualified Data.Map as Map
@@ -39,17 +40,20 @@ textureEmpty :: Texture Float
textureEmpty = Texture 0 0 0 0 QuadNil
genTexture :: Int -> IO (Texture Float)
-genTexture = MWC.withSystemRandom . mkTexture
+genTexture = MWC.withSystemRandom . mkTextureIO
-mkTexture :: Int -> MWC.GenIO -> IO (Texture Float)
+mkTextureIO :: Int -> MWC.GenIO -> IO (Texture Float)
+mkTextureIO = mkTexture
+
+mkTexture :: PrimMonad m => Int -> MWC.Gen (PrimState m) -> m (Texture Float)
mkTexture !lim gen = do
quad <- mkQuad lim 0 0 0 0 0 0.5 0.5 gen
return (Texture 0 0 0 0 quad)
-mkQuad :: (Fractional a, MWC.Variate a)
+mkQuad :: (Fractional a, MWC.Variate a, PrimMonad m)
=> Int -> Int -> a -> a -> a -> a
-> a -> a
- -> MWC.GenIO -> IO (QuadTree a)
+ -> MWC.Gen (PrimState m) -> m (QuadTree a)
mkQuad !lim !lvl !tL !tR !bL !bR h range gen
| lvl >= lim = return QuadNil
| otherwise = do
View
@@ -36,7 +36,8 @@ Library
Build-depends:
containers >= 0.2 && < 0.5,
mwc-random,
- parallel
+ parallel,
+ primitive
-- Modules not exported by this package.
-- Other-modules:
@@ -58,7 +59,8 @@ Executable texture-synthesis
Build-Depends:
containers >= 0.2 && < 0.5,
mwc-random,
- parallel
+ parallel,
+ primitive
Test-suite tests
Type: exitcode-stdio-1.0

0 comments on commit 9993021

Please sign in to comment.