[mcclim-cvs] CVS update: mcclim/Experimental/freetype/freetype-fonts.lisp mcclim/Experimental/freetype/mcclim-freetype.asd

[Brian Mastenbrook]

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

Modified Files:
	freetype-fonts.lisp mcclim-freetype.asd 
Log Message:
Cache another routine that gets called alot; remove dependency on this xrender implementation

Date: Sat Jun 18 03:56:44 2005
Author: bmastenbrook

Index: mcclim/Experimental/freetype/freetype-fonts.lisp
diff -u mcclim/Experimental/freetype/freetype-fonts.lisp:1.6 mcclim/Experimental/freetype/freetype-fonts.lisp:1.7
--- mcclim/Experimental/freetype/freetype-fonts.lisp:1.6	Wed Jun 15 03:34:06 2005
+++ mcclim/Experimental/freetype/freetype-fonts.lisp	Sat Jun 18 03:56:43 2005
@@ -290,20 +290,25 @@
 
 (fmakunbound 'clim-clx::text-style-to-x-font)
 
+(defparameter *free-type-face-hash* (make-hash-table :test #'equal))
+
 (defmethod clim-clx::text-style-to-X-font :around ((port clim-clx::clx-port) text-style)
   (multiple-value-bind (family face size) (clim:text-style-components text-style)
     (setf face (or face :roman))
     (setf size (or size :normal))
     (cond (size
            (setf size (getf *sizes* size size))
-           (let* ((font-path-relative (cdr (assoc (list family face) *families/faces*
-                                                  :test #'equal)))
-                  (font-path (namestring (merge-pathnames font-path-relative *freetype-font-path*))))
-             (if (and font-path (probe-file font-path))
-                 (make-free-type-face (slot-value port 'clim-clx::display)
-                                      font-path
-                                      size)
-                 (call-next-method))))
+           (let ((val (gethash (list family face size) *free-type-face-hash*)))
+             (if val val
+                 (setf (gethash (list family face size) *free-type-face-hash*)
+                       (let* ((font-path-relative (cdr (assoc (list family face) *families/faces*
+                                                              :test #'equal)))
+                              (font-path (namestring (merge-pathnames font-path-relative *freetype-font-path*))))
+                         (if (and font-path (probe-file font-path))
+                             (make-free-type-face (slot-value port 'clim-clx::display)
+                                                  font-path
+                                                  size)
+                             (call-next-method)))))))
           (t
            (call-next-method)))))
 


Index: mcclim/Experimental/freetype/mcclim-freetype.asd
diff -u mcclim/Experimental/freetype/mcclim-freetype.asd:1.1 mcclim/Experimental/freetype/mcclim-freetype.asd:1.2
--- mcclim/Experimental/freetype/mcclim-freetype.asd:1.1	Sun Jun  5 22:50:29 2005
+++ mcclim/Experimental/freetype/mcclim-freetype.asd	Sat Jun 18 03:56:43 2005
@@ -12,7 +12,7 @@
   (list (component-pathname c)))
 
 (defsystem :mcclim-freetype
-  :depends-on (:xrender :clim :clx)
+  :depends-on (:clim :clx)
   :serial t
   :components
   ((:file "freetype-package")