>From f24ead5da7be8566133210fb6f8e6944c4782a42 Mon Sep 17 00:00:00 2001 From: Ben Spencer Date: Sat, 24 Oct 2009 21:35:05 +0100 Subject: [PATCH] Fixed repositioning bug in resize-tree. --- tile-group.lisp | 18 +++++++----------- 1 files changed, 7 insertions(+), 11 deletions(-) diff --git a/tile-group.lisp b/tile-group.lisp index d2f9191..5233a74 100644 --- a/tile-group.lisp +++ b/tile-group.lisp @@ -563,22 +563,18 @@ LEAF. Return tree with leaf removed." (expand-tree newtree amt dir) newtree)) -(defun resize-tree (tree w h &optional x y) +(defun resize-tree (tree w h &optional (x (tree-x tree)) (y (tree-y tree))) "Scale TREE to width W and height H, ignoring aspect. If X and Y are provided, reposition the TREE as well." (let* ((tw (tree-width tree)) (th (tree-height tree)) - (wf (/ 1 (/ tw w))) - (hf (/ 1 (/ th h))) - (xo (if x (- x (tree-x tree)) 0)) - (yo (if y (- y (tree-y tree)) 0))) + (wf (/ w tw)) + (hf (/ h th))) (tree-iterate tree (lambda (f) - (setf (frame-height f) (round (* (frame-height f) hf)) - (frame-y f) (round (* (frame-y f) hf)) - (frame-width f) (round (* (frame-width f) wf)) - (frame-x f) (round (* (frame-x f) wf))) - (incf (frame-y f) yo) - (incf (frame-x f) xo))) + (setf (frame-height f) (round (* (frame-height f) hf)) + (frame-y f) (+ (round (* (- (frame-y f) (tree-y tree)) hf)) y) + (frame-width f) (round (* (frame-width f) wf)) + (frame-x f) (+ (round (* (- (frame-x f) (tree-x tree)) wf)) x)))) (dformat 4 "resize-tree ~Dx~D -> ~Dx~D~%" tw th (tree-width tree) (tree-height tree)))) (defun remove-frame (tree leaf) -- 1.6.5