Author: junrue Date: Fri Apr 7 02:12:06 2006 New Revision: 92
Modified: trunk/src/demos/unblocked/tiles-panel.lisp trunk/src/demos/unblocked/tiles.lisp Log: slightly faster drawing of selected shapes
Modified: trunk/src/demos/unblocked/tiles-panel.lisp ============================================================================== --- trunk/src/demos/unblocked/tiles-panel.lisp (original) +++ trunk/src/demos/unblocked/tiles-panel.lisp Fri Apr 7 02:12:06 2006 @@ -39,7 +39,7 @@
(defun tiles->window (pnt) (let ((xpos (1+ (* (gfs:point-x pnt) +tile-bmp-width+))) - (ypos (1+ (* (gfs:point-y pnt) +tile-bmp-height+))) + (ypos (1+ (* (- (1- +vert-tile-count+) (gfs:point-y pnt)) +tile-bmp-height+))) (size (gfw:client-size (get-tiles-panel)))) (if (or (>= xpos (gfs:size-width size)) (>= ypos (gfs:size-height size))) nil @@ -109,18 +109,19 @@ (unless (= (obtain-tile tiles tile-pnt) 0) (shape-tiles tiles tile-pnt results) (when (> (hash-table-count results) 1) - (maphash #'(lambda (pnt kind) - (declare (ignore kind)) - (set-tile tiles pnt +max-tile-kinds+)) - results) - (update-buffer self tiles) - (gfw:redraw panel) - (maphash #'(lambda (pnt kind) - (declare (ignore kind)) - (set-tile tiles pnt 0)) - results) + (let ((gc (make-instance 'gfg:graphics-context :widget panel)) + (image-table (tile-image-table-of self))) + (unwind-protect + (maphash #'(lambda (pnt kind) + (declare (ignore kind)) + (set-tile tiles pnt 0) + (gfg:draw-image gc + (gethash +max-tile-kinds+ image-table) + (tiles->window pnt))) + results) + (gfs:dispose gc))) (gfw:start (make-instance 'gfw:timer - :initial-delay 333 + :initial-delay 100 :delay 0 :dispatcher (make-instance 'tiles-timer-events :panel-dispatcher self)))))))
Modified: trunk/src/demos/unblocked/tiles.lisp ============================================================================== --- trunk/src/demos/unblocked/tiles.lisp (original) +++ trunk/src/demos/unblocked/tiles.lisp Fri Apr 7 02:12:06 2006 @@ -51,14 +51,14 @@ (let ((size (size-tiles tiles))) (dotimes (j (gfs:size-height size)) (dotimes (i (gfs:size-width size)) - (let ((kind (aref (aref tiles i) (- (1- (gfs:size-height size)) j)))) + (let ((kind (aref (aref tiles i) j))) (funcall func (gfs:make-point :x i :y j) kind))))))
(defun print-tiles (tiles) (let ((size (size-tiles tiles))) (dotimes (j (gfs:size-height size)) (dotimes (i (gfs:size-width size)) - (let ((kind (aref (aref tiles i) (- (1- (gfs:size-height size)) j)))) + (let ((kind (aref (aref tiles i) j))) (if (< kind 0) (print " ") (format t "~d " kind)))) @@ -105,8 +105,9 @@
(defun collapse-column (column-tiles) (let ((new-column (make-array (length column-tiles) :initial-element 0)) - (new-index 0)) - (dotimes (i (length column-tiles)) + (new-index 0) + (count (length column-tiles))) + (dotimes (i count) (let ((kind (aref column-tiles i))) (unless (zerop kind) (setf (aref new-column new-index) kind)