AoC/2019/day11/day11.hs

module Main where

import Data.List
import Data.List.Split
import qualified Data.Map.Strict as M
import qualified Data.Vector as V
import Intcode
import Linear.V2
import Control.Lens

data RoboState =
  RoboState
    { hull :: M.Map (V2 Int) Integer
    , position :: V2 Int
    , direction :: V2 Int
    }
  deriving (Show)

main :: IO ()
main = do
  content <- readFile "input"
  let program = V.fromList $ concatMap (map read . splitOn ",") (lines content)
  let run x =
        runIntcode
          ( TM
              { tape = tapePreprocess program
              , pointer = 0
              , pointerOffset = 0
              , output = []
              , input = Just x
              , state = Continue
              }
          , RoboState {hull = M.empty, position = V2 0 0, direction = V2 0 1})
  print $ length $ hull $ snd $ run 0
  putStrLn $ drawHull $ M.filter (==1) $ hull $ snd $ run 1

drawHull :: M.Map (V2 Int) Integer -> String
drawHull m =
  intercalate "\n" $
  transpose $
  map reverse $
  chunksOf
    10
    [ case M.findWithDefault 0 (V2 x y) m of
      1 -> '•'
      _ -> ' '
    | x <- [(-5) .. 44]
    , y <- [(-5) .. 4]
    ]

runIntcode :: (TuringMachine, RoboState) -> (TuringMachine, RoboState)
runIntcode (tm, rb) =
  case state tmNew of
    Continue -> runIntcode (tmNew, rb)
    AwaitInput -> runIntcode $ updateState (tmNew, rb)
    _ -> (tmNew, rb)
  where
    tmNew = execSteps tm

updateState :: (TuringMachine, RoboState) -> (TuringMachine, RoboState)
updateState (tm, rb) = (tmNew, rbNew)
  where
    hullNew = M.insert (position rb) (output tm !! 1) (hull rb)
    dirNew =
      if head (output tm) == 0
        then perp $ direction rb
        else iterate perp (direction rb) !! 3
    posNew = position rb + dirNew
    floorNext = M.findWithDefault 0 posNew (hull rb)
    rbNew = rb {hull = hullNew, position = posNew, direction = dirNew}
    tmNew = tm {input = Just floorNext, output = []}