(define tiletree
  (lambda (depth lbound ubound)
    (new (depth depth)
	 (lbound lbound)
	 (ubound ubound)
	 (tree (tiletreecons depth lbound ubound 'h)))))

(define withsplitbox
  (lambda (lbound ubound sense combine lift)
    (cond
     ((= sense 'h)
      (let ((xsplit (avg (car lbound) (car ubound))))
	(combine (lift lbound (cons xsplit (cdr ubound)))
		 (lift (cons xsplit (cdr lbound)) ubound))))
     ((= sense 'v)
      (let ((ysplit (avg (cdr lbound) (cdr ubound))))
	(combine (lift lbound (cons (car ubound) ysplit))
		 (lift (cons (car lbound) ysplit) ubound)))))))

(define tiletreecons
  (lambda (depth lbound ubound sense)
    (cond
     ((= depth 0)
      (cons `((blockedp nil)
	      (location ,lbound))
	    nil))
     (t (withsplitbox lbound ubound sense
		      cons (lambda (lb ub)
			     (tiletreecons (- depth 1) lb ub
					   (lookup '((h v) (v h))
						   sense))))))))

(define avg
  (lambda (a b)
    (/ (+ a b) 2)))

(define tiletreeleaf
  (lambda (tree p)
    (let loop ((lbound (_ tree lbound))
	       (ubound (_ tree ubound))
	       (sense 'h)
	       (subtree (_ tree tree))
	       (depth (_ tree depth)))
	 (cond
	  ((= depth 0)
	   subtree)
	  ((= sense 'h)
	   (let ((xsplit (avg (car lbound)
			      (car ubound))))
	     (if (< (car p) xsplit)
		 (loop lbound (cons xsplit (cdr ubound))
		       'v (car subtree) (- depth 1))
	       (loop (cons xsplit (cdr lbound)) ubound
		     'v (cdr subtree) (- depth 1)))))
	  ((= sense 'v)
	   (let ((ysplit (avg (cdr lbound)
			      (cdr ubound))))
	     (if (< (cdr p) ysplit)
		 (loop lbound (cons (car ubound) ysplit)
		       'h (car subtree) (- depth 1))
	       (loop (cons (car lbound) ysplit) ubound
		     'h (cdr subtree) (- depth 1)))))))))

(define tiletreechange
  (lambda (tree p f)
    (let ((leaf (tiletreeleaf tree p)))
      (setcar leaf (f (car leaf))))))

(define filter
  (lambda (x pred)
    (cond
     ((nilp x) nil)
     ((pred (car x)) (cons (car x)
			   (filter (cdr x) pred)))
     (t (filter (cdr x) pred)))))

(define tiletreequery
  (lambda (tree lselect uselect pred)
    (filter (tiletreeselect tree lselect uselect)
	    pred)))

(define tiletreeselect
  (lambda (tree lselect uselect)
    (letrec ((rec (lambda (depth subtree sense lbound ubound acc)
		    (cond
		     ((= depth 0)
		      (cons (car subtree) acc))
		     ((= sense 'h)
		      (let ((xsplit (avg (car lbound) (car ubound))))
			(when (< (car lselect) xsplit)
			  (set acc (rec (- depth 1) (car subtree) 'v
					lbound (cons xsplit (cdr ubound))
					acc)))
			(when (>= (car uselect) xsplit)
			  (set acc (rec (- depth 1) (cdr subtree) 'v
					(cons xsplit (cdr lbound)) ubound
					acc)))
			acc))
		     ((= sense 'v)
		      (let ((ysplit (avg (cdr lbound) (cdr ubound))))
			(when (< (cdr lselect) ysplit)
			  (set acc (rec (- depth 1) (car subtree) 'h
					lbound (cons (car ubound) ysplit)
					acc)))
			(when (>= (cdr uselect) ysplit)
			  (set acc (rec (- depth 1) (cdr subtree) 'h
					(cons (car lbound) ysplit) ubound
					acc)))
			acc))))))
	    (rec (_ tree depth) (_ tree tree) 'h
		 (_ tree lbound) (_ tree ubound) nil))))
