Day 13: Enterprise it up

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

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
+defaultTM :: Maybe (Int, Integer) -> Vector Integer -> TuringMachine
-tapePreprocess t (target,repl) = flip (//) [(target, repl)] $ (V.++) t $ V.replicate 500 0
+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

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 =
+type ScreenBuffer = M.Map (V2 Int) Integer
-  GameState
-    { board :: M.Map (V2 Int) Integer
-    }
-  deriving (Show)
 
 main :: IO ()
 main = do
-  content <- readFile "input"
+  program <- readIntcode <$> readFile "input"
-  let program = V.fromList $ concatMap (map read . splitOn ",") (lines content)
+  mode <- queryMode
-  let run x y =
+  let tm = defaultTM (Just (0, 2)) program
-        runIntcode
+  let run x = runGameloop $ pure (tm {input = Just x}, M.empty, mode)
-          ( TM
+  (_, buf, _) <- run 0
-              { tape = tapePreprocess program (0, y)
+  putStrLn $ "Final Highscore: " ++ getHighscore buf
-              , pointer = 0
-              , pointerOffset = 0
-              , output = []
-              , input = Just x
-              , state = Continue
-              }
-          , GameState {board = M.empty})
-  print $ countBlocks $ run 0 1
-  putStrLn $ drawBoard $ run 0 1
 
-runIntcode :: (TuringMachine, GameState) -> (TuringMachine, GameState)
+queryMode :: IO Bool
-runIntcode (tm, gb) =
+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)
+    Continue -> runGameloop $ pure (tmNew, bufNew, mode)
-    AwaitInput -> runIntcode (tmNew, gb)
+    AwaitInput -> do
-    _ -> (tmNew, gb)
+      nextCommand <-
-  where
+        if mode
-    tmNew = execSteps tm
+          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
+getInputBot :: [Integer] -> Integer
-parseBoard xs = foldr pttrans M.empty $ chunksOf 3 xs
+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 :: ScreenBuffer -> String
-countBlocks =
+countBlocks = show . length . M.filter (== 2)
-  length . M.filter (== 2) . parseBoard . reverse . output . fst
 
-drawBoard :: (TuringMachine, GameState) -> String
+drawBoard :: ScreenBuffer -> String
-drawBoard =
+drawBoard = drawMap (M.fromList [(1, '∥'), (2, '⌂'), (3, '—'), (4, '•')])
-  drawMap (M.fromList [(1, '∥'), (2, '⌂'), (3, '—'), (4, '•')]) .
-  parseBoard . reverse . output . fst