[mcclim-cvs] CVS update: mcclim/incremental-redisplay.lisp

[Timothy Moore]

Update of /project/mcclim/cvsroot/mcclim
In directory common-lisp.net:/tmp/cvs-serv27570

Modified Files:
	incremental-redisplay.lisp 
Log Message:
Implement a generic output-record-hash which doesn't depend on the coordinates slot of standard-rectangle
Date: Tue Aug  9 22:30:13 2005
Author: tmoore

Index: mcclim/incremental-redisplay.lisp
diff -u mcclim/incremental-redisplay.lisp:1.48 mcclim/incremental-redisplay.lisp:1.49
--- mcclim/incremental-redisplay.lisp:1.48	Sun May  8 20:15:44 2005
+++ mcclim/incremental-redisplay.lisp	Tue Aug  9 22:30:12 2005
@@ -711,9 +711,41 @@
 (defvar *existing-output-records* nil)
 
 ;;;
+(defgeneric output-record-hash (record)
+  (:documentation "Produce a value that can be used to hash the output record
+in an equalp hash table"))
 
-(defmethod output-record-hash (record)
+(defmethod output-record-hash ((record basic-output-record))
   (slot-value record 'coordinates))
+
+(defconstant +fixnum-bits+ (integer-length most-positive-fixnum))
+
+(declaim (inline hash-coords))
+(defun hash-coords (x1 y1 x2 y2)
+  (declare (type real x1 y1 x2 y2))	;XXX Someday this should be float
+  (let ((hash-val 0))
+      (declare (type fixnum hash-val))
+      (labels ((rot4 (val)
+		 (dpb (ldb (byte 4 0) val)
+		      (byte 4 (- +fixnum-bits+ 4 1))
+		      (ash val -4)))
+	       (mix-it-in (val)
+	       (let ((xval (sxhash val)))
+		 (declare (type fixnum xval))
+		 (when (minusp val)
+		   (setq xval (rot4 xval)))
+		 (setq hash-val (logxor (rot4 hash-val) xval)))))
+	(declare (inline rot4 mix-it-in))
+	(mix-it-in x1)
+	(mix-it-in y1)
+	(mix-it-in x2)
+	(mix-it-in y2)
+	hash-val)))
+
+(defmethod output-record-hash ((record output-record))
+  (with-bounding-rectangle* (x1 y1 x2 y2)
+      record
+    (hash-coords x1 y1 x2 y2)))
 
 (defmethod compute-difference-set ((record standard-updating-output-record)
 				   &optional (check-overlapping t)