[cello-cvs] CVS cello/cl-ftgl

[ktilton]

Update of /project/cello/cvsroot/cello/cl-ftgl
In directory clnet:/tmp/cvs-serv15578/cl-ftgl

Modified Files:
	cl-ftgl.lisp cl-ftgl.lpr 
Log Message:
Ongoing merge with Celtk

--- /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp	2006/06/03 12:05:55	1.3
+++ /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp	2006/06/26 17:05:21	1.4
@@ -20,7 +20,7 @@
 ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS 
 ;;; IN THE SOFTWARE.
 
-;;; $Header: /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp,v 1.3 2006/06/03 12:05:55 ktilton Exp $
+;;; $Header: /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp,v 1.4 2006/06/26 17:05:21 ktilton Exp $
 
 (defpackage #:cl-ftgl
   (:nicknames #:ftgl)
@@ -33,8 +33,10 @@
     #:ftgl-extruded 
     #:ftgl-outline
     #:ftgl-string-length 
+    #:ftgl-char-width
     #:ftgl-get-ascender 
     #:ftgl-get-descender
+    #:ftgl-height
     #:ftgl-make 
     #:cl-ftgl-init 
     #:cl-ftgl-reset 
@@ -160,17 +162,25 @@
              (:polygon 'make-ftgl-polygon)
              (:extruded 'make-ftgl-extruded))
     :face face
-    :size size
+    :size (floor size) 
     :target-res target-res
     :depth depth))
+    
 
 ;; --------- ftgl structure -----------------
 
 (defstruct ftgl
   face size target-res depth
-  descender ascender bboxes
+  descender ascender 
+  (widths (make-array 256))
+  ft-metrics
   ifont)
 
+(defun ftgl-char-width (f c)
+  (or (aref (ftgl-widths f) (char-code c))
+    (setf (aref (ftgl-widths f) (char-code c))
+      (ftgl-string-length f (string c)))))
+
 (defstruct (ftgl-disp (:include ftgl))
   ready-p)
 
@@ -204,6 +214,9 @@
       (ff:unload-foreign-library dll)
       (cl-ftgl-reset))))
 
+#+doit
+(xftgl)
+
 (defun ftgl-get-ascender (font)
   (or (ftgl-ascender font)
     (setf (ftgl-ascender font)
@@ -214,6 +227,10 @@
     (setf (ftgl-descender font)
         (fgc-descender (ftgl-get-metrics-font font)))))
 
+(defun ftgl-height (f)
+  (+ (ftgl-get-ascender f)
+    (ftgl-get-descender f)))
+
 (defun ftgl-get-display-font (font)
   (let ((cf (ftgl-get-metrics-font font)))
     (assert cf)
@@ -297,9 +314,6 @@
 (defun ftgl-string-length (font cs)
   (fgc-string-advance (ftgl-get-metrics-font font) cs))
 
-(defmethod font-bearing-x ((font ftgl) &optional (text "m"))
-  (fgc-string-x (ftgl-get-metrics-font font) text))
-
 (defmethod font-bearing-x (font &optional text)
   (declare (ignorable font text))
   0)
--- /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lpr	2006/05/26 22:08:55	1.4
+++ /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lpr	2006/06/26 17:05:21	1.5
@@ -1,4 +1,4 @@
-;; -*- lisp-version: "8.0 [Windows] (May 22, 2006 0:51)"; cg: "1.81"; -*-
+;; -*- lisp-version: "8.0 [Windows] (Jun 21, 2006 9:54)"; cg: "1.81"; -*-
 
 (in-package :cg-user)
 
@@ -7,7 +7,9 @@
 (define-project :name :cl-ftgl
   :modules (list (make-instance 'module :name "cl-ftgl.lisp"))
   :projects (list (make-instance 'project-module :name
-                                 "C:\\1-devtools\\cffi\\cffi"))
+                                 "C:\\1-devtools\\cffi\\cffi")
+                  (make-instance 'project-module :name
+                                 "..\\cl-freetype\\cl-freetype"))
   :libraries nil
   :distributed-files nil
   :internally-loaded-files nil