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))