{-# Language BlockArguments, LambdaCase, QuasiQuotes, ImportQualifiedPost #-}
{-|
Module      : Main
Description : Day 13 solution
Copyright   : (c) Eric Mertens, 2021
License     : ISC
Maintainer  : emertens@gmail.com

<https://adventofcode.com/2019/day/13>

Play a game of breakout! This solution uses a greedy strategy of
simply moving the paddle toward the ball and waiting for a win.

-}
module Main (main) where

import Advent (count, format)
import Advent.Coord (Coord(C), drawPicture)
import Data.List (foldl')
import Data.Map (Map)
import Data.Map qualified as Map
import Intcode (Effect(Input, Halt, Output), Machine, run, new, set)

-- | >>> :main
-- █████████████████████████████████████████████
-- █                                           █
-- █   ◇◇ ◇◇◇◇◇ ◇  ◇ ◇◇◇ ◇◇◇◇ ◇◇◇◇ ◇◇◇ ◇  ◇◇◇  █
-- █ ◇ ◇◇◇◇  ◇◇  ◇◇ ◇◇◇◇ ◇◇◇◇   ◇◇◇ ◇ ◇◇◇◇◇◇◇  █
-- █   ◇◇◇◇   ◇  ◇◇◇◇◇◇◇◇  ◇   ◇◇◇◇◇ ◇◇  ◇◇ ◇◇ █
-- █ ◇◇ ◇◇   ◇ ◇◇ ◇ ◇◇◇◇◇  ◇◇◇ ◇  ◇◇ ◇ ◇ ◇◇◇◇◇ █
-- █ ◇  ◇◇◇  ◇◇  ◇◇◇◇◇◇ ◇◇◇◇◇ ◇◇ ◇  ◇◇◇◇◇◇◇  ◇ █
-- █ ◇ ◇◇◇◇◇◇  ◇ ◇◇◇◇ ◇◇◇◇◇◇◇ ◇◇◇ ◇◇◇ ◇ ◇◇◇ ◇◇ █
-- █ ◇◇◇◇◇◇ ◇◇◇◇  ◇ ◇ ◇  ◇◇ ◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇ █
-- █ ◇ ◇◇◇◇◇◇ ◇◇ ◇◇◇◇◇◇◇   ◇◇  ◇◇◇◇ ◇ ◇◇◇◇◇◇◇◇ █
-- █ ◇◇◇◇◇◇◇◇◇◇◇ ◇◇◇◇◇◇◇ ◇ ◇ ◇ ◇◇◇◇  ◇◇◇◇ ◇◇◇◇ █
-- █ ◇◇ ◇◇  ◇◇◇◇◇◇◇◇◇ ◇◇ ◇ ◇◇ ◇◇◇◇◇◇  ◇◇◇◇◇ ◇  █
-- █  ◇◇ ◇ ◇◇◇◇◇   ◇◇◇  ◇◇◇◇◇◇ ◇◇◇ ◇◇  ◇◇◇◇ ◇  █
-- █  ◇◇◇ ◇◇ ◇◇◇ ◇◇◇◇  ◇◇◇◇◇◇◇◇◇ ◇◇ ◇◇ ◇◇◇ ◇◇◇ █
-- █ ◇◇◇ ◇◇◇◇◇◇◇ ◇ ◇ ◇◇◇◇◇◇◇    ◇◇◇◇  ◇◇◇◇◇◇◇◇ █
-- █ ◇◇    ◇◇◇◇◇ ◇◇◇   ◇◇ ◇◇   ◇◇◇ ◇◇◇◇◇◇◇◇◇◇◇ █
-- █  ◇◇◇  ◇◇ ◇ ◇◇◇  ◇◇ ◇   ◇  ◇ ◇◇◇  ◇◇ ◇◇◇◇◇ █
-- █  ◇◇◇  ◇◇   ◇ ◇◇ ◇ ◇◇◇◇◇◇◇◇◇◇ ◇◇ ◇◇◇ ◇◇◇◇◇ █
-- █                                           █
-- █                   ✪                       █
-- █                                           █
-- █                                           █
-- █                     ―                     █
-- █                                           █
-- 462
-- 23981
main :: IO ()
IO ()
main =
 do Machine
mach <- [Int] -> Machine
new ([Int] -> Machine) -> IO [Int] -> IO Machine
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [format|2019 13 %d&,%n|]
    let picture1 :: Map Coord Int
picture1 = Effect -> Map Coord Int
part1 (Machine -> Effect
run Machine
mach)
    String -> IO ()
putStr (Map Coord Char -> String
drawPicture ((Int -> Char) -> Map Coord Int -> Map Coord Char
forall a b. (a -> b) -> Map Coord a -> Map Coord b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Char
paint Map Coord Int
picture1))
    Int -> IO ()
forall a. Show a => a -> IO ()
print (Int -> Map Coord Int -> Int
forall (f :: * -> *) a. (Foldable f, Eq a) => a -> f a -> Int
count Int
2 Map Coord Int
picture1)
    Int -> IO ()
forall a. Show a => a -> IO ()
print (Maybe Int -> Maybe Int -> Int -> Effect -> Int
part2 Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Int
0 (Machine -> Effect
run (Int -> Int -> Machine -> Machine
set Int
0 Int
2 Machine
mach)))

-- | Count the number of screen locations assigned to @2@.
part1 :: Effect -> Map Coord Int
part1 :: Effect -> Map Coord Int
part1 = Map Coord Int -> Effect -> Map Coord Int
go Map Coord Int
forall k a. Map k a
Map.empty
  where
    go :: Map Coord Int -> Effect -> Map Coord Int
go Map Coord Int
blocks = \case
      Effect
Halt -> Map Coord Int
blocks
      Output Int
x (Output Int
y (Output Int
t Effect
e)) ->
        Map Coord Int -> Effect -> Map Coord Int
go (Coord -> Int -> Map Coord Int -> Map Coord Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Int -> Int -> Coord
C Int
y Int
x) Int
t Map Coord Int
blocks) Effect
e
      Effect
_ -> String -> Map Coord Int
forall a. HasCallStack => String -> a
error String
"part1: bad program"

-- | Play the breakout game to completion and report the final score.
part2 ::
  Maybe Int {- ^ location of ball -} ->
  Maybe Int {- ^ location of paddle -} ->
  Int       {- ^ current score -} ->
  Effect    {- ^ program effect -} ->
  Int       {- ^ final score -}
part2 :: Maybe Int -> Maybe Int -> Int -> Effect -> Int
part2 Maybe Int
ball Maybe Int
paddle Int
score = \case
  Effect
Halt -> Int
score

  Output (-1) (Output Int
0 (Output Int
score' Effect
effect')) ->
    Maybe Int -> Maybe Int -> Int -> Effect -> Int
part2 Maybe Int
ball Maybe Int
paddle Int
score' Effect
effect'

  Output Int
x (Output Int
_ (Output Int
t Effect
effect'))
    | Int
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 -> Maybe Int -> Maybe Int -> Int -> Effect -> Int
part2 Maybe Int
ball (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x) Int
score Effect
effect'
    | Int
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 -> Maybe Int -> Maybe Int -> Int -> Effect -> Int
part2 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x) Maybe Int
paddle Int
score Effect
effect'
    | Bool
otherwise -> Maybe Int -> Maybe Int -> Int -> Effect -> Int
part2 Maybe Int
ball Maybe Int
paddle Int
score Effect
effect'

  Input Int -> Effect
f ->
    Maybe Int -> Maybe Int -> Int -> Effect -> Int
part2 Maybe Int
ball Maybe Int
paddle Int
score
      case (Maybe Int
ball, Maybe Int
paddle) of
        (Just Int
b, Just Int
p) -> Int -> Effect
f (Int -> Int
forall a. Num a => a -> a
signum (Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
p))
        (Maybe Int, Maybe Int)
_ -> Int -> Effect
f Int
0

  Effect
_ -> String -> Int
forall a. HasCallStack => String -> a
error String
"part2: bad program"

-- | Render tiles as characters for viewing.
paint :: Int -> Char
paint :: Int -> Char
paint Int
0 = Char
' '
paint Int
1 = Char
'█'
paint Int
2 = Char
'◇'
paint Int
3 = Char
'―'
paint Int
4 = Char
'✪'
paint Int
_ = String -> Char
forall a. HasCallStack => String -> a
error String
"paint: invalid argument"