;; https://adventofcode.com/2022/day/14
(ql:quickload 'cl-ppcre)
(ql:quickload 'alexandria)

;; (defparameter *day14-input-file*  "day14-test.txt")
(defparameter *day14-input-file*  "day14-input.txt")

(defclass arena ()
  ((grid :initarg :grid :initform (error "supply value for :grid"))
   (leftmost :initarg :left :accessor leftmost)
   (bottommost :initarg :bottom :accessor bottommost)
   (rightmost :initarg :right :accessor rightmost)))

(defun make-arena (left right bottom)
  (let ((cols-num (1+ (- right left)))
        (rows-num (1+ bottom)))
    (make-instance 'arena :left left :right right :bottom bottom
                          :grid (make-array (list rows-num cols-num)
                                            :initial-element #\.))))

(defparameter *test-arena*  nil)


;; (x y) -> (row col) in grid
(defun translate-coords (arena x y)
  (list y (- x (leftmost arena))))

(defun get-place (arena x y)
  (destructuring-bind (row col) (translate-coords arena x y)
    (when (and (<= 0 row) (<= 0 col)
               (< row (array-dimension (slot-value arena 'grid) 0))
               (< col (array-dimension (slot-value arena 'grid) 1))
               )
      (aref (slot-value arena 'grid) row col))))

(defun set-place (arena x y value)
  (destructuring-bind (row col) (translate-coords arena x y)
    (when (and (<= 0 row) (<= 0 col)
               (< row (array-dimension (slot-value arena 'grid) 0))
               (< col (array-dimension (slot-value arena 'grid) 1))
               )
      (setf  (aref (slot-value arena 'grid) row col) value))))

(defun input-line-to-rock-coords (line)
  (mapcar (lambda (coords) (mapcar #'parse-integer (cl-ppcre:split "," coords)))
          (cl-ppcre:split " -> " line)))

(defparameter *test-input-flat-coords* nil)


(defun put-rock-line (arena start-x end-x start-y end-y)
  (let ((start-x (min start-x end-x))
        (end-x (max start-x end-x))
        (start-y (min start-y end-y))
        (end-y (max start-y end-y)))
    (loop for x from start-x to end-x do
      (progn
        (loop for y from start-y to end-y
              do (set-place arena x y #\#))))))

(defun put-rock-lines (arena rock-coords-lines)
  (loop
    for rock-coord-line in rock-coords-lines
    do (put-rock-chain arena rock-coord-line)))


(defparameter *test-input-coords-chains* nil)

(defun put-rock-chain (arena rock-coods-chain)
  (do* ((coords-list rock-coods-chain (cdr coords-list))
      (first-coords (first rock-coods-chain) (first coords-list))
      (second-coords (second rock-coods-chain) (second coords-list)))
     ((not second-coords) "end")
  (destructuring-bind ((start-x start-y) (end-x end-y))
      (list first-coords second-coords)
    (put-rock-line arena start-x end-x start-y end-y) )))

;; reinit things
;; (init-arena)
(defun init-arena ()

  (setq *test-input-flat-coords*
        (alexandria:flatten (mapcar #'input-line-to-rock-coords
                                    (uiop:read-file-lines *day14-input-file*))))
  ;; building empty arena
  (setq *test-arena*
        (let ((flat-coords
                (alexandria:flatten (mapcar #'input-line-to-rock-coords (uiop:read-file-lines *day14-input-file*)))))
          (destructuring-bind (leftmost rightmost bottommost)
              (loop
                for (x y) on flat-coords
                  by #'cddr
                minimize x into leftmost
                maximize x into rightmost
                maximize y into bottommost
                finally (return (list leftmost rightmost bottommost)))
            (make-arena leftmost rightmost bottommost))))

  (setq *test-input-coords-chains*
        (mapcar #'input-line-to-rock-coords
                (uiop:read-file-lines *day14-input-file*)))

   ; this is second step of initialization
  (put-rock-lines *test-arena* *test-input-coords-chains*))

(defun is-point-air (x y arena)
  (or  (eq #\. (get-place arena x y))
       (not (get-place arena x y))))
(defun sand-check-next-move (sand-x sand-y arena)
  (let* ((next-y (1+ sand-y))
         (possible-next-steps (list (list sand-x next-y)
                                    (list (1- sand-x)  next-y)
                                    (list (1+ sand-x)  next-y))))
    (first (remove-if-not (lambda (coords)
                            (is-point-air (first coords) (second coords) arena))
                          possible-next-steps))))
(defun out-of-bounds (x y arena)
  (not (get-place arena x y)))


(defun drop-sand-unit (arena)
  (do*
   ((prev-coords nil sand-coords)
    (sand-coords '(500 0) (sand-check-next-move
                           (first sand-coords) (second sand-coords) arena)))
   ((or (not sand-coords)               ; sand rests
        (out-of-bounds (first sand-coords) (second sand-coords) arena)) ; end condition - rest or out of bounds
    (when (or (not sand-coords)
              (equal prev-coords '(500 0))) ; if sand rests at entry point
      (set-place arena (first prev-coords) (second prev-coords) #\x)))
    ;; (format t "sc: ~a, prev: ~a~%" sand-coords prev-coords)
    ))

(defun drop-sand-unit-abyss (arena)
  (do ((sand-units 0 (1+ sand-units))
       (drop-result (drop-sand-unit arena) (drop-sand-unit arena)))
      ((not drop-result)
       sand-units)))

;; ok, could return arena
(init-arena)
(drop-sand-unit-abyss *test-arena*)     ; 901

;;; PART 2

(defun init-arena-2 ()

  (setq *test-input-flat-coords*
        (alexandria:flatten (mapcar #'input-line-to-rock-coords
                                    (uiop:read-file-lines *day14-input-file*))))
  ;; building empty arena
  (setq *test-arena*
        (let ((flat-coords
                (alexandria:flatten (mapcar #'input-line-to-rock-coords (uiop:read-file-lines *day14-input-file*)))))
          (destructuring-bind (leftmost rightmost bottommost)
              (loop
                for (x y) on flat-coords
                  by #'cddr
                minimize x into leftmost
                maximize x into rightmost
                maximize y into bottommost
                finally (return (list leftmost rightmost bottommost)))
            (let ((new-bottommost (+ 2 bottommost))
                  (new-leftmost (min leftmost
                                     (- 500 (* 2 bottommost))))
                  (new-rightmost (max rightmost
                                      (+ 500 (* 2 bottommost)))))
              (make-arena new-leftmost new-rightmost new-bottommost)))))
  ;; and put floor
  (let ((floor-y (bottommost *test-arena*))
        (floor-x-start (leftmost *test-arena*))
        (floor-x-end (rightmost *test-arena*)))
    (put-rock-line *test-arena* floor-x-start floor-x-end floor-y floor-y))

  (setq *test-input-coords-chains*
        (mapcar #'input-line-to-rock-coords
                (uiop:read-file-lines *day14-input-file*)))

   ; this is second step of initialization
  (put-rock-lines *test-arena* *test-input-coords-chains*))

;; rewriting previous. otherwise endless loop
(defun drop-sand-unit (arena)
  (do*
   ((prev-coords '(500 0) sand-coords)
    (sand-coords (sand-check-next-move 500 0 arena)
                 (sand-check-next-move
                  (first sand-coords) (second sand-coords) arena)))
   ((or (not sand-coords)               ; sand rests
        (out-of-bounds (first sand-coords) (second sand-coords) arena)) ; end condition - rest or out of bounds
    (when (and (not sand-coords)
               (not (equal prev-coords '(500 0)))) ; if sand rests
      (set-place arena (first prev-coords) (second prev-coords) #\x)))
    ;; (format t "sc: ~a, prev: ~a~%" sand-coords prev-coords)
    ))

(init-arena-2)
(print (1+ (drop-sand-unit-abyss *test-arena*)))