AoC/2019/day13/day13.hs

110 lines
3.0 KiB
Haskell
Raw Normal View History

2019-12-13 19:19:55 +01:00
{-# LANGUAGE LambdaCase #-}
2019-12-13 11:34:11 +01:00
module Main where
import Data.List.Split
import qualified Data.Map.Strict as M
import Helpers
import Intcode
import Linear.V2
2019-12-13 19:19:55 +01:00
import System.Console.ANSI
import System.IO
( BufferMode(NoBuffering)
, hReady
, hSetBuffering
, hSetEcho
, stdin
)
2019-12-13 11:34:11 +01:00
2019-12-13 19:19:55 +01:00
type ScreenBuffer = M.Map (V2 Int) Integer
2019-12-13 11:34:11 +01:00
main :: IO ()
main = do
2019-12-13 19:19:55 +01:00
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
2019-12-13 11:34:11 +01:00
case state tmNew of
2019-12-13 19:19:55 +01:00
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' ""
2019-12-13 11:34:11 +01:00
where
2019-12-13 19:19:55 +01:00
getKey' chars = do
char <- getChar
more <- hReady stdin
(if more
then getKey'
else return)
(char : chars)
2019-12-13 11:34:11 +01:00
2019-12-13 19:19:55 +01:00
updateScreenBuffer :: ScreenBuffer -> [Integer] -> ScreenBuffer
updateScreenBuffer buf xs = foldl pttrans buf $ chunksOf 3 xs
2019-12-13 11:34:11 +01:00
where
2019-12-13 19:19:55 +01:00
pttrans board [x, y, n] =
2019-12-13 11:34:11 +01:00
M.insert (V2 (fromIntegral x) (fromIntegral y)) n board
2019-12-13 19:19:55 +01:00
countBlocks :: ScreenBuffer -> String
countBlocks = show . length . M.filter (== 2)
2019-12-13 11:34:11 +01:00
2019-12-13 19:19:55 +01:00
drawBoard :: ScreenBuffer -> String
drawBoard = drawMap (M.fromList [(1, '∥'), (2, '⌂'), (3, '—'), (4, '•')])