Day 13: Enterprise it up
This commit is contained in:
parent
e6280785b3
commit
3e42c47585
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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, '•')])
|
||||
|
|
Loading…
Reference in New Issue
Block a user