[mcclim-cvs] CVS mcclim

[ahefner]

Update of /project/mcclim/cvsroot/mcclim
In directory clnet:/tmp/cvs-serv9791

Modified Files:
	design.lisp regions.lisp 
Log Message:
Plug holes in the design composition functions.



--- /project/mcclim/cvsroot/mcclim/design.lisp	2007/02/05 02:54:20	1.26
+++ /project/mcclim/cvsroot/mcclim/design.lisp	2008/01/14 07:03:15	1.27
@@ -47,6 +47,8 @@
 ;;
 ;; --GB
 
+;; I agree with this interpretation. -Hefner
+
 ;; It might be handy to have the equivalent of parent-relative
 ;; backgrounds. We can specify new indirect inks:
 ;;
@@ -283,13 +285,26 @@
 
 ||#
 
+;;;; Design <-> Region Equivalences
+
+;;; As Gilbert points in his notes, transparent ink is in every
+;;; respect interchangable with the nowhere region, and likewise
+;;; foreground ink is interchangable with the everywhere region.
+;;; By defining the following mixins and adding them to the
+;;; appropriate ink/region class pairs, we can reduce the number
+;;; of methods necessary. 
+
+(defclass everywhere-mixin () ())
+(defclass nowhere-mixin    () ()) 
 ;;;;
 ;;;; 13.6 Indirect Inks
 ;;;;
 
 (defclass indirect-ink (design) ())
 
-(defvar +foreground-ink+ (make-instance 'indirect-ink))
+(defclass %foreground-ink (indirect-ink everywhere-mixin) ())
+
+(defvar +foreground-ink+ (make-instance '%foreground-ink))
 (defvar +background-ink+ (make-instance 'indirect-ink))
 
 (defmethod print-object ((ink (eql +foreground-ink+)) stream)
@@ -313,15 +328,25 @@
           :type (real 0 1)
           :reader opacity-value)))
 
-(defvar +transparent-ink+ 
-    (make-instance 'standard-opacity :value 0))
+(defclass %transparent-ink (standard-opacity nowhere-mixin)
+  ()
+  (:default-initargs :value 0))
+
+(defvar +transparent-ink+
+  (make-instance '%transparent-ink :value 0))
+
+(defmethod opacity-value ((region everywhere-mixin))
+  (declare (ignore region))
+  1.0)
+
+(defmethod opacity-value ((region nowhere-mixin))
+  (declare (ignore region))
+  0.0)
 
 (defun make-opacity (value)
   (setf value (clamp value 0 1))        ;defensive programming
-  (cond ((= value 0)
-         +transparent-ink+)
-        ((= value 1)
-         +foreground-ink+)
+  (cond ((= value 0) +transparent-ink+)
+        ((= value 1) +everywhere+)      ; used to say +foreground-ink+
         (t
          (make-instance 'standard-opacity :value value))))
 
@@ -427,10 +452,6 @@
     :initarg :design
     :reader transformed-design-design)))
 
-#+NIL
-;; Commeted out because CLOS bites here. Ellipises will be transformed
-;; by this method. No idea why.
-;; --GB 2003-05-28
 (defmethod transform-region (transformation (design design))
   (make-instance 'transformed-design
                  :transformation transformation
@@ -456,34 +477,43 @@
 
 ;;;
 
-(defclass in-compositum (design)
+(defclass masked-compositum (design)
   ((ink  :initarg :ink  :reader compositum-ink)
    (mask :initarg :mask :reader compositum-mask)))
 
-(defmethod print-object ((object in-compositum) stream)
-  (print-unreadable-object (object stream :identity nil :type t)
+(defmethod print-object ((object masked-compositum) stream)
+  (print-unreadable-object (object stream :identity nil :type t)    
     (format stream "~S ~S ~S ~S"
-            :ink (compositum-ink object)
+            :ink  (compositum-ink object)
             :mask (compositum-mask object))))
 
-(defclass uniform-compositum (in-compositum)
-  ;; we use this class to represent rgbo values
-  ())
-
-(defclass over-compositum (design)
-  ((foreground :initarg :foreground :reader compositum-foreground)
-   (background :initarg :background :reader compositum-background)))
+(defclass in-compositum (masked-compositum) ())
 
 (defmethod compose-in ((ink design) (mask design))
   (make-instance 'in-compositum
     :ink ink
     :mask mask))
 
+(defclass out-compositum (masked-compositum) ())
+
+(defmethod compose-out ((ink design) (mask design))
+  (make-instance 'out-compositum
+    :ink ink
+    :mask mask))
+
+(defclass over-compositum (design)
+  ((foreground :initarg :foreground :reader compositum-foreground)
+   (background :initarg :background :reader compositum-background)))
+
 (defmethod compose-over ((foreground design) (background design))
   (make-instance 'over-compositum
     :foreground foreground
     :background background))
 
+(defclass uniform-compositum (in-compositum)
+  ;; we use this class to represent rgbo values
+  ())
+
 ;;;
 ;;; color
 ;;; opacity
@@ -542,6 +572,14 @@
 (defmethod compose-in ((ink color) (mask uniform-compositum))
   (make-uniform-compositum ink (opacity-value mask)))
 
+(defmethod compose-in ((design design) (mask everywhere-mixin))
+  (declare (ignore mask))
+  design)
+
+(defmethod compose-in ((design design) (mask nowhere-mixin))
+  (declare (ignore design mask))
+  +nowhere+)
+
 ;;; IN-COMPOSITUM
 
 ;; Since compose-in is associative, we can write it this way:
@@ -648,6 +686,29 @@
 
 ;;;; ------------------------------------------------------------------------------------------
 ;;;;
+;;;;  Compose-Out
+;;;;
+
+(defmethod compose-out ((design design) (mask everywhere-mixin))
+  (declare (ignore design mask))
+  +nowhere+)
+
+(defmethod compose-out ((design design) (mask nowhere-mixin))
+  (declare (ignore mask))
+  design)
+
+(defmethod compose-out ((design design) (mask color))
+  (declare (ignore design mask))
+  +nowhere+)
+
+(defmethod compose-out ((design design) (mask uniform-compositum))
+  (compose-in design (make-opacity (- 1.0 (compositum-mask (opacity-value mask))))))
+
+(defmethod compose-out ((design design) (mask standard-opacity))
+  (compose-in design (make-opacity (- 1.0 (opacity-value mask)))))
+
+;;;; ------------------------------------------------------------------------------------------
+;;;;
 ;;;;  Compose-Over
 ;;;;
 
@@ -702,7 +763,6 @@
   (multiple-value-bind (r g b o)
       (multiple-value-call #'color-blend-function
         (color-rgb foreground)
-        1
         (color-rgb (compositum-ink background))
         (opacity-value (compositum-mask background)))
     (make-uniform-compositum
--- /project/mcclim/cvsroot/mcclim/regions.lisp	2007/02/05 03:07:22	1.34
+++ /project/mcclim/cvsroot/mcclim/regions.lisp	2008/01/14 07:03:18	1.35
@@ -4,7 +4,7 @@
 ;;;   Created: 1998-12-02 19:26
 ;;;    Author: Gilbert Baumann <unk6 at rz.uni-karlsruhe.de>
 ;;;   License: LGPL (See file COPYING for details).
-;;;       $Id: regions.lisp,v 1.34 2007/02/05 03:07:22 ahefner Exp $
+;;;       $Id: regions.lisp,v 1.35 2008/01/14 07:03:18 ahefner Exp $
 ;;; --------------------------------------------------------------------------------------
 ;;;  (c) copyright 1998,1999,2001 by Gilbert Baumann
 ;;;  (c) copyright 2001 by Arnaud Rouanet (rouanet at emi.u-bordeaux.fr)
@@ -81,8 +81,8 @@
 
 (in-package :clim-internals)
 
-(defclass nowhere-region (region) ())
-(defclass everywhere-region (region) ())
+(defclass nowhere-region (region nowhere-mixin) ())
+(defclass everywhere-region (region everywhere-mixin) ())
 
 ;; coordinate is defined in coordinates.lisp