(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 advance (field state)
  (destructuring-bind (height width) (array-dimensions field)
    (with-slots (direction x-pos y-pos) state
      (destructuring-bind (new-x new-y)
          (ecase direction
            (north (list x-pos (mod (1- y-pos) height)))
            (south (list x-pos (mod (1+ y-pos) height)))
            (east  (list (mod (1+ x-pos) width) y-pos))
            (west  (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
              (advance field new-state)))))))

(defconstant +directions+ #(north east south west))

(defun new-direction (current-direction turn)
  (svref +directions+
         (mod
          (+
           (ecase turn
             (left -1)
             (right 1))
           (position current-direction +directions+))
          4)))

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

(fiveam:test preparation
  (fiveam:is (eq 'south (new-direction 'east 'right)))
  (fiveam:is (eq 'west (new-direction 'north 'left)))
  (fiveam:is (equal
              (parse-instructions "10R5L5R10L4R5L5" )
              '(10 RIGHT 5 LEFT 5 RIGHT 10 LEFT 4 RIGHT 5 LEFT 5))))


(defun decode-state (state)
  (with-slots (x-pos y-pos direction) state
    (+ (* 1000 (1+ y-pos))
       (* 4 (1+ x-pos))
       (ecase direction
         (east 0)
         (south 1)
         (west 2)
         (north 3)))))

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

(fiveam:test solutions
  (fiveam:is (= 6032 (solver "eg-in")))
  (fiveam:is (= 159034 (solver "input"))))

(defun face-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 x-face y-face x-coord y-coord)))))

(defun cube-advance (field state face-length)
  (destructuring-bind (x-face y-face x-coord y-coord) (face-coords state (floor (array-dimension field 0) 3))
    (let ((new-x (+ x-coord (case direction (< -1) (> 1) (t 0))))
          (new-y (+ y-coord (case direction (^ -1) (v 1) (t 0))))))
    (if (and
         (<= 0 new-x face-length)
         (<= 0 new-y face-length))
        (make-state :x-pos (+ new-x (* x-face face-length))
                    :y-pos (+ new-y (* y-face face-length)) :direction direction))


    (with-slots (direction x-pos y-pos) state
      (floor (+ x-pos
                (case direction (< -1) (> 1) (t 0)))
             face-length)
      (floor (+ y-pos
                (case direction (^ -1) (v 1) (t 0)))
             face-lendth)
      (destructuring-bind (new-x new-y)
          (case direction
            (^ -1) (list x-pos (floor (1- y-pos) face-length))
            (v 1) (list x-pos (floor (1+ y-pos) face-length))
            (> 1)  (list (floor (1+ x-pos) face-length) y-pos)
            (< -1)  (list (floor (1- x-pos) face-length) 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
              (cube-advance field new-state)))))))

(values (values 5 6) (values 9 2))

(floor (array-dimension (create-field "eg-in") 0) 3)

(let ((a 5))
  (trivia:match (list 5 6 2)
    ((trivia:guard (list 5 op 2)
                   (= op (1+ a))) 'hu)))

;;; 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

(trivia:match (list x-face y-face direction)
  ;; Face 1
  ((list 2 0 '>) (list 3 2 '<)) ;; 1-6
  ((list 2 0 'v) (list 2 1 'v)) ;; 1-4
  ((list 2 0 '<) (list 1 1 'v)) ;; 1-3
  ((list 2 0 '^) (list 0 1 'v)) ;; 1-2
  ;; Face 2
  ((list 0 1 '>) (list 1 1 '>)) ;; 2-3
  ((list 0 1 'v) (list 2 2 '^)) ;; 2-5
  ((list 0 1 '<) (list 3 2 '^)) ;; 2-6
  ((list 0 1 '^) (list 2 0 'v)) ;; 2-1
  ;; Face 3
  ((list 1 1 '>) (list 2 1 '>)) ;; 3-4
  ((list 1 1 'v) (list 2 2 '>)) ;; 3-5
  ((list 1 1 '<) (list 0 1 '<)) ;; 3-2
  ((list 1 1 '^) (list 2 0 '>)) ;; 3-1
  ;; Face 4
  ((list 2 1 '>) (list 3 2 'v)) ;; 4-6
  ((list 2 1 'v) (list 2 2 'v)) ;; 4-5
  ((list 2 1 '<) (list 1 1 '<)) ;; 4-3
  ((list 2 1 '^) (list 2 0 '^)) ;; 4-1
  ;; Face 5
  ((list 2 2 '>) (list 3 2 '>)) ;; 5-6
  ((list 2 2 'v) (list 0 1 '^)) ;; 5-2
  ((list 2 2 '<) (list 1 1 '^)) ;; 5-3
  ((list 2 2 '^) (list 2 1 '^)) ;; 5-4
  ;; Face 6
  ((list 3 2 '>) (list 2 0 '<)) ;; 6-1
  ((list 3 2 'v) (list 0 1 '>)) ;; 6-2
  ((list 3 2 '<) (list 2 2 '<)) ;; 6-5
  ((list 3 2 '^) (list 2 1 '<)) ;; 6-4
  )

(trivia:match '(> 5)
  ((list '> op) 6))

(let ((fl 4))
  (destructuring-bind (x-face y-face x-coord y-coord) (list 2 0 -1 1)
    (trivia:match (list x-face y-face x-coord y-coord)
      ;; Face 1 to its 4 neighbors 6,4,3,2
      ((trivia:guard
        (list 2 0 x y) ;; Neighbor 6
        (= (* 3 fl) x))
       (make-state :x-pos (1- (* 4 fl)) :y-pos (- (* 3 fl) y 1) :direction '<))
      ((trivia:guard ;; neighbor 4 is contiguous; no change
        (list 2 0 x y)
        (= fl y))
       (make-state :x-pos (+ x  (* 2 fl)) :y-pos fl :direction 'v))
      ((list 2 0 -1 y) ;; Neighbor 3
       (make-state :x-pos (+ y fl) :y-pos fl :direction 'v))
      ((list 2 0 x -1) ;; neighbor 2
       (make-state :x-pos (- fl x) :y-pos fl :direction 'v))
      ;; Face 2 to its 4 neighbors 3,5,6,1
      ((trivia:guard ;; Neighbor 3 contiguous
        (list 0 1 x y)
        (= x fl))
       (make-state :x-pos fl :y-pos (+ y fl) :direction '>))
      ((trivia:guard ;; Neighbor 5
        (list 0 1 x y)
        (= y (* 2 fl)))
       (make-state :x-pos (- fl x 1) :y-pos (1- (* 3 fl)) :direction '^))


    )))