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