Author: junrue Date: Mon Jun 5 14:42:47 2006 New Revision: 153
Modified: trunk/docs/manual/api.texinfo trunk/src/demos/unblocked/tiles-panel.lisp trunk/src/tests/uitoolkit/drawing-tester.lisp trunk/src/tests/uitoolkit/event-tester.lisp trunk/src/tests/uitoolkit/mock-objects.lisp trunk/src/uitoolkit/graphics/magick-core-api.lisp trunk/src/uitoolkit/widgets/widget-utils.lisp trunk/src/uitoolkit/widgets/widget.lisp Log: fixed silly redundant floor forms
Modified: trunk/docs/manual/api.texinfo ============================================================================== --- trunk/docs/manual/api.texinfo (original) +++ trunk/docs/manual/api.texinfo Mon Jun 5 14:42:47 2006 @@ -225,7 +225,7 @@ @end deftp
@anchor{control} -@deftp Class control +@deftp Class control brush-color brush-handle font pixel-point maximum-size minimum-size text-color The base class for widgets having pre-defined native behavior. It derives from @ref{widget}. @end deftp
Modified: trunk/src/demos/unblocked/tiles-panel.lisp ============================================================================== --- trunk/src/demos/unblocked/tiles-panel.lisp (original) +++ trunk/src/demos/unblocked/tiles-panel.lisp Mon Jun 5 14:42:47 2006 @@ -46,8 +46,8 @@ (gfs:make-point :x xpos :y ypos))))
(defun window->tiles (pnt) - (let ((xpos (floor (/ (1- (gfs:point-x pnt)) +tile-bmp-width+))) - (ypos (- +vert-tile-count+ (1+ (floor (/ (1- (gfs:point-y pnt)) +tile-bmp-height+)))))) + (let ((xpos (floor (1- (gfs:point-x pnt)) +tile-bmp-width+)) + (ypos (- +vert-tile-count+ (1+ (floor (1- (gfs:point-y pnt)) +tile-bmp-height+))))) (if (or (>= xpos +horz-tile-count+) (>= ypos +vert-tile-count+)) nil (gfs:make-point :x xpos :y ypos))))
Modified: trunk/src/tests/uitoolkit/drawing-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/drawing-tester.lisp (original) +++ trunk/src/tests/uitoolkit/drawing-tester.lisp Mon Jun 5 14:42:47 2006 @@ -301,7 +301,7 @@ (setf pnt (draw-a-string gc pnt nil "Courier New" 14 '(:italic :bold :underline) nil)) (setf pnt (draw-a-string gc pnt nil "Courier New" 18 '(:strikeout) nil))
- (setf (gfs:point-x pnt) (+ (floor (/ (gfs:size-width (gfw:client-size *drawing-win*)) 2)) 10)) + (setf (gfs:point-x pnt) (+ (floor (gfs:size-width (gfw:client-size *drawing-win*)) 2) 10)) (setf (gfs:point-y pnt) 0) (setf pnt (draw-a-string gc pnt (format nil "tab~ctab~ctab" #\Tab #\Tab) "Verdana" 10 nil '(:tab))) (setf pnt (draw-a-string gc pnt (format nil "even~cmore~ctabs" #\Tab #\Tab) "Verdana" 10 nil '(:tab)))
Modified: trunk/src/tests/uitoolkit/event-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/event-tester.lisp (original) +++ trunk/src/tests/uitoolkit/event-tester.lisp Mon Jun 5 14:42:47 2006 @@ -52,7 +52,7 @@ (setf (gfg:background-color gc) gfg:*color-white*) (setf (gfg:foreground-color gc) gfg:*color-blue*) (let* ((sz (gfw:client-size window)) - (pnt (gfs:make-point :x 0 :y (floor (/ (gfs:size-height sz) 2))))) + (pnt (gfs:make-point :x 0 :y (floor (gfs:size-height sz) 2)))) (gfg:draw-text gc *event-tester-text* pnt)))
(defmethod gfw:event-close ((d event-tester-window-events) widget time)
Modified: trunk/src/tests/uitoolkit/mock-objects.lisp ============================================================================== --- trunk/src/tests/uitoolkit/mock-objects.lisp (original) +++ trunk/src/tests/uitoolkit/mock-objects.lisp Mon Jun 5 14:42:47 2006 @@ -79,7 +79,7 @@ size))
(defmethod gfw:text-baseline ((widget mock-widget)) - (floor (/ (* (gfs:size-height (min-size-of widget)) 3) 4))) + (floor (* (gfs:size-height (min-size-of widget)) 3) 4))
(defmethod gfw:visible-p ((widget mock-widget)) (visibility-of widget))
Modified: trunk/src/uitoolkit/graphics/magick-core-api.lisp ============================================================================== --- trunk/src/uitoolkit/graphics/magick-core-api.lisp (original) +++ trunk/src/uitoolkit/graphics/magick-core-api.lisp Mon Jun 5 14:42:47 2006 @@ -135,7 +135,7 @@ (height :unsigned-long))
(defun scale-quantum-to-byte (quant) - (floor (/ quant 257))) + (floor quant 257))
;;; ;;; translated from magick.h
Modified: trunk/src/uitoolkit/widgets/widget-utils.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-utils.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-utils.lisp Mon Jun 5 14:42:47 2006 @@ -167,9 +167,9 @@ (setf baseline (+ b-width top-margin (gfg:ascent metrics) - (floor (/ (- (gfs:size-height size) - (+ (gfg:ascent metrics) (gfg:descent metrics))) - 2))))) + (floor (- (gfs:size-height size) + (+ (gfg:ascent metrics) (gfg:descent metrics))) + 2)))) (gfs:dispose gc)) baseline))
@@ -190,8 +190,8 @@ (cffi:with-foreign-object (bm-ptr 'gfs::bitmap) (cffi:with-foreign-slots ((gfs::width gfs::height) bm-ptr gfs::bitmap) (gfs::get-object hbitmap (cffi:foreign-type-size 'gfs::bitmap) bm-ptr) - (setf *check-box-size* (gfs:make-size :width (floor (/ gfs::width 4)) - :height (floor (/ gfs::height 3)))))) + (setf *check-box-size* (gfs:make-size :width (floor gfs::width 4) + :height (floor gfs::height 3))))) (gfs::delete-object hbitmap))) (gfs:copy-size *check-box-size*))
Modified: trunk/src/uitoolkit/widgets/widget.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget.lisp (original) +++ trunk/src/uitoolkit/widgets/widget.lisp Mon Jun 5 14:42:47 2006 @@ -41,7 +41,7 @@ (+ ancest-coord (floor (- (/ ancest-size 2) (/ desc-size 2)))))
(defun centered-coord-outside (ancest-coord ancest-size desc-size) - (- ancest-coord (floor (/ (- desc-size ancest-size) 2)))) + (- ancest-coord (floor (- desc-size ancest-size) 2)))
(defun center-object (ancestor descendant) (let* ((ancest-size (client-size ancestor))