(in-package :org.wanglianghome.pushbox)

;;; just to warm up :-P
;;; should convert new map to old, not the reverse.
(defun convert-map (old)
  (multiple-value-bind (person boxes targets graph)
      (values (get-person old) (get-box old) (get-target old) (get-graph old))
    (sublis (mapcar #'(lambda (list) (cons (first list) (second list))) `(,(reverse person) ,@(mapcar #'reverse boxes) ,@(mapcar #'reverse targets)))
	    (mapcar #'(lambda (edge)
			(cond ((eq (edge-direction edge) '>)
			       (list (from-node edge) '- (to-node edge)))
			      ((eq (edge-direction edge) '<)
			       (list (to-node edge) '- (from-node edge)))
			      ((eq (edge-direction edge) '^)
			       (list (from-node edge) '^ (to-node edge)))
			      ((eq (edge-direction edge) 'v)
			       (list (to-node edge) '^ (from-node edge)))))
		    graph))))

(defun generate-internal-map (map)
  (append (link-map-horizontally map) (link-map-vertically map) (special-position map)))

(defun link-map-horizontally (map)
  (let* ((column (length (first map)))
	 (row-counter 0)
	 (edges))
    (dolist (r map edges)
      (setq edges (append edges (link-row r (* row-counter column))))
      (incf row-counter))))

(defun link-map-vertically (map)
  (let* ((column (length (first map)))
	 (col-counter 0)
	 (edges))
    (dolist (c (map-transform map) edges)
      (setq edges (append edges (link-column c col-counter column)))
      (incf col-counter))))

(defun link-row (row start)
  (link-row-pair (first row) (rest row) start))

(defun link-row-pair (head tail start)
  (when (and head (first tail))
    (cons (list start '> (1+ start))
	  (link-row-pair (first tail) (rest tail) (+ start 1)))))

(defun map-transform (map)
  (let ((n (make-list (length (first map)))))
    (dolist (row map n)
      (setq n (mapcar #'append n (mapcar #'list row))))))

(defun link-column (column start step)
  (link-column-pair (first column) (rest column) start step))

(defun link-column-pair (head tail start step)
  (when (and head (first tail))
    (cons (list start '^ (+ start step))
	  (link-column-pair (first tail) (rest tail) (+ start step) step))))

(defun special-position (map)
  (let ((index 0) positions)
    (dolist (row map positions)
      (dolist (elt row)
	(let ((pos (cond ((eq elt 'p)
			  (list 'p index))
			 ((eq elt 'b)
			  (list 'b index))
			 ((eq elt 'o)
			  (list 'o index)))))
	  (when pos
	    (setq positions (cons pos positions))))
	(incf index)))))