106 lines
2.9 KiB
Haskell
106 lines
2.9 KiB
Haskell
import Common
|
|
import Prelude hiding (Right, Left)
|
|
import Data.List.Split (splitOn)
|
|
import Data.Char (isNumber)
|
|
import Data.List (elemIndex)
|
|
import Data.Maybe (fromJust, fromMaybe)
|
|
|
|
data Tile = Blank | Empty | Wall
|
|
deriving (Eq, Show, Enum)
|
|
data Direction = L | R
|
|
deriving (Eq, Show, Enum)
|
|
data Facing = Up | Down | Left | Right
|
|
deriving (Eq, Show, Enum)
|
|
data Instruction = Face Direction | Step Int
|
|
deriving (Eq, Show)
|
|
|
|
type State = (Pos, Facing)
|
|
|
|
parseMap :: String -> Grid Tile
|
|
parseMap s = map parseRow rows
|
|
where
|
|
parseRow = map parseTile
|
|
|
|
parseTile '#' = Wall
|
|
parseTile '.' = Empty
|
|
parseTile ' ' = Blank
|
|
parseTile _ = undefined
|
|
|
|
rows = lines s
|
|
|
|
turn :: Facing -> Direction -> Facing
|
|
turn Left R = Up
|
|
turn Up R = Right
|
|
turn Right R = Down
|
|
turn Down R = Left
|
|
turn Left L = Down
|
|
turn Up L = Left
|
|
turn Right L = Up
|
|
turn Down L = Right
|
|
|
|
charToDir :: Char -> Direction
|
|
charToDir 'L' = L
|
|
charToDir 'R' = R
|
|
charToDir _ = undefined
|
|
|
|
parseInstructions :: String -> [Instruction]
|
|
parseInstructions s = parseNum s
|
|
where
|
|
parseDirection :: String -> [Instruction]
|
|
parseDirection [] = []
|
|
parseDirection s = Face (charToDir (head s)) : parseNum (tail s)
|
|
parseNum :: String -> [Instruction]
|
|
parseNum [] = []
|
|
parseNum s = Step (read num) : parseDirection rest
|
|
where (num, rest) = span isNumber s
|
|
|
|
getInitialState :: Grid Tile -> State
|
|
getInitialState map = ((fromJust $ elemIndex Empty (head map), 0), Right)
|
|
|
|
forward :: Facing -> Pos
|
|
forward Right = (1, 0)
|
|
forward Down = (0, 1)
|
|
forward Left = (-1, 0)
|
|
forward Up = (0, -1)
|
|
|
|
opposite :: Facing -> Facing
|
|
opposite Right = Left
|
|
opposite Left = Right
|
|
opposite Up = Down
|
|
opposite Down = Up
|
|
|
|
getTile :: Grid Tile -> Pos -> Tile
|
|
getTile grid pos = fromMaybe Blank (grid !!? pos)
|
|
|
|
stepThrough :: (Grid Tile, [Instruction]) -> State
|
|
stepThrough (grid, instructions) = step (getInitialState grid) instructions
|
|
where
|
|
step :: State -> [Instruction] -> State
|
|
step state [] = state
|
|
step ((x, y), facing) (instruction:xs) = case instruction of
|
|
Face dir -> step ((x, y), turn facing dir) xs
|
|
Step 0 -> step ((x, y), facing) xs
|
|
Step n -> case wrappedTile of
|
|
Wall -> step ((x, y), facing) xs
|
|
Empty -> step (wrappedPos, facing) (Step (n - 1) : xs)
|
|
Blank -> error "huh?"
|
|
where
|
|
wrappedTile = getTile grid wrappedPos
|
|
wrappedPos = if newTile == Blank then (until (\pos -> getTile grid pos == Blank && pos /= newPos) (`subPos` forward facing) newPos) `addPos` forward facing else newPos
|
|
newTile = getTile grid newPos
|
|
newPos = (x, y) `addPos` forward facing
|
|
|
|
facingToInt :: Facing -> Int
|
|
facingToInt Right = 0
|
|
facingToInt Down = 1
|
|
facingToInt Left = 2
|
|
facingToInt Up = 3
|
|
|
|
getPassword :: State -> Int
|
|
getPassword ((x, y), f) = 1000 * (y + 1) + 4 * (x + 1) + facingToInt f
|
|
|
|
main = interact $
|
|
show
|
|
. getPassword
|
|
. stepThrough
|
|
. (\[a, b] -> (parseMap $ unlines a, parseInstructions $ head b)) . splitOn [""] . lines |