diff --git a/2019/day13/Helpers.hs b/2019/day13/Helpers.hs
new file mode 100644
index 0000000..58b93c8
--- /dev/null
+++ b/2019/day13/Helpers.hs
@@ -0,0 +1,40 @@
+module Helpers
+  ( v2x
+  , v2y
+  , drawMap
+  ) where
+
+import Data.List
+import Data.List.Split
+import qualified Data.Map as M
+import Linear.V2
+
+v2x :: V2 a -> a
+v2x (V2 x _) = x
+
+v2y :: V2 a -> a
+v2y (V2 _ y) = y
+
+getBounds :: M.Map (V2 Int) Integer -> (Int, Int, Int, Int)
+getBounds m = (getMinX, getMinY, getMaxX, getMaxY)
+  where
+    getMaxX = getFromMap maximum v2x
+    getMaxY = getFromMap maximum v2y
+    getMinX = getFromMap minimum v2x
+    getMinY = getFromMap minimum v2y
+    f f1 f2 k a result = f1 [f2 k, result]
+    getFromMap f1 f2 = M.foldrWithKey (f f1 f2) 0 m
+
+drawMap :: M.Map Integer Char -> M.Map (V2 Int) Integer -> String
+drawMap dict m =
+  intercalate "\n" $
+  transpose $
+  chunksOf
+    (abs (abs y1 - abs y2) + 1)
+    [ let c = M.findWithDefault (-99) (V2 x y) m
+       in M.findWithDefault ' ' c dict
+    | x <- [x1 .. x2]
+    , y <- [y1 .. y2]
+    ]
+  where
+    (x1, y1, x2, y2) = getBounds m
diff --git a/2019/day13/Intcode.hs b/2019/day13/Intcode.hs
new file mode 100644
index 0000000..a612aac
--- /dev/null
+++ b/2019/day13/Intcode.hs
@@ -0,0 +1,151 @@
+module Intcode
+  ( TuringMachine(TM, tape, pointer, pointerOffset, output, input,
+              state)
+  , step
+  , tapePreprocess
+  , TMOutState(Continue, AwaitInput, Halt)
+  , execSteps
+  ) where
+
+import Control.DeepSeq as DeepSeq
+import Data.Char
+import Data.List as L
+import Data.Maybe
+import Data.Vector as V hiding
+  ( (++)
+  , concatMap
+  , elem
+  , head
+  , last
+  , length
+  , map
+  , reverse
+  , splitAt
+  )
+import qualified Data.Vector as V ((++), last)
+
+data TMOutState
+  = Continue
+  | AwaitInput
+  | Halt
+  deriving (Enum, Eq, Show)
+
+data Mode
+  = Position
+  | Immediate
+  | Relative
+  deriving (Enum, Eq, Show)
+
+data TuringMachine =
+  TM
+    { tape :: Vector Integer
+    , pointer :: Integer
+    , pointerOffset :: Integer
+    , output :: [Integer]
+    , input :: Maybe Integer
+    , state :: TMOutState
+    }
+  deriving (Show)
+
+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
+  | n `elem` "1278" = 4
+  | n `elem` "56" = 3
+  | n `elem` "349" = 2
+  | otherwise = 1
+  where
+    n = last $ show x
+
+parseModes :: String -> [Mode]
+parseModes m = L.replicate (3 - length l) Position ++ l
+  where
+    l = map (toEnum . digitToInt) m
+
+paramChange ::
+     [Mode] -> Integer -> Vector Integer -> Vector Integer -> Vector Integer
+paramChange m rbase opvec t = imap f (V.tail opvec)
+  where
+    f i a =
+      case m !! i of
+        Immediate -> a
+        Position -> t ! fromInteger a
+        Relative -> t ! fromInteger (a + rbase)
+
+getOpModes :: Vector Integer -> (String, [Mode])
+getOpModes opvec = (op_dedup, parsed_modes)
+  where
+    (op, modes) = splitAt 2 $ reverse $ show $ opvec ! 0
+    parsed_modes = reverse $ parseModes $ reverse modes
+    op_dedup =
+      if last op == '0'
+        then [head op]
+        else op
+
+step :: TuringMachine -> TuringMachine
+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}
+    "4" -> tmn {output = V.last params : output tm}
+    "5" ->
+      tm
+        { pointer =
+            if params ! 0 /= 0
+              then params ! 1
+              else pNew
+        }
+    "6" ->
+      tm
+        { pointer =
+            if params ! 0 == 0
+              then params ! 1
+              else pNew
+        }
+    "7" ->
+      tmBinop
+        (\x y ->
+           if x < y
+             then 1
+             else 0)
+    "8" ->
+      tmBinop
+        (\x y ->
+           if x == y
+             then 1
+             else 0)
+    "9" -> tmn {pointerOffset = pointerOffset tm + (params ! 0)}
+    "99" -> tm {state = Halt}
+    _ -> error "Illegal Opcode."
+  where
+    pNew = pointer tm + opLength (tape tm ! fromInteger (pointer tm))
+    tmn = tm {pointer = pNew}
+    opvec =
+      slice
+        (fromInteger (pointer tm))
+        (fromInteger (pNew - pointer tm))
+        (tape tm)
+    (op, m) = getOpModes opvec
+    params = paramChange m (pointerOffset tm) opvec (tape tm)
+    tmBinop x = getNewTM ((params ! 0) `x` (params ! 1))
+    {-without the following DeepSeq call, thunks build up eternally and
+    the vectors won’t be garbage collected: >4GB RAM usage, god knows
+    how much with larger tapes (my laptop crashed), now it’s a cozy ~20mB-}
+    getNewTM x =
+      tmn {tape = DeepSeq.force (tape tm // [(target, x)]), state = Continue}
+    target =
+      fromInteger $
+      case m !! (length params - 1) of
+        Relative -> V.last opvec + pointerOffset tm
+        _ -> V.last opvec
+
+execSteps :: TuringMachine -> TuringMachine
+execSteps tm =
+  case state tmNew of
+    Continue -> execSteps tmNew
+    _ -> tmNew
+  where
+    tmNew = step tm
diff --git a/2019/day13/day13.hs b/2019/day13/day13.hs
new file mode 100644
index 0000000..af1302f
--- /dev/null
+++ b/2019/day13/day13.hs
@@ -0,0 +1,56 @@
+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
+
+data GameState =
+  GameState
+    { board :: M.Map (V2 Int) Integer
+    }
+  deriving (Show)
+
+main :: IO ()
+main = do
+  content <- readFile "input"
+  let program = V.fromList $ concatMap (map read . splitOn ",") (lines content)
+  let run x y =
+        runIntcode
+          ( TM
+              { tape = tapePreprocess program (0, y)
+              , 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)
+runIntcode (tm, gb) =
+  case state tmNew of
+    Continue -> runIntcode (tmNew, gb)
+    AwaitInput -> runIntcode (tmNew, gb)
+    _ -> (tmNew, gb)
+  where
+    tmNew = execSteps tm
+
+parseBoard :: [Integer] -> M.Map (V2 Int) Integer
+parseBoard xs = foldr pttrans M.empty $ chunksOf 3 xs
+  where
+    pttrans (x:y:n:xs) board =
+      M.insert (V2 (fromIntegral x) (fromIntegral y)) n board
+
+countBlocks :: (TuringMachine, GameState) -> Int
+countBlocks =
+  length . M.filter (== 2) . parseBoard . reverse . output . fst
+
+drawBoard :: (TuringMachine, GameState) -> String
+drawBoard =
+  drawMap (M.fromList [(1, '∥'), (2, '⌂'), (3, '—'), (4, '•')]) .
+  parseBoard . reverse . output . fst