{-# 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 ) import Debug.Trace import System.Random type ScreenBuffer = M.Map (V2 Int) Integer main :: IO () main = do program <- readIntcode <$> readFile "input" mode <- queryMode let tm = defaultTM Nothing program let run x = runGameloop $ pure (tm {state = AwaitInput}, M.empty, V2 0 20, 0, mode) (_, buf, _, _, _) <- run 0 putStrLn "Done." 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, V2 Int, Integer, Bool) -> IO (TuringMachine, ScreenBuffer, V2 Int, Integer, Bool) runGameloop io = do (tm, buf, oldPos, maxStep, mode) <- io case state tm of AwaitInput -> do nextCommand <- if mode then do clearScreen getInput else getInputBot let newPosTry = oldPos + case nextCommand of 1 -> V2 0 1 2 -> V2 0 (-1) 3 -> V2 1 0 4 -> V2 (-1) 0 let tmNew = execSteps tm{input = Just nextCommand} let tmNewOut = head $ output tmNew let newPos = case tmNewOut of 0 -> oldPos _ -> newPosTry let bufNew = if tmNewOut == 0 then M.insert newPosTry 0 buf else buf let bufNew2 = if newPos /= oldPos then updatePath bufNew oldPos newPos else bufNew if tmNewOut == 2 then print $ countSteps bufNew2 else return () print mode let newMode = if tmNewOut == 2 then True else mode let bufNew3 = if tmNewOut == 2 then M.filter (/=1) bufNew2 else bufNew2 let newMaxStep = max maxStep tmNewOut putStrLn $ drawBoard (M.insert newPos 3 bufNew3) print $ countSteps bufNew2 print newMaxStep runGameloop $ pure (tmNew {input = Just nextCommand, output = []}, bufNew3, newPos, newMaxStep, newMode) _ -> pure (tm, buf, oldPos, maxStep, mode) updatePath :: ScreenBuffer -> V2 Int -> V2 Int -> ScreenBuffer updatePath buf oldPos newPos = if M.member newPos buf then M.delete oldPos buf else M.insert newPos 1 buf countSteps :: ScreenBuffer -> Int countSteps = M.size . M.filter (==1) getInputBot :: IO Integer getInputBot = do randomRIO (1,4) getInput :: IO Integer getInput = do hSetBuffering stdin NoBuffering hSetEcho stdin False getKeyNow >>= \case "l" -> pure 1 "a" -> pure 2 "i" -> pure 3 "e" -> pure 4 _ -> 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 drawBoard :: ScreenBuffer -> String drawBoard = drawMap (M.fromList [(0, '█'), (2, '⌂'), (3, 'I'), (1, '•')])