AoC/2019/day15/day15.hs

{-# 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, '•')])