CLIM mail archive


Coordinates problem...

I've been trying to write a macro to draw a colored rectangular
background on any piece of output, ie., much like
SURROUNDING-OUTPUT-WITH-BORDER, but with the extra options of INK and
OFFSET, the latter to allow for some blank space around the output.
Offseting seems to be a problem with text, I've tried WITH-TRANSLATION
and WITH-LOCAL-COORDINATES without success, everytime a newline is
generated, it goes to 0 instead of the cursor relative 0.

For eg., if the cursor is at some non-zero position,
 (with-color-box-background (window)
                (print 'a window) (print 'b window)), I get

     a           instead of            a
b				       b

here's the code.

(defmacro with-color-box-background ((stream &optional (ink clim::+red+)
                                     (offset 2)) &body body)
  `(multiple-value-bind (x y) (clim:stream-cursor-position* ,stream)

    (clim::with-bounding-rectangle* (left top right bottom)
      ;; this is discarded, needed only to compute dimension.
      (clim:with-output-to-output-record (,stream)
	(clim:with-local-coordinates (,stream)

      (clim:stream-increment-cursor-position* ,stream ,offset ,offset)
      (clim:with-new-output-record (,stream)
	  (clim:draw-rectangle* ,stream x y (+ x ,offset ,offset (- right left))
				 (+ y ,offset ,offset (- bottom top)) :ink ,ink)
	(clim:with-local-coordinates (,stream)

platform: SUN IPC, LUCID 4.1, CLIM 1.1

I would appreciate any comment on the code.  The version below needs
to create only one output record but is not quite as clean, is it kosher?

(defmacro wcbb ((stream &optional (ink clim::+red+) (offset 2) (draw-p t)) &body body)
  (let ((outr (gensym)))
    `(multiple-value-bind (x y) (clim:stream-cursor-position* ,stream)
      (clim:stream-increment-cursor-position* ,stream ,offset ,offset)

      (setq ,outr (clim:with-output-to-output-record (,stream)
		    (clim:draw-rectangle* ,stream x y x y);; dummy output element
		    (clim:with-local-coordinates (,stream)

      (with-slots (clim::left clim::top clim::right clim::bottom clim::elements) ,outr
	 (setf (aref clim::elements 0)
	       (clim:with-output-to-output-record (,stream)
		 (clim:draw-rectangle* ,stream (- ,offset) (- ,offset)
				       (- clim::right clim::left) (- clim::bottom clim::top)
			               :ink ,ink :filled t)))

	 (decf clim::left ,offset) (decf clim::top ,offset)
	 (incf clim::right ,offset) (incf clim::bottom ,offset))

       (when ,draw-p (clim:replay ,outr ,stream))


Main Index | Thread Index