[closure-cvs] CVS update: closure/src/renderer/tables.lisp closure/src/renderer/renderer2.lisp closure/src/renderer/clim-draw.lisp
Christophe Rhodes
crhodes at common-lisp.net
Mon Jul 11 15:58:04 UTC 2005
Update of /project/closure/cvsroot/closure/src/renderer
In directory common-lisp.net:/tmp/cvs-serv7926/src/renderer
Modified Files:
tables.lisp renderer2.lisp clim-draw.lisp
Log Message:
Complete the renaming *MEDIUM* -> *PANE*.
Panes are CLIM extended-streams, and remember output to them in output
records. Mediums are much simpler, and don't have this kind of
memory. So, though the same drawing functions (DRAW-TEXT, DRAW-LINE)
can have the same initial effect applied to a pane and a medium, the
output-record state is very different.
Date: Mon Jul 11 17:57:57 2005
Author: crhodes
Index: closure/src/renderer/tables.lisp
diff -u closure/src/renderer/tables.lisp:1.3 closure/src/renderer/tables.lisp:1.4
--- closure/src/renderer/tables.lisp:1.3 Sun Mar 13 19:03:25 2005
+++ closure/src/renderer/tables.lisp Mon Jul 11 17:57:56 2005
@@ -943,8 +943,8 @@
(rc-first-line-tasks new-rc) nil
(rc-left-floating-boxen new-rc) nil
(rc-right-floating-boxen new-rc) nil)
- (clim:with-new-output-record (clim-user::*medium* 'clim:standard-sequence-output-record record)
- (clim:with-output-recording-options (clim-user::*medium* :record t :draw nil)
+ (clim:with-new-output-record (clim-user::*pane* 'clim:standard-sequence-output-record record)
+ (clim:with-output-recording-options (clim-user::*pane* :record t :draw nil)
(let* ((fake-parent (make-bbox))
(bbox (brender new-rc (cell-content cell) fake-parent)))
(if bbox
@@ -1030,15 +1030,15 @@
(defun render-table (rc pt parent-box)
;; Now, while we render a table, we unfortunatly have to disable
;; drawing.
- (clim:with-output-recording-options (clim-user::*medium* :record t :draw nil)
+ (clim:with-output-recording-options (clim-user::*pane* :record t :draw nil)
;;; xxx not yet correct
- (funcall (if t ;(clim:stream-drawing-p clim-user::*medium*)
+ (funcall (if t ;(clim:stream-drawing-p clim-user::*pane*)
#'clim:replay-output-record
#'values)
- (clim:with-new-output-record (clim-user::*medium*)
+ (clim:with-new-output-record (clim-user::*pane*)
;; why does drawp nest proper?
(render-table-2 rc pt parent-box))
- clim-user::*medium* clim:+everywhere+ 0 0)))
+ clim-user::*pane* clim:+everywhere+ 0 0)))
(defun render-table-2 (rc pt parent-box)
(let ((table (parse-table pt))
Index: closure/src/renderer/renderer2.lisp
diff -u closure/src/renderer/renderer2.lisp:1.8 closure/src/renderer/renderer2.lisp:1.9
--- closure/src/renderer/renderer2.lisp:1.8 Sun Jul 10 13:18:35 2005
+++ closure/src/renderer/renderer2.lisp Mon Jul 11 17:57:56 2005
@@ -4,7 +4,7 @@
;;; Created: somewhen late 2002
;;; Author: Gilbert Baumann <gilbert at base-engineering.com>
;;; License: MIT style (see below)
-;;; $Id: renderer2.lisp,v 1.8 2005/07/10 11:18:35 emarsden Exp $
+;;; $Id: renderer2.lisp,v 1.9 2005/07/11 15:57:56 crhodes Exp $
;;; ---------------------------------------------------------------------------
;;; (c) copyright 1997-2003 by Gilbert Baumann
@@ -435,8 +435,8 @@
(open-chunk-dy chunk))
)))
(when (eql pass 1)
- (clim:draw-text* clim-user::*medium* q x y))
- (incf x (clim:text-size clim-user::*medium* q))))
+ (clim:draw-text* clim-user::*pane* q x y))
+ (incf x (clim:text-size clim-user::*pane* q))))
(push dy ys)
(setf dy (open-chunk-dy chunk))
(push (bounding-chunk-style chunk) ss)
@@ -451,7 +451,7 @@
(let (p q res.text-seen-p)
(cond (link
(clim:with-output-as-presentation
- (clim-user::*medium*
+ (clim-user::*pane*
(url:unparse-url
(hyper-link-url (imap-area-link link)))
'clim-user::url
@@ -470,8 +470,8 @@
(chunk-debug-name q)
"")))
(when (eql pass 1)
- (clim:draw-text* clim-user::*medium* q x y))
- (incf x (clim:text-size clim-user::*medium* q))
+ (clim:draw-text* clim-user::*pane* q x y))
+ (incf x (clim:text-size clim-user::*pane* q))
)))
(pop ss)
@@ -483,7 +483,7 @@
;; replaced objects are different to dimensions of regular
;; inline boxen.
(cond (replaced-object-p
- (draw-box-decoration clim-user::*medium*
+ (draw-box-decoration clim-user::*pane*
x1 (- (+ y dy) (open-chunk-height oc)
(cooked-style-padding-top (bounding-chunk-style oc))
(- (cooked-style-padding-top (bounding-chunk-style oc)))
@@ -499,7 +499,7 @@
:right-halfp (not (bounding-chunk-halfp q))
))
(t
- (draw-box-decoration clim-user::*medium*
+ (draw-box-decoration clim-user::*pane*
x1 (- (+ y dy) (open-chunk-height oc)
(cooked-style-padding-top (bounding-chunk-style oc)))
x (+ (+ y dy) (open-chunk-depth oc)
@@ -528,7 +528,7 @@
(when (eql pass 1)
(setf (clim:medium-ink clim-user::*medium*)
(css-color-ink (cooked-style-color (black-chunk-style chunk))))
- (clim-draw-runes* clim-user::*medium*
+ (clim-draw-runes* clim-user::*pane*
x (+ dy y)
(black-chunk-data chunk)
0 (length (black-chunk-data chunk))
@@ -539,7 +539,7 @@
(let ((ro (replaced-object-chunk-object chunk)))
(when (eql pass 1)
(closure/clim-device::medium-draw-ro*
- clim-user::*medium*
+ clim-user::*pane*
ro x (+ dy y)))
(incf x (chunk-width chunk))) )))))
;;
@@ -1177,99 +1177,6 @@
(defvar *zzz* nil)
(defvar *dyn-elm* nil)
-#+emarsden2005-06-23
-(defun tata (mode)
- (let ((clim-user::*medium* (clim:find-pane-named clim-user::*frame* 'clim-user::canvas))
- (closure-protocol:*document-language*
- (make-instance 'r2::html-4.0-document-language))
- (closure-protocol:*user-agent* nil))
- (multiple-value-bind (x c)
- (ignore-errors
- ;; first find the chunk
- (let ((offender *dyn-elm*)
- (the-pb nil))
- (block suche
- (labels ((walk (x)
- (etypecase x
- (marker-box)
- (block-box
- (mapc #'walk (block-box-content x)))
- (para-box
- (mapc #'(lambda (z) (walk-chunk x z)) (para-box-items x)))))
- (walk-chunk (pb x)
- (etypecase x
- (floating-chunk)
- (bounding-chunk
- (setf (bounding-chunk-pt x) offender)
- #+NIL
- (when (eq (bounding-chunk-pt x) offender)
- '(cond ((eql mode :highlight)
- (setf (slot-value (bounding-chunk-style x) 'css::border-left-width) 1
- (slot-value (bounding-chunk-style x) 'css::border-left-style) :solid
- (slot-value (bounding-chunk-style x) 'css::border-right-width) 1
- (slot-value (bounding-chunk-style x) 'css::border-right-style) :solid
- (slot-value (bounding-chunk-style x) 'css::border-top-width) 1
- (slot-value (bounding-chunk-style x) 'css::border-top-style) :solid
- (slot-value (bounding-chunk-style x) 'css::border-bottom-width) 1
- (slot-value (bounding-chunk-style x) 'css::border-bottom-style) :solid))
- (t
- (setf (slot-value (bounding-chunk-style x) 'css::border-left-width) 0
- (slot-value (bounding-chunk-style x) 'css::border-left-style) :none
- (slot-value (bounding-chunk-style x) 'css::border-right-width) 0
- (slot-value (bounding-chunk-style x) 'css::border-right-style) :none
- (slot-value (bounding-chunk-style x) 'css::border-top-width) 0
- (slot-value (bounding-chunk-style x) 'css::border-top-style) :none
- (slot-value (bounding-chunk-style x) 'css::border-bottom-width) 0
- (slot-value (bounding-chunk-style x) 'css::border-bottom-style) :none)))
- '(setf (slot-value (bounding-chunk-style x) 'css::background-color)
- (if (eq mode :highlight)
- "#ccccff"
- :transparent))
- '(setf (slot-value (bounding-chunk-style x) 'css::text-decoration)
- (if (eq mode :highlight)
- (list :underline)
- :none))
- ))
- (kern-chunk)
- (disc-chunk
- (mapc #'(lambda (x) (walk-chunk pb x))
- (disc-chunk-here x))
- (mapc #'(lambda (x) (walk-chunk pb x))
- (disc-chunk-after x))
- (mapc #'(lambda (x) (walk-chunk pb x))
- (disc-chunk-before x)))
- (black-chunk
- '(setf (slot-value (black-chunk-style x) 'css::color)
- (if (eq mode :highlight)
- "#ff0000"
- "#000000"))
- )
- (replaced-object-chunk
- (when (typep (replaced-object-chunk-object x)
- 'lazy-image)
- (setf (replaced-object-chunk-object x)
- (replaced-element-p *document* *device* (replaced-object-chunk-element x)))
- (setf the-pb pb)
- (return-from suche nil))
- ))))
- (walk *zzz*)))
-
- (dprint "@@@@@@@ offender = ~S." offender)
- (dprint "@@@@@@@ the-pb = ~S." the-pb)
- (when the-pb
- (let (
- (papa (clim:output-record-parent (para-box-output-record the-pb))))
- (dprint "@@@@@@@ papa = ~S." papa)
- (clim:delete-output-record (para-box-output-record the-pb) papa)
- ;; now clim is so inherently broken ....
- (setf (para-box-output-record the-pb)
- (clim:with-new-output-record (clim-user::*pane*)
- (funcall (para-box-genesis the-pb)))))
- (tata mode))
- ))
- (when c
- (dprint "Error: ~A." c)))))
-
(defun format-block (item x1 x2 ss before-markers #||# pos-vertical-margin neg-vertical-margin yy)
(let (res)
(setf (block-box-output-record item)
@@ -1549,7 +1456,7 @@
(+ x2 pr) (- yy
(cooked-style-border-bottom-width s)
))
- (draw-box-decoration clim-user::*medium* x1 y1 x2 y2 block-style)
+ (draw-box-decoration clim-user::*pane* x1 y1 x2 y2 block-style)
(incf y1 (cooked-style-padding-top s))
(decf y2 (cooked-style-padding-bottom s))
(when (realp (cooked-style-height s))
@@ -1558,7 +1465,7 @@
(error "Fubar")))
#+NIL
(unless (or (= x1 x2) (= y1 y2))
- (clim:draw-rectangle* clim-user::*medium* x1 y1 x2 y2
+ (clim:draw-rectangle* clim-user::*pane* x1 y1 x2 y2
:ink clim:+red+
:filled nil))
)
@@ -2162,7 +2069,7 @@
(unless (or (= x1 (+ x1 w))
(= yyy yy))
#-NIL
- (clim:draw-rectangle* clim-user::*medium*
+ (clim:draw-rectangle* clim-user::*pane*
x1 yyy (+ x1 w) yy
:ink (elt *table-depth-color*
(mod *table-depth* (length *table-depth-color*)))
@@ -2272,7 +2179,7 @@
(let ((new-record
(clim:with-output-recording-options (clim-user::*pane* :record t :draw nil)
(clim:with-new-output-record (clim-user::*pane*)
- (draw-box-decoration clim-user::*medium* (+ x1 xx1) y1 (+ x1 xx2) y2
+ (draw-box-decoration clim-user::*pane* (+ x1 xx1) y1 (+ x1 xx2) y2
(block-box-style (table-cell-content cell)))))))
(clim:delete-output-record new-record (clim:output-record-parent new-record))
(clim:add-output-record new-record bg-record)))))))
@@ -2286,7 +2193,7 @@
(let ((new-record
(clim:with-output-recording-options (clim-user::*pane* :record t :draw nil)
(clim:with-new-output-record (clim-user::*pane*)
- (draw-box-decoration clim-user::*medium* x1 y1 x2 y2
+ (draw-box-decoration clim-user::*pane* x1 y1 x2 y2
(table-style table))))))
(clim:delete-output-record new-record (clim:output-record-parent new-record))
(clim:add-output-record new-record bg-record)))
@@ -2303,7 +2210,7 @@
(multiple-value-bind (x1 x2) (table-column-coordinates table column-widths j)
(let* (
(y1 (+ yy (loop for k below i sum (elt row-heights k)))))
- (clim:draw-line* clim-user::*medium*
+ (clim:draw-line* clim-user::*pane*
x1 y1 x2 y1
:ink (clim-user::parse-x11-color color)
:line-thickness width)))))))
@@ -2317,7 +2224,7 @@
(let* ((y1 (+ yy (loop for k below i sum (elt row-heights k))))
(y2 (+ y1 (elt row-heights i)))
(x1 (+ x1 (loop for k below j sum (elt column-widths k)))))
- (clim:draw-line* clim-user::*medium*
+ (clim:draw-line* clim-user::*pane*
x1 y1 x1 y2
:ink (clim-user::parse-x11-color color)
:line-thickness width)))))) )
@@ -5061,6 +4968,15 @@
;; $Log: renderer2.lisp,v $
+;; Revision 1.9 2005/07/11 15:57:56 crhodes
+;; Complete the renaming *MEDIUM* -> *PANE*.
+;;
+;; Panes are CLIM extended-streams, and remember output to them in output
+;; records. Mediums are much simpler, and don't have this kind of
+;; memory. So, though the same drawing functions (DRAW-TEXT, DRAW-LINE)
+;; can have the same initial effect applied to a pane and a medium, the
+;; output-record state is very different.
+;;
;; Revision 1.8 2005/07/10 11:18:35 emarsden
;; Distinguish between pane and medium in the CLIM GUI. This should
;; fix image display.
Index: closure/src/renderer/clim-draw.lisp
diff -u closure/src/renderer/clim-draw.lisp:1.3 closure/src/renderer/clim-draw.lisp:1.4
--- closure/src/renderer/clim-draw.lisp:1.3 Sun Mar 13 22:39:19 2005
+++ closure/src/renderer/clim-draw.lisp Mon Jul 11 17:57:56 2005
@@ -4,7 +4,7 @@
;;; Created: 2003-03-08
;;; Author: Gilbert Baumann <gilbert at base-engineering.com>
;;; License: MIT style (see below)
-;;; $Id: clim-draw.lisp,v 1.3 2005/03/13 21:39:19 emarsden Exp $
+;;; $Id: clim-draw.lisp,v 1.4 2005/07/11 15:57:56 crhodes Exp $
;;; ---------------------------------------------------------------------------
;;; (c) copyright 1997-2003 by Gilbert Baumann
@@ -171,14 +171,14 @@
(dolist (deco text-decoration)
(case deco
(:underline
- (clim:draw-line* clim-user::*medium*
+ (clim:draw-line* clim-user::*pane*
xx1 (+ yy 2) xx (+ yy 2) :ink (clim-user::parse-x11-color color)))
(:overline
;; xxx hack
- (clim:draw-line* clim-user::*medium*
+ (clim:draw-line* clim-user::*pane*
xx1 (- yy 12) xx (- yy 12) :ink (clim-user::parse-x11-color color)))
(:line-through
- (clim:draw-line* clim-user::*medium*
+ (clim:draw-line* clim-user::*pane*
xx1 (- yy 6) xx (- yy 6) :ink (clim-user::parse-x11-color color))) ))))
;;;; Runes
More information about the Closure-cvs
mailing list