From 3e42c475859db70dc155a7e41328b4527eb06cb6 Mon Sep 17 00:00:00 2001 From: shu Date: Fri, 13 Dec 2019 19:19:55 +0100 Subject: [PATCH] Day 13: Enterprise it up --- 2019/day13/Helpers.hs | 5 ++ 2019/day13/Intcode.hs | 23 ++++++-- 2019/day13/day13.hs | 129 +++++++++++++++++++++++++++++------------- 3 files changed, 115 insertions(+), 42 deletions(-) diff --git a/2019/day13/Helpers.hs b/2019/day13/Helpers.hs index 58b93c8..d8ba253 100644 --- a/2019/day13/Helpers.hs +++ b/2019/day13/Helpers.hs @@ -2,11 +2,13 @@ module Helpers ( v2x , v2y , drawMap + , readIntcode ) where import Data.List import Data.List.Split import qualified Data.Map as M +import qualified Data.Vector as V import Linear.V2 v2x :: V2 a -> a @@ -38,3 +40,6 @@ drawMap dict m = ] where (x1, y1, x2, y2) = getBounds m + +readIntcode :: String -> V.Vector Integer +readIntcode = V.fromList . concatMap (map read . splitOn ",") . lines diff --git a/2019/day13/Intcode.hs b/2019/day13/Intcode.hs index a612aac..2d04192 100644 --- a/2019/day13/Intcode.hs +++ b/2019/day13/Intcode.hs @@ -2,7 +2,7 @@ module Intcode ( TuringMachine(TM, tape, pointer, pointerOffset, output, input, state) , step - , tapePreprocess + , defaultTM , TMOutState(Continue, AwaitInput, Halt) , execSteps ) where @@ -47,8 +47,20 @@ data TuringMachine = } deriving (Show) -tapePreprocess :: Vector Integer -> (Int,Integer) -> Vector Integer -tapePreprocess t (target,repl) = flip (//) [(target, repl)] $ (V.++) t $ V.replicate 500 0 +defaultTM :: Maybe (Int, Integer) -> Vector Integer -> TuringMachine +defaultTM replacement t = + TM + { tape = maybe t (tapePreprocess t) replacement + , pointer = 0 + , pointerOffset = 0 + , output = [] + , input = Nothing + , state = Continue + } + +tapePreprocess :: Vector Integer -> (Int, Integer) -> Vector Integer +tapePreprocess t (target, repl) = + flip (//) [(target, repl)] $ (V.++) t $ V.replicate 500 0 opLength :: Integer -> Integer opLength x @@ -89,7 +101,10 @@ step tm = case op of "1" -> tmBinop (+) "2" -> tmBinop (*) - "3" -> if isJust (input tm) then (getNewTM (fromJust $ input tm)){input = Nothing} else tm {state = AwaitInput} + "3" -> + if isJust (input tm) + then (getNewTM (fromJust $ input tm)) {input = Nothing} + else tm {state = AwaitInput} "4" -> tmn {output = V.last params : output tm} "5" -> tm diff --git a/2019/day13/day13.hs b/2019/day13/day13.hs index af1302f..5236323 100644 --- a/2019/day13/day13.hs +++ b/2019/day13/day13.hs @@ -1,56 +1,109 @@ +{-# LANGUAGE LambdaCase #-} + module Main where import Data.List.Split import qualified Data.Map.Strict as M -import qualified Data.Vector as V import Helpers import Intcode import Linear.V2 +import System.Console.ANSI +import System.IO + ( BufferMode(NoBuffering) + , hReady + , hSetBuffering + , hSetEcho + , stdin + ) -data GameState = - GameState - { board :: M.Map (V2 Int) Integer - } - deriving (Show) +type ScreenBuffer = M.Map (V2 Int) Integer main :: IO () main = do - content <- readFile "input" - let program = V.fromList $ concatMap (map read . splitOn ",") (lines content) - let run x y = - runIntcode - ( TM - { tape = tapePreprocess program (0, y) - , pointer = 0 - , pointerOffset = 0 - , output = [] - , input = Just x - , state = Continue - } - , GameState {board = M.empty}) - print $ countBlocks $ run 0 1 - putStrLn $ drawBoard $ run 0 1 + 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 -runIntcode :: (TuringMachine, GameState) -> (TuringMachine, GameState) -runIntcode (tm, gb) = +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 -> runIntcode (tmNew, gb) - AwaitInput -> runIntcode (tmNew, gb) - _ -> (tmNew, gb) - where - tmNew = execSteps tm + 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) -parseBoard :: [Integer] -> M.Map (V2 Int) Integer -parseBoard xs = foldr pttrans M.empty $ chunksOf 3 xs +getInputBot :: [Integer] -> Integer +getInputBot n = negate $ signum paddleBallDiff where - pttrans (x:y:n:xs) board = + 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 :: (TuringMachine, GameState) -> Int -countBlocks = - length . M.filter (== 2) . parseBoard . reverse . output . fst +countBlocks :: ScreenBuffer -> String +countBlocks = show . length . M.filter (== 2) -drawBoard :: (TuringMachine, GameState) -> String -drawBoard = - drawMap (M.fromList [(1, '∥'), (2, '⌂'), (3, '—'), (4, '•')]) . - parseBoard . reverse . output . fst +drawBoard :: ScreenBuffer -> String +drawBoard = drawMap (M.fromList [(1, '∥'), (2, '⌂'), (3, '—'), (4, '•')])