advent13/src/advent13.hs

   1 import Debug.Trace
   2
   3 import Intcode
   4
   5 import qualified Data.Text.IO as TIO
   6
   7 import qualified Data.Map.Strict as M
   8 -- import Data.Map.Strict ((!))
   9 import Data.List
  10 import Data.List.Split
  11 -- import Data.List
  12 -- import Data.Function (on)
  13
  14 type Position = (Integer, Integer) -- x, y
  15 data Cell  = Empty | Wall | Block | Paddle | Ball deriving (Show, Eq, Ord)
  16 -- data Direction = North | East | South | West deriving (Show, Eq, Ord, Enum, Bounded)
  17
  18 type Field = M.Map Position Cell
  19
  20 data Game = Game
  21     { _machine :: Machine
  22     , _executionState :: ExecutionState
  23     , _currentInput :: [Integer]
  24     , _machineOutput :: [Integer]
  25     , _currentScore :: Integer
  26     , _paddleX :: Integer
  27     , _ballX :: Integer
  28     } deriving (Eq)
  29
  30 instance Show Game where
  31   show g = "Game {<m>, _executionState = " ++ show (_executionState g) ++
  32            ", _currentInput = " ++ show (_currentInput g) ++
  33            ", _machineOutput = " ++ show (_machineOutput g) ++
  34            ", _currentScore = " ++ show (_currentScore g) ++
  35            ", _paddleX = " ++ show (_paddleX g) ++
  36            ", _ballX = " ++ show (_ballX g) ++
  37            " }"
  38
  39
  40 main :: IO ()
  41 main = do
  42         text <- TIO.readFile "data/advent13.txt"
  43         let mem = parseMachineMemory text
  44         -- print mem
  45         print $ part1 mem
  46         print $ part2 mem
  47
  48
  49 part1 mem = M.size $ M.filter (== Block) screen
  50     where (_halted, _machine, output) = runProgram [] mem
  51           (screen, _score) = buildScreen output
  52
  53 part2 mem = _currentScore game
  54     where mem' = [2] ++ (tail mem)
  55           game0 = buildGame mem'
  56           game = runGame game0
  57
  58
  59 buildScreen :: [Integer] -> (Field, Integer)
  60 buildScreen output = foldl' addCell (M.empty, 0) $ chunksOf 3 output
  61
  62 addCell :: (Field, Integer) -> [Integer] -> (Field, Integer)
  63 addCell (screen, _s) [- 1 , 0, s] = (screen, s)
  64 addCell (screen, score) [x, y, c] = (M.insert (x, y) (cellOf c) screen, score)
  65
  66 cellOf :: Integer -> Cell
  67 cellOf 0 = Empty
  68 cellOf 1 = Wall
  69 cellOf 2 = Block
  70 cellOf 3 = Paddle
  71 cellOf 4 = Ball
  72
  73
  74 buildGame mem = Game
  75     { _machine = makeMachine mem
  76     , _executionState = Runnable
  77     , _currentInput = []
  78     , _machineOutput = []
  79     , _currentScore = 0
  80     , _paddleX = 0
  81     , _ballX = 0
  82     }
  83
  84 runGame :: Game -> Game
  85 -- runGame game | trace (show (_currentScore game) ++ " " ++ show (_executionState game)) False = undefined
  86 runGame game0 = game
  87     where game1 = runGameStep game0
  88           game = if (_executionState game1 == Terminated)
  89                  then game1
  90                  else runGame game1
  91
  92 runGameStep :: Game -> Game
  93 -- runGameStep game | trace (show (_currentScore game) ++ " " ++ show (_executionState game)) False = undefined
  94 runGameStep game0 = game
  95     where game1 = runGameMachine game0
  96           output = _machineOutput game1
  97           (screen, score) = buildScreen output
  98           cs = _currentScore game0
  99           score' = if score > cs then score else cs
 100           game2 = game1 { _currentScore = score' }
 101           game = joystick game2 screen
 102
 103
 104 runGameMachine :: Game -> Game
 105 runGameMachine g = g { _machine = machine'
 106                      , _executionState = halted
 107                      , _machineOutput = output
 108                      }
 109     where   machine = _machine g
 110             input = _currentInput g
 111             (halted, machine', output) = runMachine input machine
 112
 113 joystick :: Game -> Field -> Game
 114 joystick game screen = game {_currentInput = ci ++ [direction],
 115                               _paddleX = px, _ballX = bx,
 116                               _executionState = termination}
 117   where knownBall = M.filter (== Ball) screen
 118         bx = if M.null knownBall
 119              then _ballX game
 120              else fst $ fst $ M.findMin knownBall
 121         knownPaddle = M.filter (== Paddle) screen
 122         px = if M.null knownPaddle
 123              then _paddleX game
 124              else fst $ fst $ M.findMin knownPaddle
 125         termination = if _executionState game == Blocked
 126                       then Runnable
 127                       else _executionState game
 128         ci = _currentInput game
 129         direction = if bx > px
 130                     then 1
 131                     else if bx < px
 132                          then -1
 133                          else 0
 134
 135
 136 ghcisetup text = game0
 137     where mem = parseMachineMemory text
 138           mem' = [2] ++ (tail mem)
 139           game0 = buildGame mem'
 140
 141
 142 showScreen :: Field -> String
 143 showScreen screen = unlines rows
 144     where   minX = minimum $ map fst $ M.keys screen
 145             minY = minimum $ map snd $ M.keys screen
 146             maxX = maximum $ map fst $ M.keys screen
 147             maxY = maximum $ map snd $ M.keys screen
 148             rows = [showScreenRow screen minX maxX y | y <- [minY..maxY]]
 149
 150 showScreenRow :: Field -> Integer -> Integer -> Integer -> String
 151 showScreenRow screen minX maxX y = [showScreenCell screen x y | x <- [minX..maxX]]
 152
 153 showScreenCell :: Field -> Integer -> Integer -> Char
 154 showScreenCell screen x y =
 155     case (M.findWithDefault Empty (x, y) screen) of
 156         Empty -> ' '
 157         Wall -> '#'
 158         Block -> '*'
 159         Paddle -> '='
 160         Ball -> '+'