(defpackage #:advent.2024.06
  (:use #:cl #:advent.2024.00))
(in-package #:advent.2024.06)

;;; Part 1.

(defparameter *blocks* ())
(defparameter *guard* nil)
(defparameter *direction* nil)
(defparameter *covered* nil)
(defparameter *width* nil)
(defparameter *height* nil)

(defun reset ()
  (setf *blocks* nil
        *guard* nil
        *direction* nil
        *width* nil
        *height* nil
        *covered* nil))

(defun init (&optional (file (input)))
  "Convert the contents of FILE into a 2d array of characters."
  (reset)
  (let* ((lines (uiop:read-file-lines file)))
    (loop for line in lines
          for i from 0
          do (loop for char across line
                   for j from 0 do
                     (case char         ; (aref res i j)
                       (#\#
                        (push (cons i j) *blocks*))
                       (#\^
                        (setf *guard* (cons i j)
                              *direction* 'up))
                       ((#\V #\v)
                        (setf *guard* (cons i j)
                              *direction* 'down))
                       (#\>
                        (setf *guard* (cons i j)
                              *direction* 'right))
                       (#\<
                        (setf *guard* (cons i j)
                              *direction* 'left)))
                   finally (setf *height* i
                                 *width* j
                                 *covered*
                                 (make-array (list i j) :initial-element 0))))
    t))

(defun move (direction)
  "Try to move in DIRECTION.
If there's a block there, return NIL.
Otherwise, update the guard's position and return the new position."
  (let* ((line (car *guard*))
         (col (cdr *guard*))
         (next-point
           (case direction
             (up (cons (1- line) col))
             (down (cons (1+ line) col))
             (left (cons line (1- col)))
             (right (cons line (1+ col))))))
    (when (> (aref *covered* line col) 25)
      (error 'loop!))
    (unless (find next-point *blocks* :test #'equal)
      (setf *guard* next-point)
      (incf (aref *covered* line col)))))

(defun step-guard ()
  (unless (move *direction*)
    (progn
      (setf *direction*
            (case *direction*
              (up 'right)
              (down 'left)
              (left 'up)
              (right 'down)))
      (step-guard))))

(define-condition loop! (error)
  ()
  (:report (lambda (condition stream)
             (declare (ignorable condition))
             (format stream "Loop detected!"))))

(defun count-covered ()
  (destructuring-bind (n m) (array-dimensions *covered*)
    (let ((count 1))
      (loop for i from 0 below n do
        (loop for j from 0 below m do
          (unless (zerop (aref *covered* i j))
            (incf count))))
      count)))

(defun solve1 (&optional (input (input)))
  (init input)
  (loop until (or (= (car *guard*) *height*)
                  (= (cdr *guard*) *width*)
                  (= (car *guard*) 0)
                  (= (cdr *guard*) 0))
        do (step-guard))
  (count-covered))

;;; Part 2.
;; Find all the places where you could put *one* new obstacle to get the guard
;; stuck in a loop.
;;
;; OK, so to get stuck in a loop the guard needs 4 obstacles that would make the
;; guard trace a rectangle, *without* any other obstacles in their paths ---
;; (x, y)
;; ->(x, {y-1 ,, 1})
;; ->({x+1 .. (width-1)}, ny)
;; ->(nx, {ny+1 .. (height-1)})
;;
;; so (1) check each stone to find if it is the corner of a square. record each square.
;; (2) take the corners and make sure there are no stones in the path of the
;; guard for each square

;;; ... or, you know, do the brutiest of forces.

(defun solve2 (&optional (input (input)))
  (init input)
  (let ((res 0))
    (loop for row from 0 upto *height* do
      (loop for col from 0 upto *width* do
        (unless (find (cons row col) *blocks* :test #'equal)
          (init input)
          (let ((*blocks* (cons (cons row col) *blocks*)))
            ;; (print (cons row col))
            (handler-case
                (loop until (or (= (car *guard*) *height*)
                                (= (cdr *guard*) *width*)
                                (= (car *guard*) 0)
                                (= (cdr *guard*) 0))
                      do (step-guard))
              (loop! ()
                (princ "*")
                (incf res)))))))
    (print res)
    res))

;; 377 too low
;; 1502 too low
;;; OFF BY ONE ERRRORRRRRRRRRRR
;; 1503 was the answer for me