CLIM mail archive
[Prev][Next][Index][Thread]

Coordinates problem...

    Date: Fri, 25 Sep 1992 21:43 EDT
    From: chee@isi.edu

    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.

Here is a grotesque kludge you can use for the time being; I did not
actually test this in CLIM 1.1, but I did in CLIM 2.0.  CLIM 2.0 will
allow you to specify drawing options for bordered output, so something
like the following will do what you want:

  (surrounding-output-with-border (stream :shape :rectangle :ink +yellow+ :filled t)
    (write-string "a filled rectangle" stream))

-------- cut here --------
(in-package :clim)

(defmacro with-color-box-background ((stream &optional (ink +red+) (offset 2))
				     &body body)
  `(flet ((with-color-box-background-body (,stream) ,@body))
     (declare (dynamic-extent #'with-color-box-background-body))
     (invoke-with-color-box-background
       ,stream #'with-color-box-background-body ,ink ,offset)))

(defun invoke-with-color-box-background (stream continuation ink offset)
  (let* ((body nil)				;the record containing the body
	 (border-record				;the entire bordered output record
	   (with-output-recording-options (stream :draw-p nil :record-p t)
	     (with-new-output-record (stream)
	       (setq body (with-new-output-record (stream)
			    (funcall continuation stream)))))))
    (with-bounding-rectangle* (left top right bottom) body
      (multiple-value-bind (xoff yoff)
	  (convert-from-relative-to-absolute-coordinates
	    stream (output-record-parent (output-record-parent body)))
	(translate-positions xoff yoff left top right bottom))
      (with-output-recording-options (stream :draw-p nil :record-p t)
	(with-new-output-record (stream 'linear-output-record nil
				 :parent border-record)
	  (draw-rectangle* stream 
			   (- left offset) (- top offset)
			   (+ right offset) (+ bottom offset)
			   :ink ink))))
    ;;--- Close your eyes
    (let ((elements (slot-value border-record 'elements)))
      (rotatef (aref elements 0) (aref elements 1)))
    ;;--- Now you can open your eyes again
    (replay border-record stream)
    border-record))

0,,
References:
Main Index | Thread Index