core: designs: make effective-transformation-design a no-op

There is no need for this indirection - compose transformations eagerly.

5 files changed, 20 insertions, 70 deletions

diff --git a/Backends/CLX/medium.lisp b/Backends/CLX/medium.lisp
index 2af7ace1..d5218238 100644
--- a/Backends/CLX/medium.lisp
+++ b/Backends/CLX/medium.lisp
@@ -345,8 +345,7 @@ translated, so they begin at different position than [0,0])."))
       (incf (xlib:gcontext-clip-y gc) gc-y)
       gc)))
 
-(defmethod medium-gcontext ((medium clx-medium) (ink clime:transformed-design)
-                            &aux (ink (clime:effective-transformed-design ink)))
+(defmethod medium-gcontext ((medium clx-medium) (ink clime:transformed-design))
   (with-bounding-rectangle* (x1 y1) ink
     (with-transformed-position ((medium-native-transformation medium) x1 y1)
       (let ((gc-x (round-coordinate x1))
@@ -436,8 +435,7 @@ translated, so they begin at different position than [0,0])."))
     pm))
 
 (defmethod design-gcontext ((medium clx-medium) (ink clime:pattern)
-                            &aux (ink* (climi::transformed-design-design
-                                        (clime:effective-transformed-design ink))))
+                            &aux (ink* (clime:transformed-design-design ink)))
   (let* ((drawable (clx-drawable medium))
          (rgba-pattern (climi::%collapse-pattern ink
                                                  0 0
diff --git a/Core/clim-basic/drawing/design.lisp b/Core/clim-basic/drawing/design.lisp
index 89f91dbc..9583baf5 100644
--- a/Core/clim-basic/drawing/design.lisp
+++ b/Core/clim-basic/drawing/design.lisp
@@ -69,13 +69,6 @@
 ;;;
 
 ;;;
-;;;   EFFECTIVE-TRANSFORMED-DESIGN design                             [function]
-;;;
-;;;      Returns a transformed design with all transformations collapsed into a
-;;;      single transformation and a source pattern. If resulting transformation
-;;;      is an identity then DESIGN is returned.
-;;;
-;;;
 ;;;   DESIGN-INK design x y                                           [method]
 ;;;
 ;;;      Returns ink at position X, Y. When DESIGN is not defined under the
@@ -428,7 +421,6 @@
 
 ;;;
 ;;; For patterns look in pattern.lisp
-
 ;;;
 
 (defclass transformed-design (design)
@@ -439,33 +431,6 @@
     :initarg :design
     :reader transformed-design-design)))
 
-;;; This may be cached in a transformed-design slot. -- jd 2018-09-24
-(defun effective-transformed-design (design &aux source-design)
-  "Merges all transformations along the way and returns a shallow, transformed
-design. If design is not transformed (or effective transformation is an
-identity-transformation) then source design is returned."
-  (check-type design design)
-  (labels ((effective-transformation (p)
-             (let ((design* (transformed-design-design p))
-                   (transformation (transformed-design-transformation p)))
-               (typecase design*
-                 (transformed-design
-                  (compose-transformations transformation
-                                           (effective-transformation design*)))
-                 (otherwise
-                  (setf source-design design*)
-                  transformation)))))
-    (typecase design
-      (transformed-design
-       (if (identity-transformation-p (transformed-design-transformation design))
-           (effective-transformed-design (transformed-design-design design))
-           (make-instance (type-of design)
-                          ;; Argument order matters: EFFECTIVE-TRANSFORMATION
-                          ;; sets the lexical variable SOURCE-DESIGN.
-                          :transformation (effective-transformation design)
-                          :design source-design)))
-      (otherwise design))))
-
 (defmethod transform-region :around (transformation (design design))
   (if (or (identity-transformation-p transformation)
           (typep design '(or color opacity uniform-compositum standard-flipping-ink indirect-ink)))
@@ -474,13 +439,11 @@ identity-transformation) then source design is returned."
 
 (defmethod transform-region (transformation (design design))
   (let ((old-transformation (transformed-design-transformation design)))
-    (if (and (translation-transformation-p transformation)
-             (translation-transformation-p old-transformation))
-        (make-instance 'transformed-design
-                       :design (transformed-design-design design)
-                       :transformation (compose-transformations old-transformation transformation))
-        (make-instance 'transformed-design :design design :transformation transformation))))
+    (make-instance 'transformed-design
+                   :design (transformed-design-design design)
+                   :transformation (compose-transformations old-transformation transformation))))
 
+(defun effective-transformed-design (design) design) ;obsolete
 (defmethod transformed-design-transformation ((design design)) +identity-transformation+)
 (defmethod transformed-design-design ((design design)) design)
 
diff --git a/Core/clim-basic/drawing/graphics.lisp b/Core/clim-basic/drawing/graphics.lisp
index fc1a3e42..95891bbb 100644
--- a/Core/clim-basic/drawing/graphics.lisp
+++ b/Core/clim-basic/drawing/graphics.lisp
@@ -910,9 +910,8 @@
 (defmethod draw-design (medium (pattern transformed-pattern)
                         &key clipping-region transformation &allow-other-keys)
   (flet ((draw-it ()
-           (let* ((effective-pattern (effective-transformed-design pattern))
-                  (pattern-tr (transformed-design-transformation effective-pattern))
-                  (pattern-ds (transformed-design-design effective-pattern))
+           (let* ((pattern-tr (transformed-design-transformation pattern))
+                  (pattern-ds (transformed-design-design pattern))
                   (ink-tr (compose-transformations (medium-transformation medium) pattern-tr))
                   (width (pattern-width pattern-ds))
                   (height (pattern-height pattern-ds))
@@ -935,18 +934,15 @@
              ;; should draw the full (untransformed) pattern at the transformed x/y
              ;; coordinates. This requires we revert to the identity transformation
              ;; before drawing the rectangle. -Hefner
-             (let* ((effective-pattern (effective-transformed-design pattern))
-                    ;; Effective design
-                    (effective-design  (transformed-design-design effective-pattern))
+             (let* (;; Effective design
+                    (effective-design  (transformed-design-design pattern))
                     (design-rectangle  (make-rectangle*
                                         0 0
                                         (pattern-width effective-design)
                                         (pattern-height effective-design)))
                     ;; Effective pattern transformation
-                    (pattern-transform (transformed-design-transformation
-                                        effective-pattern))
-                    (pattern-region    (transform-region
-                                        pattern-transform design-rectangle))
+                    (pattern-transform (transformed-design-transformation pattern))
+                    (pattern-region    (transform-region pattern-transform design-rectangle))
                     ;; Final transformation and region. Adjust for
                     ;; offsets introduced by PATTERN-TRANSFORM and
                     ;; axis flipping introduced by the medium
diff --git a/Core/clim-basic/drawing/pattern.lisp b/Core/clim-basic/drawing/pattern.lisp
index 75eb3afb..e5ac1a8b 100644
--- a/Core/clim-basic/drawing/pattern.lisp
+++ b/Core/clim-basic/drawing/pattern.lisp
@@ -288,9 +288,8 @@ Returns a pattern representing this file."
 
 ;;; This may be cached in a transformed-pattern slot. -- jd 2018-09-24
 (defmethod bounding-rectangle* ((pattern transformed-pattern))
-  (let* ((pattern* (effective-transformed-design pattern))
-         (source-pattern (transformed-design-design pattern*))
-         (transformation (transformed-design-transformation pattern*))
+  (let* ((source-pattern (transformed-design-design pattern))
+         (transformation (transformed-design-transformation pattern))
          (width (pattern-width source-pattern))
          (height (pattern-height source-pattern))
          (rectangle (make-rectangle* 0 0 width height)))
@@ -298,7 +297,6 @@ Returns a pattern representing this file."
 
 (defmethod pattern-width ((pattern transformed-pattern)
                           &aux
-                            (pattern (effective-transformed-design pattern))
                             (pattern* (transformed-design-design pattern))
                             (transformation (transformed-design-transformation pattern))
                             (width (pattern-width pattern*))
@@ -308,7 +306,6 @@ Returns a pattern representing this file."
 
 (defmethod pattern-height ((pattern transformed-pattern)
                            &aux
-                             (pattern (effective-transformed-design pattern))
                              (pattern* (transformed-design-design pattern))
                              (transformation (transformed-design-transformation pattern))
                              (width (pattern-width pattern*))
@@ -318,17 +315,13 @@ Returns a pattern representing this file."
 
 (defmethod transform-region (transformation (design pattern))
   (let ((old-transformation (transformed-design-transformation design)))
-    (if (and (translation-transformation-p transformation)
-             (translation-transformation-p old-transformation))
-        (make-instance 'transformed-pattern
-                       :design (transformed-design-design design)
-                       :transformation (compose-transformations old-transformation transformation))
-        (make-instance 'transformed-pattern :design design :transformation transformation))))
+    (make-instance 'transformed-pattern
+                   :design (transformed-design-design design)
+                   :transformation (compose-transformations old-transformation transformation))))
 
 (defmethod design-ink ((design transformed-design) x y)
-  (let* ((effective-pattern (effective-transformed-design design))
-         (source-pattern (transformed-design-design effective-pattern))
-         (transformation (transformed-design-transformation effective-pattern))
+  (let* ((source-pattern (transformed-design-design design))
+         (transformation (transformed-design-transformation design))
          (inv-tr (invert-transformation transformation)))
     (multiple-value-bind (x y) (transform-position inv-tr x y)
       ;; It is important to not use ROUND here, since when the fractional part
diff --git a/package.lisp b/package.lisp
index ad6fe39d..55ab3eb9 100644
--- a/package.lisp
+++ b/package.lisp
@@ -1969,7 +1969,7 @@
    #:rectangular-tile
    #:transformed-design
    #:transformed-pattern
-   #:effective-transformed-design
+   #:effective-transformed-design       ; obsolete
    #:rectangular-tile-design
    ;; readers
    #:pattern-array