diff --git a/Graphics/Mars/Example.hs b/Graphics/Mars/Example.hs --- a/Graphics/Mars/Example.hs +++ b/Graphics/Mars/Example.hs @@ -7,10 +7,14 @@ Run an example function to view an image, or study the function source code for to see how the library can be used. + +Please be aware that breaking API changes to the Example functions +will not be tracked in library version numbering. It is recommended +that you do not link to these functions from any production code. -} module Graphics.Mars.Example where -import Prelude(IO, (.), ($), writeFile) +import Prelude(IO, (.), ($), writeFile, return, putStrLn) import Graphics.Gloss (black) import Data.Array.Unboxed (elems) import Graphics.Mars.Paint @@ -22,106 +26,115 @@ -- intensity graph -- -- @ --- example2D = do a <- graph height width radius walkfactor +-- example2D :: IO() +-- example2D = do putStrLn \"Generating the graph. This may take a minute or two.\" +-- a <- graph height width radius walkfactor -- seed iterations scalefactor startingpoint --- displayWindow (width, height) black "Mars" +-- displayWindow (width, height) black \"Mars\" -- (toImage a (lightnessInt hue (minMax (elems a)))) -- where (width, height) = (300, 300) -- radius = 30 -- walkfactor = 30 --- seed = 9484 +-- seed = 54844 -- hue = 272 --- iterations = 200 +-- iterations = 300 -- scalefactor = 1 --- startingpoint = (0, 0) +-- startingpoint = (0, -80) -- @ example2D :: IO() -example2D = do a <- graph height width radius walkfactor +example2D = do putStrLn "Generating the graph. This may take a minute or two." + a <- graph height width radius walkfactor seed iterations scalefactor startingpoint displayWindow (width, height) black "Mars" (toImage a (lightnessInt hue (minMax (elems a)))) where (width, height) = (300, 300) radius = 30 walkfactor = 30 - seed = 9484 + seed = 54844 hue = 272 - iterations = 200 + iterations = 300 scalefactor = 1 - startingpoint = (0, 0) + startingpoint = (0, -80) -- |Generates a random walk array, converts it PLY ascii format, and output the -- PLY to a file called \"out.ply\". -- -- @ --- examplePly = do a <- graph height width radius walkfactor +-- examplePly :: IO () +-- examplePly = do putStrLn \"Generating the graph. This may take a minute or two.\" +-- a <- graph height width radius walkfactor -- seed iterations scalefactor startingpoint --- writeFile "out.ply" $ (toPly . surface) a --- where (width, height) = (400, 400) --- radius = 10 --- walkfactor = 10 --- seed = 4748830300 --- iterations = 400 +-- writeFile \"out.ply\" $ (toPly . surface) a +-- putStrLn \"The file \'out.ply\' has been created in the current \\ +-- \\working directory.\" +-- where (width, height) = (300, 300) +-- radius = 30 +-- walkfactor = 30 +-- seed = 54844 +-- iterations = 300 -- scalefactor = 1 --- startingpoint = (0, 0) +-- startingpoint = (0, -80) -- @ examplePly :: IO () -examplePly = do a <- graph height width radius walkfactor +examplePly = do putStrLn "Generating the graph. This may take a minute or two." + a <- graph height width radius walkfactor seed iterations scalefactor startingpoint writeFile "out.ply" $ (toPly . surface) a - where (width, height) = (400, 400) - radius = 10 - walkfactor = 10 - seed = 4748830300 - iterations = 400 + putStrLn "The file 'out.ply' has been created in the current \ + \working directory." + where (width, height) = (300, 300) + radius = 30 + walkfactor = 30 + seed = 54844 + iterations = 300 scalefactor = 1 - startingpoint = (0, 0) + startingpoint = (0, -80) +-- |Similar to examplePly2, but generates two graphs and merges them together. +-- +-- @ +-- examplePly2 :: IO () +-- examplePly2 = do putStrLn \"Generating two graphs and merging them. This may \\ +-- \\take a few minutes.\" +-- a1 <- graph height width radius walkfactor +-- seed1 iterations scalefactor startingpoint1 +-- a2 <- graph height width radius walkfactor +-- seed2 iterations scalefactor startingpoint2 +-- let a3 = meldGraphs a1 a2 +-- let a4 = zRandomize 0.5 seed3 a3 +-- writeFile \"out2.ply\" $ (toPly . surface) a4 +-- putStrLn \"The file \'out2.ply\' has been created in the current \\ +-- \\working directory.\" +-- where (width, height) = (300, 300) +-- radius = 30 +-- walkfactor = 30 +-- iterations = 200 +-- scalefactor = 1 +-- seed1 = 3939423948 +-- startingpoint1 = (0, 0) +-- seed2 = 34209809 +-- startingpoint2 = (100, 100) +-- seed3 = 87484853049 +-- @ examplePly2 :: IO () -examplePly2 = do a <- graph height width radius walkfactor - seed iterations scalefactor startingpoint - writeFile "out2.ply" $ (toPly . surface) a - where (width, height) = (400, 400) - radius = 10 - walkfactor = 10 - seed = 84934 - iterations = 400 - scalefactor = 1 - startingpoint = (0, 0) - -examplePly3 :: IO () -examplePly3 = do a <- graph height width radius walkfactor - seed iterations scalefactor startingpoint - writeFile "out3.ply" $ (toPly . surface) a - where (width, height) = (400, 400) - radius = 10 - walkfactor = 10 - seed = 49409484 - iterations = 2000 - scalefactor = 1 - startingpoint = (0, 0) - -examplePly4 :: IO () -examplePly4 = do a <- graph height width radius walkfactor - seed iterations scalefactor startingpoint - writeFile "out4.ply" $ (toPly . surface) a - where (width, height) = (600, 600) - radius = 10 - walkfactor = 20 - seed = 1829384 - iterations = 4000 +examplePly2 = do putStrLn "Generating two graphs and merging them. This may \ + \take a few minutes." + a1 <- graph height width radius walkfactor + seed1 iterations scalefactor startingpoint1 + a2 <- graph height width radius walkfactor + seed2 iterations scalefactor startingpoint2 + let a3 = meldGraphs a1 a2 + let a4 = zRandomize 0.5 seed3 a3 + writeFile "out2.ply" $ (toPly . surface) a4 + putStrLn "The file 'out2.ply' has been created in the current \ + \working directory." + where (width, height) = (300, 300) + radius = 30 + walkfactor = 30 + iterations = 200 scalefactor = 1 - startingpoint = (0, 0) - --- |Warning: Large output file with 1 million vertices! May take a --- while to complete, with 40000 iterations. -examplePly5 :: IO () -examplePly5 = do a <- graph height width radius walkfactor - seed iterations scalefactor startingpoint - writeFile "out5.ply" $ (toPly . surface) a - where (width, height) = (1000, 1000) - radius = 15 - walkfactor = 15 - seed = 74830949937 - iterations = 40000 - scalefactor = 0.5 - startingpoint = ((-250), 250) + seed1 = 3939423948 + startingpoint1 = (0, 0) + seed2 = 34209809 + startingpoint2 = (100, 100) + seed3 = 87484853049 diff --git a/Graphics/Mars/Graph.hs b/Graphics/Mars/Graph.hs --- a/Graphics/Mars/Graph.hs +++ b/Graphics/Mars/Graph.hs @@ -10,12 +10,16 @@ -} module Graphics.Mars.Graph where -import Prelude((+), (*), fromIntegral, round, Float, Int, take, IO) +import Prelude + ((+), (*), fromIntegral, round, Float, Int, take, IO, map, + (-), return, sequence, max, (/=), error, zip) import Data.Array.IO (newArray, IOUArray, freeze) import Data.Array.Unboxed (UArray) +import Data.Array.IArray (elems, bounds, listArray) import Graphics.Mars.Stamp import Graphics.Mars.Walk import System.Random (mkStdGen) +import Control.Monad.Random (getRandomR, evalRand) -- |Beginning in the center, follows a random walk path, and stamps a circle -- shape onto the array at each step. Internally uses a mutable unboxed array @@ -28,7 +32,7 @@ -> Int -- ^ a seed value for the random number generator -> Int -- ^ numbers of steps to take in random walk -> Float -- ^ magnification factor - -> (Float, Float) -- ^ Starting point + -> (Float, Float) -- ^ starting point -> IO (UArray (Int, Int) Float) graph height width radius walkfactor seed iterations scalefactor sp = do a <- (newArray ((0, 0), (height, width)) 0.0 :: IO (IOUArray (Int, Int) Float)) @@ -37,3 +41,30 @@ [ (round (f1 + (fromIntegral height) * 0.5), round (f2 + (fromIntegral width) * 0.5)) | (f1, f2) <- walk walkfactor sp (mkStdGen seed) ]) freeze a + +-- |Adjust each float value in a UArray by some random value between +-- negative 'delta' and 'delta'. +zRandomize :: Float -- ^ delta + -> Int -- ^ seed value for random number generator + -> UArray (Int, Int) Float -- ^ input UArray + -> UArray (Int, Int) Float +zRandomize delta seed a = + listArray (bounds a) + (evalRand m (mkStdGen seed)) + where m = sequence (map f (elems a)) + f e = do r <- getRandomR ((0 - delta), delta) + return (e + r) + + +-- |From each pair of corresponding points on the two input UArrays, select the +-- the higher point, to create a new UArray. The two arrays must have the same +-- bounds, or an error is thrown. +meldGraphs :: UArray (Int, Int) Float + -> UArray (Int, Int) Float + -> UArray (Int, Int) Float +meldGraphs a1 a2 = + if bounds a1 /= bounds a2 + then error "UArray bounds must be equal" + else listArray (bounds a1) + (map (\(x, y) -> max x y) (zip (elems a1) (elems a2))) + diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,10 @@ # Changelog for [`mars` package](http://hackage.haskell.org/package/mars) +## 0.2.1.0 *Aug 2016* + + * Adds `zRandomize`, `meldGraphs` to `Graphics.Mars.Graph`. + * Modifies `Graphics.Mars.Example` examples. + ## 0.2.0.0 *Aug 2016* * Breaking modification of parameters for `Graphics.Mars.Graph.graph`, diff --git a/mars.cabal b/mars.cabal --- a/mars.cabal +++ b/mars.cabal @@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.2.0.0 +version: 0.2.1.0 -- A short (one-line) description of the package. synopsis: Generates mountainous terrain using a random walk algorithm.