5 import qualified Data.Text.IO as TIO
7 import qualified Data.Map.Strict as M
8 -- import Data.Map.Strict ((!))
10 -- import Data.Function (on)
12 type Position = (Int, Int) -- x, y
13 data Colour = Black | White deriving (Show, Eq, Ord)
14 data Direction = North | East | South | West deriving (Show, Eq, Ord, Enum, Bounded)
18 , _executionState :: ExecutionState
19 , _currentInput :: [Integer]
20 , _machineOutput :: [Integer]
21 , _currentPosition :: Position
22 , _currentDirection :: Direction
25 type Hull = M.Map Position Colour
30 text <- TIO.readFile "data/advent11.txt"
31 let mem = parseMachineMemory text
37 part1 mem = M.size hull
38 where ant = encapsulate mem []
39 hull = runAnt ant M.empty
41 part2 mem = showHull hull
42 where ant = encapsulate mem []
43 hull = runAnt ant (M.singleton (0, 0) White)
45 encapsulate :: [Integer] -> [Integer] -> Ant
46 encapsulate mem input = Ant
47 { _machine = makeMachine mem
48 , _executionState = Runnable
50 , _currentInput = input
51 , _currentPosition = (0, 0)
52 , _currentDirection = North
56 runAnt :: Ant -> Hull -> Hull
57 -- runAnt ant hull | trace (show ant ++ " -> " ++ (show (runAntStep ant)) ++ " -- " ++ show hull) False = undefined
58 runAnt ant hull = hull''
59 where ant' = runAntStep ant
60 output = _machineOutput ant'
61 hull' = if (null output) then hull else paint hull ant' (output!!0)
62 ant'' = if (null output) then ant' else move ant' (output!!1)
63 ant''' = camera ant'' hull
64 hull'' = if (_executionState ant' == Terminated)
66 else runAnt ant''' hull'
69 paint :: Hull -> Ant -> Integer -> Hull
70 paint hull ant 0 = M.insert (_currentPosition ant) Black hull
71 paint hull ant 1 = M.insert (_currentPosition ant) White hull
73 move :: Ant -> Integer -> Ant
74 move ant angle = ant { _currentDirection = direction', _currentPosition = position' }
75 where direction' = turn (_currentDirection ant) angle
76 delta = directionDelta direction'
77 position' = sumPos delta $ _currentPosition ant
79 camera :: Ant -> Hull -> Ant
80 camera ant hull = ant { _currentInput = input' }
81 where colour = M.findWithDefault Black (_currentPosition ant) hull
82 input = _currentInput ant
83 input' = input ++ [colourNum colour]
85 colourNum :: Colour -> Integer
89 turn :: Direction -> Integer -> Direction
90 turn direction 0 = predW direction
91 turn direction 1 = succW direction
93 directionDelta :: Direction -> Position
94 directionDelta North = ( 0 , 1)
95 directionDelta East = ( 1 , 0)
96 directionDelta South = ( 0 , -1)
97 directionDelta West = (-1 , 0)
99 sumPos :: Position -> Position -> Position
100 sumPos (a, b) (c, d) = (a + c, b + d)
103 runAntStep :: Ant -> Ant
104 runAntStep a = a { _machine = machine'
105 , _executionState = halted
106 , _machineOutput = output
108 where machine = _machine a
109 input = _currentInput a
110 (halted, machine', output) = runMachine input machine
113 showHull :: Hull -> String
114 showHull hull = unlines rows
115 where minX = minimum $ map fst $ M.keys hull
116 minY = minimum $ map snd $ M.keys hull
117 maxX = maximum $ map fst $ M.keys hull
118 maxY = maximum $ map snd $ M.keys hull
119 rows = [showHullRow hull minX maxX y | y <- reverse [minY..maxY]]
121 showHullRow :: Hull -> Int -> Int -> Int -> String
122 showHullRow hull minX maxX y = [showHullCell hull x y | x <- [minX..maxX]]
124 showHullCell :: Hull -> Int -> Int -> Char
125 showHullCell hull x y
126 | colour == White = '\x2588'
127 | colour == Black = ' '
128 where colour = M.findWithDefault Black (x, y) hull
131 -- | a `succ` that wraps
132 succW :: (Bounded a, Enum a, Eq a) => a -> a
133 succW dir | dir == maxBound = minBound
134 | otherwise = succ dir
136 -- | a `pred` that wraps
137 predW :: (Bounded a, Enum a, Eq a) => a -> a
138 predW dir | dir == minBound = maxBound
139 | otherwise = pred dir