AoC/2019/day13/day13.hs

{-# LANGUAGE LambdaCase #-}

module Main where

import Data.List.Split
import qualified Data.Map.Strict as M
import Helpers
import Intcode
import Linear.V2
import System.Console.ANSI
import System.IO
  ( BufferMode(NoBuffering)
  , hReady
  , hSetBuffering
  , hSetEcho
  , stdin
  )

type ScreenBuffer = M.Map (V2 Int) Integer

main :: IO ()
main = do
  program <- readIntcode <$> readFile "input"
  mode <- queryMode
  let tm = defaultTM (Just (0, 2)) program
  let run x = runGameloop $ pure (tm {input = Just x}, M.empty, mode)
  (_, buf, _) <- run 0
  putStrLn $ "Final Highscore: " ++ getHighscore buf

queryMode :: IO Bool
queryMode = do
  putStrLn "Do you want to play the game yourself? [y/n]"
  getLine >>= \case
    "y" -> pure True
    "n" -> pure False
    _ -> do print "Illegal input."
            queryMode

runGameloop ::
     IO (TuringMachine, ScreenBuffer, Bool)
  -> IO (TuringMachine, ScreenBuffer, Bool)
runGameloop io = do
  (tm, buf, mode) <- io
  let tmNew = execSteps tm
  let bufNew = updateScreenBuffer buf $ reverse $ output tmNew
  putStrLn $ drawBoard bufNew
  putStrLn $ "Highscore: " ++ getHighscore bufNew
  putStrLn $ "Blocks left: " ++ countBlocks bufNew
  case state tmNew of
    Continue -> runGameloop $ pure (tmNew, bufNew, mode)
    AwaitInput -> do
      nextCommand <-
        if mode
          then do
            clearScreen
            getInput
          else pure $ getInputBot (output tmNew)
      runGameloop $
        pure (tmNew {input = Just nextCommand, output = []}, bufNew, mode)
    _ -> pure (tmNew, bufNew, mode)

getInputBot :: [Integer] -> Integer
getInputBot n = negate $ signum paddleBallDiff
  where
    f :: (V2 Int, V2 Int) -> [(V2 Int, Integer)] -> (V2 Int, V2 Int)
    (ball, paddle) = f (V2 0 0, V2 0 0) vals
    vals = M.toList $ updateScreenBuffer M.empty $ reverse n
    paddleBallDiff = fromIntegral $ v2x $ ball - paddle
    f (paddle, ball) [] = (paddle, ball)
    f (paddle, ball) ((coord, obj):xs)
      | obj == 4 = f (paddle, coord) xs
      | obj == 3 = f (coord, ball) xs
      | otherwise = f (paddle, ball) xs

getHighscore :: ScreenBuffer -> String
getHighscore buf = show $ M.findWithDefault 0 (V2 (-1) 0) buf

getInput :: IO Integer
getInput = do
  hSetBuffering stdin NoBuffering
  hSetEcho stdin False
  getKeyNow >>= \case
    "i" -> pure (-1)
    "a" -> pure 0
    "e" -> pure 1
    _ -> getInput

getKeyNow :: IO String
getKeyNow = reverse <$> getKey' ""
  where
    getKey' chars = do
      char <- getChar
      more <- hReady stdin
      (if more
         then getKey'
         else return)
        (char : chars)

updateScreenBuffer :: ScreenBuffer -> [Integer] -> ScreenBuffer
updateScreenBuffer buf xs = foldl pttrans buf $ chunksOf 3 xs
  where
    pttrans board [x, y, n] =
      M.insert (V2 (fromIntegral x) (fromIntegral y)) n board

countBlocks :: ScreenBuffer -> String
countBlocks = show . length . M.filter (== 2)

drawBoard :: ScreenBuffer -> String
drawBoard = drawMap (M.fromList [(1, '∥'), (2, '⌂'), (3, '—'), (4, '•')])