[cells-cvs] CVS update: cell-cultures/cl-ftgl/cl-ftgl.lisp

[Kenny Tilton]

Update of /project/cells/cvsroot/cell-cultures/cl-ftgl
In directory common-lisp.net:/tmp/cvs-serv27567/cl-ftgl

Modified Files:
	cl-ftgl.lisp 
Log Message:
Re-port to Lispworks/win32
Date: Thu Oct 28 02:09:20 2004
Author: ktilton

Index: cell-cultures/cl-ftgl/cl-ftgl.lisp
diff -u cell-cultures/cl-ftgl/cl-ftgl.lisp:1.4 cell-cultures/cl-ftgl/cl-ftgl.lisp:1.5
--- cell-cultures/cl-ftgl/cl-ftgl.lisp:1.4	Fri Oct  1 06:01:12 2004
+++ cell-cultures/cl-ftgl/cl-ftgl.lisp	Thu Oct 28 02:09:16 2004
@@ -20,7 +20,7 @@
 ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS 
 ;;; IN THE SOFTWARE.
 
-;;; $Header: /project/cells/cvsroot/cell-cultures/cl-ftgl/cl-ftgl.lisp,v 1.4 2004/10/01 04:01:12 ktilton Exp $
+;;; $Header: /project/cells/cvsroot/cell-cultures/cl-ftgl/cl-ftgl.lisp,v 1.5 2004/10/28 00:09:16 ktilton Exp $
 
 (defpackage #:cl-ftgl
   (:nicknames #:ftgl)
@@ -41,6 +41,7 @@
     #:xftgl 
     #:ftgl-render
     #:ftgl-font-ensure
+    #:ftgl-ensure-ifont
     #:cl-ftgl-set-home-dir
     #:cl-ftgl-get-home-dir
     #:cl-ftgl-set-dll-filename
@@ -62,8 +63,8 @@
 (defparameter *gui-style-button-face* :unconfigured)
 
 (eval-when (compile load eval)
-  (load (merge-pathnames "cl-ftgl-config.lisp"
-          cl-user::*cello-config-directory*)))
+  (load (merge-pathnames "cl-ftgl-config"
+          cl-user::*cell-cultures-config*)))
 
 ;; ----------------------------------------------------------------------------
 ;; EXTERNAL DEPENDENCIES
@@ -427,36 +428,14 @@
 (defun ftgl-get-ascender (font)
   (or (ftgl-ascender font)
     (setf (ftgl-ascender font)
-        (fgc-ascender (ftgl-get-metrics-font font)))))
+        (fgc-ascender (ftgl-ensure-ifont font)))))
 
 (defun ftgl-get-descender (font)
   (or (ftgl-descender font)
     (setf (ftgl-descender font)
-        (fgc-descender (ftgl-get-metrics-font font)))))
+        (fgc-descender (ftgl-ensure-ifont font)))))
 
-(defun ftgl-get-display-font (font)
-  (let ((cf (ftgl-get-metrics-font font)))
-    (assert cf)
-    (ukt::trc nil "FTGL-GET-DISPLAY-FONT sees" (ftgl-disp-ready-p font))
-    (unless (ftgl-disp-ready-p font)
-      (when *ogl-listing-p*
-        (cells::c-break "bad time #1 for sizing? ~a ~a" *ogl-listing-p* font))
-      (setf (ftgl-disp-ready-p font) t)
-      (typecase font
-        (ftgl-extruded
-         #+nyet (let ((*ogl-listing-p* t))
-           (ukt::trc nil "ftgl-get-display-font> building glyphs for" font)
-           
-           (fgc-build-glyphs cf)
-           (ukt::trc nil "ftgl-get-display-font> glyphs built OK for" font)))
-        (ftgl-texture
-         #+no (fgc-set-face-size cf (ftgl-size font) (ftgl-target-res font)))
-        (ftgl-pixmap
-         #+no (fgc-set-face-size cf (ftgl-size font) (ftgl-target-res font))))
-      )
-    cf))
-
-(defun ftgl-get-metrics-font (font)
+(defun ftgl-ensure-ifont (font)
   (or (ftgl-ifont font)
     (setf (ftgl-ifont font) (ftgl-font-make font))))
 
@@ -477,9 +456,8 @@
       (error "Font not found: ~a" path))))
 
 (defun ftgl-render (font s)
-  (let ((df (ftgl-get-display-font font)))
-    (uffi:with-cstring (cs s)
-      (fgc-render df cs))))
+  (uffi:with-cstring (cs s)
+      (fgc-render (ftgl-ensure-ifont font) cs)))
 
 (defmethod fgc-font-make :before (font fpath)
   (declare (ignore font fpath))
@@ -506,11 +484,11 @@
   (fgc-polygon-make fpath))
 
 (defun ftgl-string-length (font cs)
-  (fgc-string-advance (ftgl-get-metrics-font font) cs))
+  (fgc-string-advance (ftgl-ensure-ifont font) cs))
 
 (defmethod font-bearing-x ((font ftgl) &optional (text "m"))
   (uffi:with-cstring (cs text)
-    (fgc-string-x (ftgl-get-metrics-font font) cs)))
+    (fgc-string-x (ftgl-ensure-ifont font) cs)))
 
 (defmethod font-bearing-x (font &optional text)
   (declare (ignorable font text))