(defpackage aoc-3
  (:use :cl)
  (:export read-format))

(in-package :aoc-3)

(defstruct claim
  (id 0 :type integer)
  (x 0 :type integer)
  (y 0 :type integer)
  (w 0 :type integer)
  (h 0 :type integer))

(defun sort-by-slot (lst slot-name &optional (pred #'<))
  (sort lst (lambda (a b)
			  (funcall pred
					   (slot-value a slot-name)
					   (slot-value b slot-name)))))

(defmethod axis-overlap ((a claim) b axis dim)
  (destructuring-bind (a b)
	  (sort-by-slot (sort-by-slot (list a b) dim) axis)
	(cons (slot-value b axis)
		  (max 0 (min (- (+ (slot-value a axis)
							(slot-value a dim))
						 (slot-value b axis))
					  (slot-value a dim)
					  (slot-value b dim))))))

(defmethod overlap ((a claim) b)
	(* (cdr (axis-overlap a b 'x 'w))
	   (cdr (axis-overlap a b 'y 'h))))

(defmethod overlap-coords ((a claim) b)
  (loop
	 with (x-start . width) = (axis-overlap a b 'x 'w)
	 with (y-start . height) = (axis-overlap a b 'y' h)
	 for x from x-start below (+ x-start width)
	 nconc (loop for y from y-start below (+ y-start height)
			  collect (cons x y))))

(defun read-expect (in expected)
  (loop for c across expected
	 for next = (peek-char nil in nil 'eof)
	 do (assert (eq c next))
	 do (read-char in))
  expected)

(defun read-int (in)
  (let* ((first (peek-char nil in nil 'eof))
		 (chars (append
				 (when (eq first #\-)
				   (list (read-char in)))
				 (loop
					for next = (peek-char nil in nil 'eof)
					while (and (not (eq next 'eof))
							   (digit-char-p next))
					collect (read-char in)))))
	(when chars
	  (parse-integer (coerce chars 'string)))))

(defun skip-whitespace (in)
  (loop for next = (peek-char nil in nil 'eof)
	 while (find next '(#\space #\newline))
	 counting (read-char in)))

(defun read-format (in spec)
  (loop for fmt in spec
	 for val = (etypecase fmt
				 (keyword fmt)
				 (symbol (ecase fmt
						   ((integer int) (read-int in))
						   (whitespace (skip-whitespace in))))
				 (string (read-expect in fmt) nil))
	 when val collect val))

(defun claims ()
  (with-open-file (in "input3")
    (loop
	   with fmt = '("#"
					:id int
					" @ "
					:x int "," :y int
					": "
					:w int "x" :h int)
	   do (skip-whitespace in)
	   while (listen in)
	   collect (apply #'make-claim
					  (read-format in fmt)))))

(defun pairs (lst)
  (loop for a on lst
	 nconc (loop for b in a
			  collect (cons (car a) b))))

(defun solve-challenge ()
  (loop with touched = (make-hash-table :test #'equalp)
	 for (a . b) in (pairs (claims))
	 unless (eq a b)
	 do (loop for xy in (overlap-coords a b)
		   do (setf (gethash xy touched) t))
	 finally (return (hash-table-count touched))))

(defun solve-challenge-2 ()
  (loop
	 with claims = (claims)
	 with ids = (mapcar #'claim-id claims)
	 for (a . b) in (pairs claims)
	 when (and (not (eq a b))
			   (> (overlap a b) 0))
	 do (setq ids (delete (claim-id a) (delete (claim-id b) ids :count 1) :count 1))
	 finally (return ids)))