2013-12-29 14:39:01 +01:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
2013-12-29 06:03:32 +01:00
|
|
|
module Map.Map
|
|
|
|
|
|
|
|
where
|
|
|
|
|
|
|
|
import System.Random
|
|
|
|
import Data.Array.IArray
|
2013-12-29 14:39:01 +01:00
|
|
|
import Data.Text as T
|
|
|
|
import Prelude as P
|
2013-12-29 06:03:32 +01:00
|
|
|
|
|
|
|
data TileType =
|
|
|
|
Grass
|
|
|
|
| Sand
|
|
|
|
| Water
|
|
|
|
| Mountain
|
|
|
|
deriving (Show, Eq)
|
|
|
|
|
|
|
|
type MapEntry = (
|
|
|
|
Float, -- ^ Height
|
|
|
|
TileType
|
|
|
|
)
|
|
|
|
|
|
|
|
type PlayMap = Array (Int, Int) MapEntry
|
|
|
|
|
2013-12-29 14:39:01 +01:00
|
|
|
-- if writing in ASCII-Format transpose so i,j -> y,x
|
|
|
|
-- row-minor -> row-major
|
|
|
|
testMapTemplate :: [Text]
|
|
|
|
testMapTemplate = T.transpose [
|
2014-01-01 20:32:35 +01:00
|
|
|
"~~~~~~~~~~~~~~~~~~~~",
|
|
|
|
"~~SSSSSSSSSSSSSS~~~~",
|
|
|
|
"~SSGGGGGGGSGSGGS~~~~",
|
|
|
|
"~SSGGGGGGMSGSGMS~~~~",
|
|
|
|
"~SGGGGGGMMMGGGS~~~S~",
|
|
|
|
"~SGGGMGMMMMMGGS~~~SS",
|
|
|
|
"~GGGGGGGGGGGGGGS~~~~",
|
|
|
|
"~SGGGGGGGGGGGGGS~~~~",
|
|
|
|
"~~SSSSGGGSSSSS~~~~~~",
|
|
|
|
"~~~~~SGGGGS~~~~~~~~~",
|
|
|
|
"~~~~SSGGGGSS~~~~~~~~",
|
|
|
|
"~~SSSGGGGGGSSSSS~~~~",
|
|
|
|
"~SSGSGSGGGSGSGGS~~~~",
|
|
|
|
"~SSGSGSGGMSGSGMS~~~~",
|
|
|
|
"~SGGMMMMGGGGGGS~~~~~",
|
|
|
|
"~SGMMMMMGGGGSSS~~~~~",
|
|
|
|
"~GGMMMMMGGGSSSSS~~~~",
|
|
|
|
"~SGGGGGGGSSSSSSS~~~~",
|
|
|
|
"~~SSSSSSSSSSSS~~~~~~",
|
|
|
|
"~~~~~~~~~~~~~~~~~~~~"
|
2013-12-29 06:03:32 +01:00
|
|
|
]
|
|
|
|
|
|
|
|
testmap :: IO PlayMap
|
|
|
|
testmap = do
|
|
|
|
g <- getStdGen
|
2013-12-29 14:39:01 +01:00
|
|
|
rawMap <- return $ parseTemplate (randoms g) (T.concat testMapTemplate)
|
2014-01-01 20:32:35 +01:00
|
|
|
return $ listArray ((0,0),(19,19)) rawMap
|
2013-12-29 06:03:32 +01:00
|
|
|
|
|
|
|
|
2013-12-29 14:39:01 +01:00
|
|
|
parseTemplate :: [Int] -> Text -> [MapEntry]
|
|
|
|
parseTemplate (r:rs) t =
|
|
|
|
(case T.head t of
|
2013-12-29 06:03:32 +01:00
|
|
|
'~' -> (0, Water)
|
|
|
|
'S' -> (0, Sand)
|
2013-12-29 18:18:18 +01:00
|
|
|
'G' -> (fromIntegral (r `mod` 3)/2.0,Grass)
|
|
|
|
'M' -> (fromIntegral (r `mod` 3 + 2)/2.0, Mountain)
|
2013-12-29 06:03:32 +01:00
|
|
|
_ -> error "invalid template format for map"
|
2013-12-29 14:39:01 +01:00
|
|
|
):parseTemplate rs (T.tail t)
|
|
|
|
parseTemplate [] _ = error "out of randoms.."
|