[cello-cvs] CVS cello/cl-ftgl

[ktilton]

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

Modified Files:
	cl-ftgl.lisp 
Log Message:
nothing special

--- /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp	2008/04/11 09:22:58	1.18
+++ /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp	2008/06/16 12:39:26	1.19
@@ -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.18 2008/04/11 09:22:58 ktilton Exp $
+;;; $Header: /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp,v 1.19 2008/06/16 12:39:26 ktilton Exp $
 
 (eval-when (:compile-toplevel :load-toplevel)
   (pushnew :cl-ftgl *features*))
@@ -83,32 +83,47 @@
 (defparameter *ftgl-ogl* nil)
 
 (defparameter *ftgl-font-dirs* nil)
+(defparameter *ftgl-application-font-paths* nil)
+
+(export! ftgl-application-font-paths)
+
+(defun ftgl-application-font-paths ()
+  (assert (loop for p in *ftgl-application-font-paths*
+                always (probe-file p)))
+  *ftgl-application-font-paths*)
+
+(defun (setf ftgl-application-font-paths) (paths)
+  (setf *ftgl-application-font-paths* paths))
 
 (defun ftgl-font-directories ()
   (or *ftgl-font-dirs*
     (setf *ftgl-font-dirs*
       #+cffi-features:windows
-      (list (font-path)
+      (append (ftgl-application-font-paths)
+        (list (make-pathname
+               :directory
+               '(:absolute "Windows" "fonts"))))
+      #+cffi-features:darwin
+      (append 
+       (ftgl-application-font-paths)
+       (list
         (make-pathname
          :directory
-         '(:absolute "Windows" "fonts")))
-      #+cffi-features:darwin
-      (list
-       (make-pathname
-        :directory
-        '(:absolute "System" "Library" "Fonts"))
-       (make-pathname
-        :directory
-        '(:absolute "Library" "Fonts"))
-       (make-pathname
-        :directory
-        '(:relative "~" "Library" "Fonts")))
+         '(:absolute "System" "Library" "Fonts"))
+        (make-pathname
+         :directory
+         '(:absolute "Library" "Fonts"))
+        (make-pathname
+         :directory
+         '(:relative "~" "Library" "Fonts"))))
             
       #+(and cffi-features:unix (not cffi-features:darwin))
-      (list
-       (make-pathname
-        :directory
-        '(:absolute "usr" "share" "truetype"))))))
+      (append 
+       (ftgl-application-font-paths)
+       (list
+        (make-pathname
+         :directory
+         '(:absolute "usr" "share" "truetype")))))))
 
 (defparameter *ftgl-font-types-list* ;; list of font types
   ;; (font filename endings)
@@ -213,14 +228,14 @@
 (defmacro dbgftgl (tag &body body)
   (declare (ignorable tag))
   `(progn
-     #+nahhh (unless (boundp '*gl-begun*)
+     #+nahhh (unless (boundp 'ogl::*gl-begun*)
        (assert (zerop (glgeterror))))
      (progn ;; cells:wtrc (0 100 "dbgftgl" ,tag)
        (ftgl-assert-opengl-context)
-       (unless (boundp '*gl-begun*) (glec :dbgftgl-entry))
+       (unless (boundp 'ogl::*gl-begun*) (glec :dbgftgl-entry))
        (prog1
            (progn , at body)
-         (unless (boundp '*gl-begun*)
+         (unless (boundp 'ogl::*gl-begun*)
            (progn
              (glec :dbgftgl-post-body)))))))
 
@@ -447,6 +462,10 @@
   (declare (ignorable s))
   (dbgfont font :ftgl-render-before)
   
+     (if (boundp 'ogl::*gl-begun*)
+       (break "gl begun OK?" font)
+       (trc nil "cool" s))
+
   (dbgftgl :ftgl-render
     (gl-enable gl_texture_2d)
     (gl-enable gl_blend)