[mcclim-cvs] CVS mcclim/Experimental/freetype

[ahefner]

Update of /project/mcclim/cvsroot/mcclim/Experimental/freetype
In directory clnet:/tmp/cvs-serv10002

Modified Files:
	freetype-fonts.lisp 
Log Message:
Simple implementation of ttf device fonts by their proper name (as 
opposed to filename), using fc-match.  'make-fontconfig-font-name'
creates such a font name, given a name, size, and list of options in the
syntax of fontconfig.



--- /project/mcclim/cvsroot/mcclim/Experimental/freetype/freetype-fonts.lisp	2008/01/17 07:57:55	1.19
+++ /project/mcclim/cvsroot/mcclim/Experimental/freetype/freetype-fonts.lisp	2008/01/17 09:54:21	1.20
@@ -411,15 +411,38 @@
 
 (defstruct freetype-device-font-name
   (font-file (error "missing argument"))
-  (size (error "missing argument")))
+  (size      (error "missing argument")))
 
-(defmethod clim-clx::text-style-to-X-font :around 
+(defstruct fontconfig-font-name
+  (string (error "missing argument"))
+  (size   (error "missing argument"))
+  (options nil)
+  (device-name nil))
+
+(defmethod clim-clx::text-style-to-X-font :around
     ((port clim-clx::clx-port) (text-style climi::device-font-text-style))
   (let ((display (slot-value port 'clim-clx::display))
         (font-name (climi::device-font-name text-style)))
-    (make-free-type-face display
-                         (freetype-device-font-name-font-file font-name)
-                         (freetype-device-font-name-size font-name))))
+    (typecase font-name
+      (freetype-device-font-name
+       (make-free-type-face display
+                            (namestring (freetype-device-font-name-font-file font-name))
+                            (freetype-device-font-name-size font-name)))
+      (fontconfig-font-name        
+       (clim-clx::text-style-to-X-font
+        port
+        (or (fontconfig-font-name-device-name font-name)
+            (setf (fontconfig-font-name-device-name font-name)
+                  (make-device-font-text-style
+                   port
+                   (make-freetype-device-font-name 
+                    :font-file (find-bitstream-font
+                                (format nil "~A-~A~{:~A~}"
+                                        (namestring (fontconfig-font-name-string font-name))
+                                        (fontconfig-font-name-size font-name)
+                                        (fontconfig-font-name-options font-name)))
+                    :size (fontconfig-font-name-size font-name))))))))))
+
 
 (defmethod text-style-mapping :around
     ((port clim-clx::clx-port) (text-style climi::device-font-text-style)