(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 solver-finite-grid (bounds)
  (let* ((y-len (+ 3 (car bounds)))
         (x-len (* 2 y-len)))
    (setf (car bounds) (+ 500 y-len))
    (setf (elt bounds 1) (- 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 solver--wall-line (grid walls)
  (loop for line in walls
        do (loop for ((startx starty) (fx fy)) on line until (null fx)
                 :if (= startx fx)
                   :do (loop for y from (min starty fy) to (max starty fy)
                             :do (setf (aref (grid-grid grid) (solver-point startx y grid)) 1))
                 :else
                   :do (loop for x from (min startx fx) to (max startx fx)
                             :do (setf (aref (grid-grid grid) (solver-point x starty grid)) 1)))))

(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))
    (loop while
          (ignore-errors ;; went out of grid
           (cond
             ((= 0 (aref (grid-grid grid) (solver-point x (1+ y) grid)))
              (incf y)) ;; check next
             ((= 0 (aref (grid-grid grid) (solver-point (1- x) (1+ y) grid)))
              (incf y)
              (decf x)) ;; check left
             ((= 0 (aref (grid-grid grid) (solver-point (1+ x) (1+ y) grid)))
              (incf y)
              (incf x)) ;; check right
             (t (setf (aref (grid-grid grid) (solver-point x y grid)) 2)
                (incf drops)
                (unless (= y 0)
                  (setf x 500 y 0))))))
    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)
  (let* ((walls (parse-location list-str))
         (grid (make-abyss-grid (bounds walls))))
    (solver--wall-line grid walls)
    (list (simulate grid)
          (draw-grid grid))))

(solver (uiop:split-string "498,4 -> 498,6 -> 496,6
503,4 -> 502,4 -> 502,9 -> 494,9" :separator '(#\Newline)))

(solver (uiop:read-file-lines #P"./input"))