57 lines
1.8 KiB
Haskell
57 lines
1.8 KiB
Haskell
module Dirty where
|
|
|
|
import Element
|
|
import Types
|
|
|
|
-- printing factory state with elements overlayed
|
|
-- very dirty code ahead
|
|
|
|
replaceNth :: Int -> a -> [a] -> [a]
|
|
replaceNth _ _ [] = []
|
|
replaceNth 0 a (first:rest) = a : rest
|
|
replaceNth n a (first:rest) = first : replaceNth (n-1) a rest
|
|
|
|
changeLine :: Element -> (Int, [Char]) -> (Int, [Char])
|
|
changeLine e (index, line)
|
|
| yPos e == index = (index, replaceNth (xPos e) (head $ show $ value e) line)
|
|
| otherwise = (index, line)
|
|
|
|
changeTiles :: Element -> [(Int, [Char])] -> [(Int, [Char])]
|
|
changeTiles e [] = []
|
|
changeTiles e cs = map (changeLine e) cs
|
|
|
|
putElements :: [Element] -> [(Int, [Char])] -> [(Int, [Char])]
|
|
putElements [e] cs = changeTiles e cs
|
|
putElements (e:es) cs = changeTiles e (putElements es cs)
|
|
|
|
indexFactory :: Factory -> [(Int, [Tile])]
|
|
indexFactory tiles = indexed
|
|
where indexed = zip [0..] tiles
|
|
|
|
indexCharFactory :: Factory -> [(Int, [Char])]
|
|
indexCharFactory f = zip [0..] charFactory
|
|
where charFactory = showFactory f
|
|
|
|
showFactory :: Factory -> [[Char]]
|
|
showFactory [] = []
|
|
showFactory f = map (map (head . show)) f
|
|
|
|
printFactory :: Factory -> [Element] -> IO ()
|
|
printFactory f es = mapM_ (putStrLn . snd) lines
|
|
where lines = putElements es $ indexCharFactory f
|
|
|
|
-- get tiles safely (boundary checks)
|
|
getTile :: Direction -> Factory -> Element -> Maybe Tile
|
|
getTile East f elem
|
|
| length (f !! yPos elem) < xPos elem + 2 = Nothing
|
|
| otherwise = Just $ (f !! yPos elem) !! (xPos elem + 1)
|
|
getTile South f elem
|
|
| length f < yPos elem + 2 = Nothing
|
|
| otherwise = Just $ (f !! (yPos elem + 1)) !! xPos elem
|
|
getTile West f elem
|
|
| xPos elem - 1 < 0 = Nothing
|
|
| otherwise = Just $ (f !! yPos elem) !! (xPos elem - 1)
|
|
getTile North f elem
|
|
| yPos elem - 1 < 0 = Nothing
|
|
| otherwise = Just $ (f !! (yPos elem - 1)) !! xPos elem
|