(defpackage #:box-stacks
  (:use :cl))

(in-package #:box-stacks)

(defvar *drawing** ())
(defvar *cmds* ())
(with-open-file (s "./rnput.txt")
  (setf *drawing**
	(reverse (loop for line = (read-line s nil)
		       while line
		       until (string= line "")
		       collect line)))
  (setf *cmds*
	(loop for line = (read-line s nil)
		       while line
		       collect line)))

(defun parse-drawing (drawing)
  (let ((stackc (car drawing)) (stacks (cdr drawing)))
    (let (
	  (repr (loop for c across stackc when (not (eql c #\  )) collect nil))
	  (stacks (mapcar #'(lambda (s)
			      (loop for pos = 1 then (+ 4 pos)
				    while (< pos (length s)) collect (char s pos)))
			  stacks)))

      (mapcar #'(lambda (s)
		  (setf repr (loop for stack in repr
			for box in s
			while box
			;when (not (eql box #\ )) do (print (list stack box))))
			if (not (eql box #\ )) collect (cons box stack)
			else collect stack)))

		  stacks)

    repr)))

(defun parse-command (cmd)
  (let ((words (loop
	  for start = 0 then (1+ split)
	  for split = (position #\  cmd :start start)
	  when (and (null split) (not (= start (length cmd))))
	  collect (subseq cmd start)
	  while split
	  when (> split start) collect (subseq cmd start split)
	)))
    (mapcar #'parse-integer
	    (list (second words) (fourth words) (sixth words)))))



(defmacro move-boxes-9000 (command stacks)
  (let (
	(tmp (gensym))
	(cnt (gensym))
	(src (gensym))
	(dst (gensym))
	(source-stack (gensym)))
    `(let ((,tmp (parse-command ,command)))
       (let ((,cnt (first ,tmp))
	     (,src (- (second ,tmp) 1))
	     (,dst(- (third ,tmp) 1)))
	 (loop for i from 1 to ,cnt
	       do (progn
		    (let ((,source-stack (nth ,src ,stacks)))
		      (setf (nth ,dst ,stacks) (cons (car ,source-stack) (nth ,dst ,stacks)))
		      (setf (nth ,src ,stacks) (cdr ,source-stack)))))))))

(defmacro move-boxes-9001 (command stacks)
  (let (
	(tmp (gensym))
	(cnt (gensym))
	(src (gensym))
	(dst (gensym))
	(source-stack (gensym)))
  `(let ((,tmp (loop
		 for start = 0 then (1+ split)
		 for split = (position #\   ,command :start start)
		 when (and (null split) (not (= start (length ,command))))
		 collect (subseq ,command start)
		 while split
		 when (> split start) collect (subseq ,command start split))))
     (let ((,cnt (parse-integer (second ,tmp)))
	   (,src (- (parse-integer (fourth ,tmp)) 1))
	   (,dst(- (parse-integer (sixth ,tmp)) 1)))
       (let ((,source-stack (nth ,src ,stacks)))
	 (setf (nth ,dst ,stacks) (append (subseq ,source-stack 0 ,cnt) (nth ,dst ,stacks)))
	 (setf (nth ,src ,stacks) (subseq ,source-stack ,cnt)))))))



(defun part-one ()
  (let ((stacks (parse-drawing *drawing**)))
    (loop for cmd in *cmds*
	  while cmd
	  do (progn (move-boxes-9000 cmd stacks)))
    (mapcar #'(lambda (c)(format t "~c" c)) (mapcar #'car stacks))))

(defun part-two ()
  (let ((stacks (parse-drawing *drawing**)))
    (loop for cmd in *cmds*
	  while cmd
	  do (progn (move-boxes-9001 cmd stacks)))
    (mapcar #'(lambda (c)(format t "~c" c)) (mapcar #'car stacks))))

;(print (macroexpand-1 '(move-boxes-9001 cmd stacks)))

(format t "Part One: ")
(part-one)
(format t "~%Part Two: ")
(part-two)
(format t "~%")