Permalink
Browse files

gen: generate a stream of 100 textures

  • Loading branch information...
1 parent be1f1ab commit ae218c567a13baf81e1d9726783510bb970bd1b0 @kfish committed Dec 12, 2011
Showing with 7 additions and 7 deletions.
  1. +7 −7 tools/texture-synthesis.hs
View
@@ -7,7 +7,7 @@ module Main (
) where
import Control.Applicative ((<$>))
-import Control.Monad (foldM)
+import Control.Monad (foldM, replicateM_)
import Control.Monad.Trans (liftIO)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as C
@@ -141,18 +141,18 @@ texGenHandler = do
texWriteFile :: Config -> [FilePath] -> IO ()
texWriteFile _ [] = return ()
texWriteFile Config{..} (path:_) = do
- ss <- slices <$> flattenTexture 6 <$> genTexture 5
- -- ss <- slices <$> flattenTexture 5 <$> genTexture 4
- -- ss <- slices <$> flattenTexture 3 <$> genTexture 2
+ let mk = slices <$> flattenTexture 6 <$> genTexture 5
+ -- let mk = slices <$> flattenTexture 5 <$> genTexture 4
+ -- let mk = slices <$> flattenTexture 3 <$> genTexture 2
if variable
then do
let spec = oneTrackMultichannel channels (undefined :: Float) delta zlib VariableSR rate' label
- withFileWrite spec (not noRaw) (sW >> mapM_ (write track)
- (zip (map SO [10000,10002..]) ss)) path
+ withFileWrite spec (not noRaw) (sW >> liftIO mk >>= (\ss -> mapM_ (write track)
+ (zip (map SO [10000,10002..]) ss))) path
else do
let spec = oneTrackMultichannel channels (undefined :: Float) delta zlib ConstantSR rate' label
- withFileWrite spec (not noRaw) (sW >> mapM_ (write track) ss) path
+ withFileWrite spec (not noRaw) (sW >> replicateM_ 100 (liftIO mk >>= mapM_ (write track))) path
where
rate' = fromInteger rate
sW = setWatermark 1 wmLevel

0 comments on commit ae218c5

Please sign in to comment.