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

(defun in-bounds (field ray)
  (destructuring-bind (maxrow maxcol) (array-dimensions field)
    (destructuring-bind (dir row col) ray
      (declare (ignorable dir))
      (and (< -1 row maxrow)
           (< -1 col maxcol)))))

(defun next-direction (ray)
  (destructuring-bind (dir row col) ray
    (cons dir
          (ecase dir
            (up (list (1- row) col))
            (lf (list row (1- col)))
            (dw (list (1+ row) col))
            (rt (list row (1+ col)))))))

(defun mirror-bs (ray)
  (destructuring-bind (dir row col) ray
    (arrows:->
        (ecase dir
          (up 'lf)
          (lf 'up)
          (dw 'rt)
          (rt 'dw))
        (list row col)
        (list))))

(defun mirror-fs (ray)
  (destructuring-bind (dir row col) ray
    (arrows:->
        (ecase dir
          (up 'rt)
          (lf 'dw)
          (dw 'lf)
          (rt 'up))
        (list row col)
        (list))))

(defun split-v (ray)
  (destructuring-bind (dir row col) ray
    (ecase dir
      ((up dw) (list ray))
      ((lf rt) (list (list 'up row col) (list 'dw row col)) ))))

(defun split-h (ray)
  (destructuring-bind (dir row col) ray
    (ecase dir
      ((lf rt) (list ray))
      ((up dw) (list (list 'lf row col) (list 'rt row col)) ))))

(defun energized-p (energized ray)
  (destructuring-bind (dir row col) ray
    (find dir (gethash (cons row col) energized))))

(defun action (field ray energized)
  (destructuring-bind (dir row col) ray
    (unless (find dir (gethash (cons row col) energized)))
    (arrows:->>
     (ecase (aref field row col)
       (#\. (list ray))
       (#\\ (mirror-bs ray))
       (#\/ (mirror-fs ray))
       (#\| (split-v ray))
       (#\- (split-h ray)))
     (mapcar #'next-direction)
     (remove-if-not (alexandria:curry #'in-bounds field))
     (remove-if (alexandria:curry #'energized-p energized)))))

(defun advancer (field rays energized)
  (loop for (dir row col) in rays do
    (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)
    (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 (list 'rt 0 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))))