;;8:57
;;10:26 part1
;;10:53 part2
(ql:quickload '(fiveam arrows alexandria))

(defstruct ray
  dir row col)

(defun in-bounds (field ray)
  (destructuring-bind (maxrow maxcol) (array-dimensions field)
    (with-slots (row col) ray
      (and (< -1 row maxrow)
           (< -1 col maxcol)))))

(defun next-direction (ray)
  (with-slots (dir row col) ray
    (ecase dir
      (up (decf row))
      (lf (decf col))
      (dw (incf row))
      (rt (incf col))))
  ray)

(defun mirror-bs (ray)
  (with-slots (dir row col) ray
    (arrows:->>
     (ecase dir
       (up 'lf)
       (lf 'up)
       (dw 'rt)
       (rt 'dw))
     (setf dir)))
  ray)

(defun mirror-fs (ray)
  (with-slots (dir row col) ray
    (arrows:->>
     (ecase dir
       (up 'rt)
       (rt 'up)
       (lf 'dw)
       (dw 'lf))
     (setf dir)))
  ray)

(defun split (ray alignment)
  (with-slots (dir row col) ray
    (mapcar (lambda (d) (make-ray :dir d :row row :col col))
            (cond
              ((and (eq alignment 'vertical)   (member dir '(lf rt))) '(up dw))
              ((and (eq alignment 'horizontal) (member dir '(up dw))) '(lf rt))
              ((list dir))))))

(defun energized-p (energized ray)
  (with-slots (dir row col) ray
    (find dir (gethash (cons row col) energized))))

(defun ensure-list (l) (if (listp l) l (list l)))

(defun action (field ray energized)
  (with-slots (dir row col) ray
    (arrows:->>
     (ecase (aref field row col)
       (#\. ray)
       (#\\ (mirror-bs ray))
       (#\/ (mirror-fs ray))
       (#\| (split ray 'vertical))
       (#\- (split ray 'horizontal)))
     (ensure-list)
     (mapcar #'next-direction)
     (remove-if-not (alexandria:curry #'in-bounds field))
     (remove-if (alexandria:curry #'energized-p energized)))))

(defun advancer (field rays energized)
  (dolist (r rays)
    (with-slots (dir row col) r
      (push dir (gethash (cons row col) energized))))
  (if  (null rays)
       energized
       (let ((next-moves (mapcan (lambda (ray) (action field ray energized)) rays)))
         ;; (format t "~d Next: ~a~%" maxi next-moves)
         (advancer field next-moves energized))))

(defun boundary-rays (field)
  (destructuring-bind (maxrow maxcol) (array-dimensions field)
    (mapcar (lambda (point)
              (destructuring-bind (dir row col) point
                (make-ray :dir dir :row row :col col)))
            (append
             (loop for i below maxrow collect (list 'rt i 0))
             (loop for i below maxrow collect (list 'lf i (1- maxcol)))
             (loop for i below maxcol collect (list 'dw 0 i))
             (loop for i below maxcol collect (list 'up (1- maxrow) i))))))

(defun solver (field)
  (lambda (start)
    (hash-table-count
     (advancer field (list start)
               (make-hash-table :test #'equal)))))

(defun solution (input &optional (starter (constantly (list (make-ray :dir 'rt :row 0 :col 0)))))
  (let* ((rows (length input))
         (field
           (make-array (list rows (length (car input))) :initial-contents input)))
    (reduce #'max (funcall starter field) :key (solver field))))

(fiveam:test solutions
  (fiveam:is (= 46 (solution (uiop:read-file-lines "eg-in"))))
  (fiveam:is (= 7996 (solution (uiop:read-file-lines "input"))))
  (fiveam:is (= 51 (solution (uiop:read-file-lines "eg-in") #'boundary-rays)))
  (fiveam:is (= 8239 (solution (uiop:read-file-lines "input") #'boundary-rays))))