61 lines
2.2 KiB
Haskell
61 lines
2.2 KiB
Haskell
{-# LANGUAGE TupleSections, LambdaCase #-}
|
|
|
|
import Control.Applicative
|
|
import Control.Arrow (first, second, (&&&))
|
|
import Control.Monad
|
|
import Data.Array
|
|
import Data.List
|
|
import Data.Maybe
|
|
import Data.IORef
|
|
import System.IO
|
|
|
|
import qualified Data.Set as S
|
|
|
|
data Direction = UP | DOWN | LEFT | RIGHT deriving (Eq,Ord,Enum,Bounded,Show)
|
|
data Cell = Wall | Hollow | Start | Control | Unknown deriving (Eq,Ord,Enum,Bounded,Show)
|
|
type Maze = Array (Int,Int) Cell
|
|
|
|
main :: IO ()
|
|
main = do
|
|
hSetBuffering stdout NoBuffering -- DO NOT REMOVE
|
|
[rows,columns,alarmDelay] <- liftM (map read . words) getLine :: IO [Int]
|
|
leaving <- newIORef False
|
|
|
|
forever $ do
|
|
[row,column] <- liftM (map read . words) getLine :: IO [Int]
|
|
maze <- getMaze (rows, columns)
|
|
|
|
let cds = snd <$> findCell (\p c -> c == Control) (row,column) maze
|
|
when (cds == Just []) $ writeIORef leaving True
|
|
|
|
readIORef leaving >>= \case
|
|
True -> case snd <$> findCell (\p c -> c == Start) (row,column) maze of
|
|
Just (d:_) -> print d
|
|
False -> case cds of
|
|
Nothing -> case snd <$> findCell (\p c -> c == Unknown) (row,column) maze of
|
|
Just (d:_) -> print d
|
|
Just (d:_) -> print d
|
|
|
|
findCell :: ((Int,Int) -> Cell -> Bool) -> (Int,Int) -> Maze -> Maybe ((Int,Int),[Direction])
|
|
findCell f (sr,sc) mz = go [(sr,sc,[])] S.empty
|
|
where go [] _ = Nothing
|
|
go ((r,c,ds):ps) vs
|
|
| not (inRange (bounds mz) (r,c)) = go ps vs
|
|
| f (r,c) (mz!(r,c)) = Just ((r,c), reverse ds)
|
|
| S.member (r,c) vs = go ps vs
|
|
| (mz!(r,c)) `elem` [Wall,Unknown] = go ps (S.insert (r,c) vs)
|
|
| otherwise = let ns = [(r-1,c,UP:ds),(r+1,c,DOWN:ds),(r,c-1,LEFT:ds),(r,c+1,RIGHT:ds)]
|
|
in go (ps ++ ns) (S.insert (r,c) vs)
|
|
|
|
getMaze :: (Int, Int) -> IO Maze
|
|
getMaze (rows, columns) = array ((0,0),(rows-1,columns-1)) . concat <$>
|
|
forM [0..rows-1] (\r -> zipWith (\c x -> ((r,c),x)) [0..] . map decodeCell <$> getLine)
|
|
|
|
decodeCell :: Char -> Cell
|
|
decodeCell '#' = Wall
|
|
decodeCell '.' = Hollow
|
|
decodeCell 'T' = Start
|
|
decodeCell 'C' = Control
|
|
decodeCell '?' = Unknown
|
|
decodeCell _ = error "expected one of '#.TC?'"
|