Haskell Terrain Generator WIP

Main.hs

module Main(main) where

-- http://alpmestan.com/posts/2013-04-02-gloss-juicy-0-dot-1-load-juicypixels-images-in-your-gloss-applications.html

import Codec.Picture
import Graphics.Gloss
import Graphics.Gloss.Data.Color
import Graphics.Gloss.Juicy
import System.Random

width, height, offset :: Int
width = 384
height = 384
offset = 100
scaleF = 3

niceGreen :: Color
niceGreen = makeColorI 0 228 54 255
niceDarkGreen :: Color
niceDarkGreen = makeColorI 0 135 81 255
niceDarkBlue :: Color
niceDarkBlue = makeColorI 29 43 83 255
niceBrown :: Color
niceBrown = makeColorI 171 82 54 255
nicePurple :: Color
nicePurple = makeColorI 126 37 83 255

window :: Display
window = InWindow "Terrain" (width, height) (offset, offset)

background :: Color
background = niceDarkBlue

genHeightMap :: Int -> StdGen -> [Float] -> [Float]
genHeightMap _ _ [] = []
--genHeightMap _ _ (x:[]) = [x]
genHeightMap rndness r [a,b,c] = [a,displaced,c]
  where
    (d, nr) = next r 
    displaced = ((a + c) / 2) + fromIntegral (d `mod` rndness)
genHeightMap _ _ [a,b] = [a,b]
genHeightMap rndness r x = (genHeightMap nrndness lnr (firstHalf ++ [displaced])) ++ (genHeightMap nrndness rnr (displaced : (tail secondHalf)))
  where
    halfway = (length x) `quot` 2
    (firstHalf, secondHalf) = splitAt halfway x
    (displacement, lnr) = next r 
    (_, rnr) = next r 

    right = (secondHalf !! (length secondHalf - 1))
    left = head firstHalf
    displaced = ((right + left) / 2) + fromIntegral (displacement `mod` rndness) - fromIntegral (rndness `quot` 2)
    nrndness = rndness `quot` 2
    
genWorld :: [Float] -> Picture
genWorld world = pictures (map (\(x, y) -> mkSlice (x*3-192) (y-100)) (zip [0..] world))

mkSlice :: Float -> Float -> Picture
mkSlice x y = pictures [ color col $ translate x y $ rectangleSolid (1*scaleF) (96*scaleF), 
 color nicePurple $ translate x (y-30) $ rectangleSolid (1*scaleF) (96*scaleF),
 color niceBrown $ translate x (y-50) $ rectangleSolid (1*scaleF) (96*scaleF)]
  where
    col = if ((round x) `mod` 2) == 0
      then niceDarkGreen
      else niceGreen

main :: IO ()
main = do
  rando <- getStdGen
  display window background (genWorld (genHeightMap 400 rando (take 128 (repeat (-30)))))

terrain.cabal

-- Initial terrain.cabal generated by cabal init.  For further
-- documentation, see http://haskell.org/cabal/users-guide/

-- The name of the package.
name:                terrain

-- The package version.  See the Haskell package versioning policy (PVP)
-- for standards guiding when and how versions should be incremented.
-- https://wiki.haskell.org/Package_versioning_policy
-- PVP summary:      +-+------- breaking API changes
--                   | | +----- non-breaking API additions
--                   | | | +--- code changes with no API change
version:             0.1.0.0

-- A short (one-line) description of the package.
-- synopsis:

-- A longer description of the package.
-- description:

-- The license under which the package is released.
license:             BSD3

-- The file containing the license text.
license-file:        LICENSE

-- The package author(s).
author:              Ben Jones

-- An email address to which users can send suggestions, bug reports, and
-- patches.
maintainer:          [email protected]

-- A copyright notice.
-- copyright:

category:            Game

build-type:          Simple

-- Extra files to be distributed with the package, such as examples or a
-- README.
extra-source-files:  ChangeLog.md, pig.png

-- Constraint on the version of Cabal needed to build this package.
cabal-version:       >=1.10


executable terrain
  -- .hs or .lhs file containing the Main module.
  main-is:             Main.hs

  -- Modules included in this executable, other than Main.
  -- other-modules:

  -- LANGUAGE extensions used by modules in this package.
  -- other-extensions:

  -- Other library packages from which modules are imported.
  build-depends:       base >=4.11 && <4.12, gloss==1.12.*, JuicyPixels==3.2.9.5, gloss-juicy==0.2.2, random==1.1

  -- Directories containing source files.
  hs-source-dirs:      src
  
  -- Base language which the package is written in.
  default-language:    Haskell2010