McCLIM
McCLIM copied to clipboard
McCLIM
with-room-for-graphics interpretation is invalid
with-room-for-graphics is specified here: http://bauhh.dyndns.org:8000/clim-spec/15-4.html#_815
We have interpreted this as an operator that creates the area below the cursor position to allow inserting some graphics, while the specification seems to indicate that it is an operator to inline graphics in the line (see the issue #722 - this request probably describes intended utility of this macro). The specification has problems regardless:
- the origin should be located at the baseline, not the cursor position that is the top of the line
- it is not explicitly mentioned what happens with the line - height should /probably/ change the line height
Related to https://github.com/McCLIM/McCLIM/issues/722
Here is implementation that follows the text of the spec (without taking into account two above issues)
(defmethod invoke-with-room-for-graphics
(continuation (stream extended-output-stream)
&key (first-quadrant t) (move-cursor t) height
(record-type 'standard-sequence-output-record))
(multiple-value-bind (cx cy) (stream-cursor-position stream)
(let ((record (with-output-to-output-record (stream record-type)
(if first-quadrant
(with-first-quadrant-coordinates (stream cx cy)
(funcall continuation stream))
(with-local-coordinates (stream cx cy)
(funcall continuation stream))))))
(when height
(with-bounding-rectangle* (x1 y1 :height record-height) record
(setf (output-record-position record)
(values x1 (+ y1 (- height record-height))))))
(when (stream-recording-p stream)
(stream-add-output-record stream record))
(when (stream-drawing-p stream)
(replay record stream))
(setf (stream-cursor-position stream)
(if move-cursor
(values (bounding-rectangle-max-x record) cy)
(values cx cy))))))
For the reference, this came up when I've tried to improve the invalid interpretation - I'm attaching patches for curious readers.
From c1ed00cf22746811eb2b5b0427caba61fa27a653 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <[email protected]>
Date: Mon, 11 Oct 2021 16:15:58 +0200
Subject: [PATCH 1/2] with-room-for-graphics: rewrite the implementation
This version avoids a few issues when drawing in the first quadrant. Moreover
it allows specifying width to clip the output from the right. The
interpretation for the record bounding rectangle is clarified to always
include the origin [0,0] and cut everythingq falling outside of the positive
x/y drawing plane.
---
Core/clim-basic/decls.lisp | 7 +
.../extended-streams/recording.lisp | 144 ++++++++----------
.../extended-streams/stream-output.lisp | 12 +-
3 files changed, 73 insertions(+), 90 deletions(-)
diff --git a/Core/clim-basic/decls.lisp b/Core/clim-basic/decls.lisp
index 49dc92a8..af95d402 100644
--- a/Core/clim-basic/decls.lisp
+++ b/Core/clim-basic/decls.lisp
@@ -562,6 +562,13 @@ and right margin for text output."))
;; with-room-for-graphics (&optional stream &key (first-quadrant t) height (move-cursor t) record-type) &body body [Macro]
+;;; FIXME: think about merging behavior by using WITH-LOCAL-COORDINATES and
+;;; WITH-FIRST-QUADRANT-COORDINATES which both work on both mediums and
+;;; streams. Also write a documentation chapter describing behavior and
+;;; providing some examples.
+(defgeneric invoke-with-room-for-graphics
+ (cont stream &key first-quadrant height move-cursor record-type &allow-other-keys))
+
;;; 15.4.2 Wrapping of Text Lines [complete]
(defgeneric stream-end-of-line-action (stream))
diff --git a/Core/clim-basic/extended-streams/recording.lisp b/Core/clim-basic/extended-streams/recording.lisp
index 3906e5cd..03bab4dc 100644
--- a/Core/clim-basic/extended-streams/recording.lisp
+++ b/Core/clim-basic/extended-streams/recording.lisp
@@ -2110,13 +2110,6 @@ according to the flags RECORD and DRAW."
(when (stream-drawing-p stream)
(call-next-method)))
-;;; FIXME: think about merging behavior by using WITH-LOCAL-COORDINATES and
-;;; WITH-FIRST-QUADRANT-COORDINATES which both work on both mediums and
-;;; streams. Also write a documentation chapter describing behavior and
-;;; providing some examples.
-(defgeneric invoke-with-room-for-graphics
- (cont stream &key first-quadrant height move-cursor record-type))
-
;;; ----------------------------------------------------------------------------
;;; Complicated, underspecified...
;;;
@@ -2124,82 +2117,67 @@ according to the flags RECORD and DRAW."
;;; with-room-for-graphics is supposed to set the medium transformation to
;;; give the desired coordinate system; i.e., it doesn't preserve any
;;; rotation, scaling or translation in the current medium transformation.
-(defmethod invoke-with-room-for-graphics (cont (stream extended-output-stream)
- &key (first-quadrant t)
- height
- (move-cursor t)
- (record-type
- 'standard-sequence-output-record))
- ;; I am not sure what exactly :height should do. ; [avengers pun]
- ;; --GB 2003-05-25 ; -----------------
- ;; The current behavior is consistent with 'classic' CLIM ; where is genera?
- ;; --Hefner 2004-06-19 ;
- ;; Don't know if it still is :) ; what is genera?
- ;; -- Moore 2005-01-26 ;
- ;; I think that it doesn't matter ;) ; why is genera?
- ;; -- jd 2018-08-11 ; -----------------
- ;;
- ;; More seriously though (comments left for giggles), HEIGHT defaults to the
- ;; output-record height unless specified by the programmer. In that case
- ;; output is clipped to that height and exactly that amount of space is
- ;; reserved for drawing (so if the output-record is smaller we have some empty
- ;; space, if it is bigger it is clipped). In case of panes which does not
- ;; record it will be the only means to assure space in case of the
- ;; FIRST-QUADRANT = T (Y-axis inverted). -- jd
- ;;
- ;; ADDME: add width argument for clipping (McCLIM extension)
- (multiple-value-bind (cx cy) (stream-cursor-position stream)
- (with-sheet-medium (medium stream)
- (let ((clip-region (graphics-state-clip medium)))
- (letf (((medium-transformation medium)
- (if first-quadrant
- (make-scaling-transformation 1 -1)
- +identity-transformation+))
- ((medium-clipping-region medium)
- +everywhere+))
- (let ((record (with-output-to-output-record (stream record-type)
- (funcall cont stream))))
- ;; Bounding rectangle is in sheet coordinates!
- (with-bounding-rectangle* (x1 y1 x2 y2) record
- (let* ((record-height (- y2 y1))
- (height-clip (when (and height
- (< height record-height))
- (make-rectangle*
- cx cy (+ cx (- x2 x1)) (+ cy height))))
- (new-x (max cx (+ cx x1)))
- (new-y (cond ((not first-quadrant)
- (max cy (+ cy y1)))
- (height
- (+ cy (- height record-height)))
- (t
- cy))))
- (setf (output-record-position record) (values new-x new-y))
- ;; Clip all output records to HEIGHT and/or the medium clipping
- ;; region. All clipping region are in sheet coordinates.
- (when-let ((clip-region
- (cond ((and (not (eq clip-region +everywhere+))
- height-clip)
- (region-intersection clip-region height-clip))
- (height-clip)
- ((not (eq clip-region +everywhere+))
- clip-region))))
- (map-over-output-records
- (lambda (record)
- (when (typep record 'gs-clip-mixin)
- (setf (graphics-state-clip record) clip-region)))
- record))
- ;; And and/or replay the clipped and repositioned RECORD.
- (when (stream-recording-p stream)
- (stream-add-output-record stream record))
- (when (stream-drawing-p stream)
- (replay record stream))
- ;; Restore the cursor position or move the cursor.
- (setf (stream-cursor-position stream)
- (values cx (+ cy (if move-cursor
- (max (if first-quadrant (- y1) 0)
- (or height record-height))
- 0)))))
- record)))))))
+;;;
+;;; This function takes the following interpretation:
+;;; - the clipped region is [0,0] -> [width,height] (positive x/y)
+;;; - the transformation is identity (+ quadrant)
+;;; - the medium clipping region is honored (intersection)
+(defmethod invoke-with-room-for-graphics
+ (continuation (stream extended-output-stream)
+ &key (first-quadrant t) (move-cursor t) width height
+ (record-type 'standard-sequence-output-record))
+ (with-sheet-medium (medium stream)
+ (flet ((make-output-record ()
+ (letf (((medium-transformation medium)
+ (if first-quadrant
+ (make-scaling-transformation 1 -1)
+ +identity-transformation+))
+ ((medium-clipping-region medium) +everywhere+))
+ (with-output-to-output-record (stream record-type)
+ (funcall continuation stream)))))
+ (multiple-value-bind (cx cy) (stream-cursor-position stream)
+ (let ((clip-region (graphics-state-clip medium))
+ (record (make-output-record)))
+ ;; We fit the record in the room for graphics. When the height and/or
+ ;; width are provided then they are used to clip the output record
+ ;; bounding rectangle (in the sheet coordinates).
+ (with-bounding-rectangle* (x1 y1 x2 y2) record
+ (setf x1 (+ cx (max 0 x1))
+ x2 (+ cx (max 0 (or width x2))))
+ (if (null first-quadrant)
+ (setf y1 (+ cy (max 0 y1))
+ y2 (+ cy (max 0 (or height y2))))
+ ;; juggle juggle
+ (psetf y1 (if (null height)
+ cy
+ (+ cy (- height (- y1))))
+ y2 (+ cy (max 0 (or height (- y1))))))
+ ;; 1. Move the output record to the origin.
+ (setf (output-record-position record) (values x1 y1))
+ ;; 2. Clip output records when necessary.
+ (when (or (and width (< width x2))
+ (and height (< height y2)))
+ (let ((room-for-graphics (make-bounding-rectangle x1 cy x2 y2)))
+ (if (region-equal +everywhere+ clip-region)
+ (setf clip-region room-for-graphics)
+ (setf clip-region (region-intersection clip-region room-for-graphics)))
+ (map-over-output-records
+ (lambda (record)
+ (when (typep record 'gs-clip-mixin)
+ (setf (graphics-state-clip record) clip-region)))
+ record)))
+ ;; 3. Add and/or replay the repositioned record.
+ (when (stream-recording-p stream)
+ (stream-add-output-record stream record))
+ (when (stream-drawing-p stream)
+ (replay record stream))
+ ;; 4. Move (or restore) the cursor position.
+ (setf (stream-cursor-position stream)
+ (if move-cursor
+ (values x2 y2)
+ (values cx cy))))
+ ;; Presto!
+ record)))))
;;; FIXME: add clipping to HEIGHT and think of how MOVE-CURSOR could be
;;; implemented (so i-w-r-f-g returns an imaginary cursor progress).
diff --git a/Core/clim-basic/extended-streams/stream-output.lisp b/Core/clim-basic/extended-streams/stream-output.lisp
index f853fc53..1139fdc6 100644
--- a/Core/clim-basic/extended-streams/stream-output.lisp
+++ b/Core/clim-basic/extended-streams/stream-output.lisp
@@ -440,13 +440,11 @@ produces no more than one line of output i.e., doesn't wrap."))
(declare (ignore y))
(= x (stream-cursor-initial-position stream))))
-(defmacro with-room-for-graphics ((&optional (stream t)
- &rest arguments
- &key (first-quadrant t)
- height
- (move-cursor t)
- (record-type ''standard-sequence-output-record))
- &body body)
+(defmacro with-room-for-graphics
+ ((&optional (stream t) &rest arguments
+ &key (first-quadrant t) (move-cursor t) width height
+ (record-type ''standard-sequence-output-record))
+ &body body)
(declare (ignore first-quadrant height move-cursor record-type))
(let ((cont (gensym "CONT."))
(stream (stream-designator-symbol stream '*standard-output*)))
--
2.33.0
From 4a628c759dfe102f6cb90cb9464c5b368d230222 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <[email protected]>
Date: Tue, 12 Oct 2021 10:03:01 +0200
Subject: [PATCH 2/2] THIS IS WRONG! specification: with-room-for-graphics:
clarify the macro
This macro had ambiguous specification. This commit clarifies the behavior
according to McCLIM understanding.
WHY THIS IS WRONG? this was my initial interpretation, but this is not
right. The macro is supposed to allow draw something in the same line as
text. For example:
|
|
Here comes graphics |_____________ and again here comes text.
---
.../Specification/extended-output.tex | 32 +++++++++++--------
1 file changed, 19 insertions(+), 13 deletions(-)
diff --git a/Documentation/Specification/extended-output.tex b/Documentation/Specification/extended-output.tex
index ee8c5cc7..406bf64b 100644
--- a/Documentation/Specification/extended-output.tex
+++ b/Documentation/Specification/extended-output.tex
@@ -438,28 +438,34 @@ The following macro provides a convenient way to mix text and graphics on the
same output stream.
\Defmacro {with-room-for-graphics} {(\optional stream
- \key (first-quadrant \cl{t}) height (move-cursor \cl{t})
- record-type)
+ \key (first-quadrant \cl{t}) (move-cursor \cl{t})
+ width height record-type)
\body body}
Binds the dynamic environment to establish a local coordinate system for doing
graphics output onto the \term{extended output stream} designated by
-\arg{stream}. If \arg{first-quadrant} is \term{true} (the default), a local
-Cartesian coordinate system is established with the origin $(0,0)$ of the local
-coordinate system placed at the current cursor position; $(0,0)$ is in the lower
-left corner of the area created. If the boolean \arg{move-cursor} is
-\term{true} (the default), then after the graphic output is completed, the
-cursor is positioned past (immediately below) this origin. The bottom of the
-vertical block allocated is at this location (that is, just below point $(0,0)$,
-not necessarily at the bottom of the output done).
+\arg{stream}. A local Cartesian coordinate system is estabilished with the
+origin $(0,0)$ and clipped to a rectangle $(0,0,width,height)$. The upper left
+corner of graphics is put at the current cursor position of the \arg{stream}.
+
+If \arg{first-quadrant} is \term{true} (the default), the origin $(0,0)$ is in
+the lower left corner of the area created and y axis increases upwards (the
+coordinate system is right-handed).
+Otherwise the origin $(0,0)$ is in the upper left corner of the area created
+and y axis increases downwards (the coordinate system is left-handed)..
The \arg{stream} argument is not evaluated, and must be a symbol that is bound
to a stream. If \arg{stream} is \cl{t} (the default), \cl{*standard-output*} is
used. \arg{body} may have zero or more declarations as its first forms.
-If \arg{height} is supplied, it must be a rational number that specifies the
-amount of vertical space to allocate for the output, in device units. If it is
-not supplied, the height is computed from the output.
+If \arg{height} or \arg{width} is supplied, it must be a rational number that
+specifies the amount of vertical or horizontal space to allocate for the
+output, in device units. If they are not supplied, dimensions are computed
+from the output.
+
+If the boolean \arg{move-cursor} is \term{true} (the default), then the text
+cursor will be moved so that it immediately follows the lower right corner of
+the drawing area. Otherwise the old position is preserved.
\arg{record-type} specifies the class of output record to create to hold the
graphical output. The default is \cl{standard-sequence-output-record}.
--
2.33.0