порвало
не попадает по кнопкам на клавиатуре и злится
РАЗОРВАЛО НА ЧАСТИ
https://gelbooru.com/index.php?page=post&s=view&id=9628468
>>20524
--import Debug.Trace
import System.Environment
import System.Exit
import System.IO
import qualified System.IO.Strict as IOS
-- do not want to run around in code removing traces every time!
trace :: a -> b -> b
trace _ b = b
data Cell
= Tree
| Open -- no tree
| Empty -- not initialized!
| Invalid -- out of boundaries
deriving (Show, Eq, Ord)
-- purely functional array yeeey!!
data Field =
Field
{ runField :: Int -> Int -> Cell
, fieldHeight :: Int
, fieldWidth :: Int
}
Just testF = emptyField (2, 2)
Just testF2 = emptyField (3, 2) >>= \f -> insertCell f (0, 0) Tree
Just testF3 = emptyField (2, 2) >>= \f -> insertCell f (1, 0) Tree
showRow :: Field -> Int -> String
showRow field y = foldl f "" ([0 .. (w - 1)])
where
f [] x = show $ runField field x y
f str x = str ++ "," ++ (show $ runField field x y)
w = fieldWidth field
showField :: Field -> String
showField field = glue . map (showRow field) $ [0 .. (h - 1)]
where
h = fieldHeight field
glue (x:[]) = x
glue (x:xs) = x ++ "\n" ++ (glue xs)
instance Show Field where
show f =
"{fieldHeight:" ++
(show $ fieldHeight f) ++
",fieldWidth:" ++
(show $ fieldWidth f) ++ ",field:\n" ++ (showField f) ++ "\n}"
cellInBoundaries :: (Int, Int, Int, Int) -> Bool
cellInBoundaries (h, w, x, y)
| x >= w || y >= h || x < 0 || y < 0 = False
| otherwise = True
emptyField :: (Int, Int) -> Maybe Field
emptyField (h, w)
| h <= 0 || w <= 0 = Nothing
| otherwise = Just $ Field f h w
where
f x y
| not $ cellInBoundaries (h, w, x, y) = Invalid
| otherwise = Empty
insertCell :: Field -> (Int, Int) -> Cell -> Maybe Field
insertCell f (x, y) c
| not $ cellInBoundaries (h, w, x, y) = Nothing
| otherwise = Just g
where
h = fieldHeight f
w = fieldWidth f
g' :: Int -> Int -> Cell
g' x' y'
| not $ cellInBoundaries (h, w, x', y') = Invalid
| x' == x && y' == y = c
| otherwise = runField f x' y'
g = Field g' h w
cat2FieldsVer :: Field -> Field -> Maybe Field
cat2FieldsVer fi1 fi2
| w1 /= w2 = Nothing
| otherwise = Just $ Field {runField = fun, fieldWidth = w, fieldHeight = h}
where
w1 = fieldWidth fi1
w2 = fieldWidth fi2
h1 = fieldHeight fi1
h2 = fieldHeight fi2
w = w1
h = trace (show $ h1 + h2) (h1 + h2)
rfi1 = runField fi1
rfi2 = runField fi2
fun x y
| not $ cellInBoundaries (h, w, x, y) = Invalid
| y < h1 = rfi1 x y
| otherwise = rfi2 x (y - h1)
catFieldsVer :: [Field] -> Maybe Field
catFieldsVer (x:xs) = cat' (Just x) xs
where
cat' :: Maybe Field -> [Field] -> Maybe Field
cat' mF (x:[]) = mF >>= \m -> cat2FieldsVer m x
cat' mF (x:xs) = mF >>= \m0 -> cat' (cat2FieldsVer m0 x) xs
parseString2Row :: String -> Maybe Field
parseString2Row str = fst $ foldl parse (emptyField (1, len), 0) str
where
len = length str
parse :: (Maybe Field, Int) -> Char -> (Maybe Field, Int)
parse (mF, cnt) ch =
case mF of
Nothing -> (Nothing, 0)
Just f
| ch /= '#' && ch /= '.' -> (Nothing, 0)
| ch == '#' -> (insertCell f (cnt, 0) Tree, cnt + 1)
| ch == '.' -> (insertCell f (cnt, 0) Open, cnt + 1)
mmap :: (Monad m) => [m a] -> m [a]
mmap (a:[]) = a >>= \a0 -> return [a0]
mmap (a:as) = a >>= \a0 -> mmap as >>= \a0s -> return $ a0 : a0s
parseTextualField :: [String] -> Maybe Field
parseTextualField strs =
(\x -> x >>= catFieldsVer) . mmap $ map parseString2Row strs
-- No checks here
getCell :: Field -> (Int, Int) -> Cell
getCell f (x, y) = runField f x' y'
where
h = fieldHeight f
w = fieldWidth f
x' =
if x >= w
then x
mod w
else x
y' =
if y >= h
then y
mod h
else y
calculate :: Field -> (Int, Int) -> (Int, Int) -> Int
calculate f (right, down) pos = go 0 pos
where
h = fieldHeight f
go :: Int -> (Int, Int) -> Int
go cnt (x, y)
| y >= h = cnt
| otherwise =
case getCell f (x, y) of
Tree -> go (cnt + 1) (x + right, y + down)
Open -> go cnt (x + right, y + down)
_ -> -1 -- should not happen (tm)
main = do
argv <- getArgs
let fp = argv !! 0
c <- IOS.readFile fp
field <-
case parseTextualField . lines $ c of
Nothing -> hPutStrLn stderr "Parse error, go figure" >> exitFailure
Just field -> return field
putStrLn . show $ calculate field (3, 1) (0, 0)
