(ql:quickload '(fiveam uiop arrows trivia))

(defun parse-instructions (str &optional (start 0))
  (multiple-value-bind (action str-pos)
      (case (aref str start)
        (#\R 'right)
        (#\L 'left)
        (t (parse-integer str :start start :junk-allowed t)))
    (let ((next (or str-pos (1+ start))))
      (if (= next (length str))
          (list action)
          (cons action (parse-instructions str next))))))

(defun create-field (filename)
  (let* ((data (uiop:read-file-lines filename))
         (map (butlast data 2))
         (instructions (car (last data)))
         (rows (length map))
         (columns (reduce (lambda (a r) (max a (length r))) map :initial-value 0))
         (field (make-array (list rows columns) :initial-element nil)))
    (loop for row in map
          for i from 0
          do (loop for entry across row
                   for j from 0
                   do (setf (aref field i j)
                            (ecase entry
                              (#\. 'free)
                              (#\# 'wall)
                              (#\Space nil)))))
    (values field (parse-instructions instructions))))


(defun get-start (field)
  (loop for i from 0
        until (aref field 0 i)
        finally (return i)))

(defstruct state
  x-pos y-pos direction)

(defun wrap-step (state field)
  (destructuring-bind (height width) (array-dimensions field)
    (with-slots (direction x-pos y-pos) state
      (destructuring-bind (new-x new-y)
          (ecase direction
            (^ (list x-pos (mod (1- y-pos) height)))
            (v (list x-pos (mod (1+ y-pos) height)))
            (> (list (mod (1+ x-pos) width) y-pos))
            (< (list (mod (1- x-pos) width) y-pos)))
        (let ((new-state (make-state :x-pos new-x :y-pos new-y :direction direction)))
          (if (aref field new-y new-x)
              new-state
              (wrap-step new-state field)))))))

(defun new-direction (current-direction turn &optional (directions #(^ > v <)))
  (svref directions
         (mod
          (+
           (ecase turn
             (left -1)
             (right 1))
           (position current-direction directions))
          4)))

(defun walk (field state steps advance-fn)
  (if (zerop steps)
      state
      (let ((new-state (funcall advance-fn state field)))
        (with-slots (x-pos y-pos) new-state
            (ecase (aref field y-pos x-pos)
              (free (walk field new-state (1- steps) advance-fn))
              (wall state))))))

(defun decode-state (state)
  (with-slots (x-pos y-pos direction) state
    (+ (* 1000 (1+ y-pos))
       (* 4 (1+ x-pos))
       (ecase direction
         (> 0)
         (v 1)
         (< 2)
         (^ 3)))))

(defun solver (filename advance-fn)
  (multiple-value-bind (field instructions) (create-field filename)
    (let ((state (make-state :x-pos (get-start field) :y-pos 0 :direction '>)))
      (dolist (move instructions)
        (if (numberp move)
            (setf state (walk field state move advance-fn))
            (setf (state-direction state) (new-direction (state-direction state) move))))
      (decode-state state))))

;;; part 2
;;; Cube face layout
;;;   1
;;; 234
;;;   56
;;; face coords
;;; 1=2 0
;;; 2=0 1
;;; 3=1 1
;;; 4=2 1
;;; 5=2 2
;;; 6=3 2

(defparameter +face-label+
  '((1 . (2 0))
    (2 . (0 1))
    (3 . (1 1))
    (4 . (2 1))
    (5 . (2 2))
    (6 . (3 2))))

(defun coord->face (x-face y-face)
  (car (rassoc (list x-face y-face) +face-label+ :test #'equal)))

(defun face->coord (face)
  (cdr (assoc face  +face-label+ :test #'eq)))

(defun reduced-coords (state face-length)
  (with-slots (x-pos y-pos) state
    (multiple-value-bind (x-face x-coord)
        (floor x-pos face-length)
      (multiple-value-bind (y-face y-coord)
          (floor y-pos face-length)
        (list (coord->face x-face y-face) x-coord y-coord)))))

(defun place-state (face x y direction face-length)
  (destructuring-bind (x-face y-face) (face->coord face)
    (make-state :x-pos (+ x (* x-face face-length))
                :y-pos (+ y (* y-face face-length)) :direction direction)))

(defun face-jump (face direction fl)
  "fl is face-length"
  (ecase face
    (1 (case direction
         (> (list 6 '< (lambda (_ y) (declare (ignore _)) (list (1- fl)    (- fl y 1)))))
         (v (list 4 'v (lambda (x _) (declare (ignore _)) (list x          0))))
         (< (list 3 'v (lambda (_ y) (declare (ignore _)) (list y          0))))
         (^ (list 2 'v (lambda (x _) (declare (ignore _)) (list (- fl x 1) 0))))))
    (2 (case direction
         (> (list 3 '> (lambda (_ y) (declare (ignore _)) (list 0          y))))
         (v (list 5 '^ (lambda (x _) (declare (ignore _)) (list (- fl x 1) (1- fl)))))
         (< (list 6 '^ (lambda (_ y) (declare (ignore _)) (list (- fl y 1) (1- fl)))))
         (^ (list 1 'v (lambda (x _) (declare (ignore _)) (list (- fl x 1) 0))))))
    (3 (case direction
         (> (list 4 '> (lambda (_ y) (declare (ignore _)) (list 0       y))))
         (v (list 5 '> (lambda (x _) (declare (ignore _)) (list 0       (- fl x 1)))))
         (< (list 2 '< (lambda (_ y) (declare (ignore _)) (list (1- fl) y))))
         (^ (list 1 '> (lambda (x _) (declare (ignore _)) (list 0       x))))))
    (4 (case direction
         (> (list 6 'v (lambda (_ y) (declare (ignore _)) (list (- fl y 1) 0))))
         (v (list 5 'v (lambda (x _) (declare (ignore _)) (list x          0))))
         (< (list 3 '< (lambda (_ y) (declare (ignore _)) (list (1- fl)    y))))
         (^ (list 1 '^ (lambda (x _) (declare (ignore _)) (list x         (1- fl)))))))
    (5 (case direction
         (> (list 6 '> (lambda (_ y) (declare (ignore _)) (list 0           y))))
         (v (list 2 '^ (lambda (x _) (declare (ignore _)) (list (- fl x 1) (1- fl)))))
         (< (list 3 '^ (lambda (_ y) (declare (ignore _)) (list (- fl y 1) (1- fl)))))
         (^ (list 4 '^ (lambda (x _) (declare (ignore _)) (list x          (1- fl)))))))
    (6 (case direction
         (> (list 1 '< (lambda (_ y) (declare (ignore _)) (list (1- fl) (- fl y 1)))))
         (v (list 2 '> (lambda (x _) (declare (ignore _)) (list 0       (- fl x 1)))))
         (< (list 5 '< (lambda (_ y) (declare (ignore _)) (list (1- fl) y))))
         (^ (list 4 '< (lambda (x _) (declare (ignore _)) (list (1- fl) (- fl x 1)))))))))

(defun cube-step (state face-length)
  (destructuring-bind (face x-coord y-coord) (reduced-coords state face-length)
    (with-slots (direction) state
      (let ((new-x (+ x-coord (case direction (< -1) (> 1) (t 0))))
            (new-y (+ y-coord (case direction (^ -1) (v 1) (t 0)))))
        (if (and
             (< -1 new-x face-length)
             (< -1 new-y face-length))
            (place-state face new-x new-y direction face-length)
            (destructuring-bind (new-face new-direction pos-fn) (face-jump face direction face-length)
              (destructuring-bind (new-x new-y) (funcall pos-fn x-coord y-coord)
                (place-state new-face new-x new-y new-direction face-length))))))))



(defun around-corner-test (start-face face-length)
  (let* ((orig (place-state start-face 0 0 '^ face-length))
         (state (copy-structure orig)))
    (dolist (move '(1 left 1 left 1 left))
      (if (numberp move)
          (setf state (cube-step state face-length))
          (setf (state-direction state) (new-direction (state-direction state) move))))
    (equalp orig state)))

(fiveam:test preparation
  (fiveam:is (eq 'v (new-direction '> 'right)))
  (fiveam:is (eq '< (new-direction '^ 'left)))
  (fiveam:is (equal
              (parse-instructions "10R5L5R10L4R5L5" )
              '(10 RIGHT 5 LEFT 5 RIGHT 10 LEFT 4 RIGHT 5 LEFT 5)))

  (fiveam:is (= 1 (coord->face 2 0)))
  (fiveam:is (= 6 (apply #'coord->face (face->coord 6)))))

;; (let* ((field (create-field "eg-in"))
;;        (face-length (floor (array-dimension field 0) 3)))
;;   (fiveam:is
;;    (equalp (place-state 2 3 0 'v 4)
;;            (cube-advance (place-state 1 0 0 '^ face-length) face-length))))

(fiveam:test around-corner
  (dotimes (i 6)
    (fiveam:is (around-corner-test (1+ i) 4))))

(fiveam:test solutions
  (fiveam:is (= 6032 (solver "eg-in" #'wrap-step)))
  (fiveam:is (= 159034 (solver "input" #'wrap-step)))
  ;part 2
  (fiveam:is (= 5031 (solver "eg-in" (lambda (state field) (cube-step state 4))))))

;; (solver "input" (lambda (state field) (cube-step state 50)))

;; (multiple-value-bind (field instructions) (create-field "input")
;;     (let ((state (place-state 1 0 0 '> 4))
;;           (advance-fn (lambda (state) (cube-step state 4))))
;;       (dolist (move instructions)
;;         (if (numberp move)
;;             (setf state (walk field state move advance-fn))
;;             (setf (state-direction state) (new-direction (state-direction state) move))))
;;       (decode-state state)))