(ql:quickload '(fiveam uiop str))

(defun bounds (walls)
  (loop for (ym x1 x0) on (loop for line in walls
                                nconc (loop for (x y) in line
                                            maximize y into ymax
                                            maximize x into xmax
                                            minimize x into xmin
                                            finally (return (list ymax xmax xmin)))) by #'cdddr

        maximize ym into ymax
        maximize x1 into xmax
        minimize x0 into xmin
        finally (return (list ymax xmax xmin))))

(defstruct grid
  bounds
  x-len
  y-len
  grid)

(defun grid (bounds x-len y-len)
  (make-grid :bounds bounds :x-len x-len :y-len y-len
             :grid (make-array (* x-len y-len) :initial-element 0 :element-type '(unsigned-byte 2))))

(defun make-abyss-grid (bounds)
  (let ((y-len (1+ (car bounds)))
        (x-len (1+ (- (cadr bounds) (caddr bounds)))))
    (grid bounds x-len y-len)))

(defun make-finite-grid (bounds)
  (let* ((y-len (+ 3 (car bounds)))
         (x-len (* 2 y-len)))
    (setf (elt bounds 1) (+ 500 y-len))
    (setf (elt bounds 2) (- 500 y-len))
    (grid bounds x-len y-len)))

(defun solver-point (x y grid)
  (let ((x (- x (caddr (grid-bounds grid)))))
    (when (and (< -1 x (grid-x-len grid))
               (< -1 y (grid-y-len grid)))
      (+ x (* y (grid-x-len grid))))))

(defun paired-range (fx tx fy ty grid)
  (destructuring-bind ((fx tx) (fy ty)) (list (sort (list fx tx) #'<) (sort (list fy ty) #'<))
    (loop for l from (solver-point fx fy grid) to (solver-point tx ty grid) by (if (= fx tx) (grid-x-len grid) 1)
          collect l)))


(defun place-wall (positions grid)
 (loop for l in positions :do (setf (aref (grid-grid grid) l) 1)))

(defun solver--wall-line (grid walls)
  (loop for line in walls
        do (loop for ((fx fy) (tx ty)) on line until (null tx)
                 :do (place-wall (paired-range fx tx fy ty grid) grid))))

(defun draw-grid (grid)
  (let ((out (make-string-output-stream)))
    (loop for elt across (grid-grid grid)
          for idx from 0
          do (progn (when (= 0 (mod idx (grid-x-len grid))) (terpri out))
                    (princ (case elt
                             (0 ".")
                             (1 "#")
                             (2 "o")) out)))
    (get-output-stream-string out)))

(defun simulate (grid)
  (let ((drops 0)
        (x 500) (y 0))
    (flet ((check (dir)
             (when (= 0 (aref (grid-grid grid)
                              (ecase dir
                                (forward (solver-point x (1+ y) grid))
                                (left (solver-point (1- x) (1+ y) grid))
                                (right (solver-point (1+ x) (1+ y) grid)))))
               (incf y))))
      (handler-case
          (loop while
                (cond
                  ((check 'forward))
                  ((check 'left) (decf x))
                  ((check 'right) (incf x))
                  (t (setf (aref (grid-grid grid) (solver-point x y grid)) 2)
                     (incf drops)
                     (unless (= y 0)
                       (setf x 500 y 0)))))
        (sb-int:invalid-array-index-error ()))

      drops)))

(defun parse-location (list-str)
  (mapcar (lambda (row)
            (mapcar (lambda (pair)
                      (mapcar #'parse-integer (str:split "," pair)))
                    (str:split " -> " row)))
          list-str))

(defun solver (list-str grid-constructor)
  (let* ((walls (parse-location list-str))
         (grid (funcall grid-constructor (bounds walls))))
    (solver--wall-line grid walls)
    (when (eq grid-constructor #'make-finite-grid)
      (let ((b (grid-bounds grid)))
        (place-wall 
         (paired-range (1- (elt b 1)) (elt b 2)
                       (1- (grid-y-len grid)) (1- (grid-y-len grid)) grid) grid)))
    (values (simulate grid)
            (draw-grid grid))))

(fiveam:test test
  (let ((eg-data (uiop:split-string "498,4 -> 498,6 -> 496,6
503,4 -> 502,4 -> 502,9 -> 494,9" :separator '(#\Newline))))
    (fiveam:is (= 24 (solver eg-data #'make-abyss-grid)))
    (fiveam:is (= 93 (solver eg-data #'make-finite-grid))))

  (let ((in-data (uiop:read-file-lines "./input")))
    (fiveam:is (= 665 (solver in-data #'make-abyss-grid)))
    (fiveam:is (= 25434 (solver in-data #'make-finite-grid)))))