cello-cvs August 2006

cello-cvs@common-lisp.net

2 participants
51 discussions

[cello-cvs] CVS cello/kt-opengl
by fgoenninger 28 Aug '06

28 Aug '06

Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv20733 Modified Files: kt-opengl.lisp Log Message: Changed: Use CFFI scheme to define and use foreign libs. --- /project/cello/cvsroot/cello/kt-opengl/kt-opengl.lisp 2006/08/25 08:39:26 1.4 +++ /project/cello/cvsroot/cello/kt-opengl/kt-opengl.lisp 2006/08/28 18:38:03 1.5 @@ -21,7 +21,7 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. -;;; $Id: kt-opengl.lisp,v 1.4 2006/08/25 08:39:26 fgoenninger Exp $ +;;; $Id: kt-opengl.lisp,v 1.5 2006/08/28 18:38:03 fgoenninger Exp $ (pushnew :kt-opengl *features*) @@ -80,21 +80,22 @@ (defvar *selecting*) -(defparameter *gl-dynamic-lib* - (make-pathname - ;;#+lispworks :host #-lispworks :device "c" - :directory '(:absolute "windows" "system32") - :name "opengl32" - :type "dll")) - -(defparameter *glu-dynamic-lib* - (make-pathname - ;;#+lispworks :host #-lispworks :device "c" - :directory '(:absolute "windows" "system32") - :name "glu32" - :type "dll")) - -(defparameter *glut-dynamic-lib* :unconfigured) +(define-foreign-library OpenGL + (:windows (:or (namestring + (make-pathname + ;;#+lispworks :host #-lispworks :device "c" + :directory '(:absolute "windows" "system32") + :name "opengl32" + :type "dll")))) + (:darwin (:or (:framework "OpenGL")))) + +(define-foreign-library GLU + (:windows (:or (namestring + (make-pathname + ;;#+lispworks :host #-lispworks :device "c" + :directory '(:absolute "windows" "system32") + :name "opengl32" + :type "dll"))))) (defparameter *opengl-dll* nil)

1 0

[cello-cvs] CVS cello/kt-opengl
by fgoenninger 28 Aug '06

28 Aug '06

Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv20456 Modified Files: ogl-macros.lisp Log Message: Changed: Now using CFFI scheme for defining and using foreign libs. --- /project/cello/cvsroot/cello/kt-opengl/ogl-macros.lisp 2006/08/21 04:28:29 1.6 +++ /project/cello/cvsroot/cello/kt-opengl/ogl-macros.lisp 2006/08/28 18:37:22 1.7 @@ -33,7 +33,6 @@ (defmacro with-matrix ((&optional load-identity-p) &body body) `(call-with-matrix ,load-identity-p (lambda () ,@body) ',body)) - (defun call-with-matrix (load-identity-p matrix-fn matrix-code) (declare (ignorable matrix-code)) (gl-push-matrix) @@ -98,6 +97,7 @@ (defvar *gl-begun*) (defvar *gl-stop*) + (defmacro with-gl-begun ((what) &body body) `(progn (when (boundp '*gl-begun*) @@ -123,24 +123,19 @@ (gl-translatef (- ,dx)(- ,dy)(- ,dz)))))) (defun kt-opengl-init () - (declare (ignorable load-oglfont-p)) (unless *opengl-dll* - #-mcl (progn - (print "loading open GL/GLU") - (cffi-uffi-compat:load-foreign-library - *gl-dynamic-lib* - :module "open-gl")) - #+mcl - (format t "~&We're on Darwin, so we do not load the OpenGL dynlib explicitely~%.") - #-mcl - (setf *opengl-dll* (cffi-uffi-compat:load-foreign-library *glu-dynamic-lib* - :module "gl-util")) - #+mcl - (setf *opengl-dll* t) - )) + (let ((opengl-loaded-p + (use-foreign-library OpenGL)) + (glu-loaded-p + #+macosx + t ;; on Mac OS X, no explicit loading of GLU needed. + #-macosx + (use-foreign-library GLU))) + (assert (and opengl-loaded-p glu-loaded-p)) + (setf *opengl-dll* t))))) -(eval-when (load eval) +(eval-when (:load-toplevel :execute) (kt-opengl-init)) (defun glec (&optional (id :anon))

1 0

[cello-cvs] CVS cello/kt-opengl
by fgoenninger 28 Aug '06

28 Aug '06

Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv20116 Modified Files: ogl-utils.lisp Log Message: Added: Id for CVS info Changed: Done some code "beautifying" for myself being able to understand this better... --- /project/cello/cvsroot/cello/kt-opengl/ogl-utils.lisp 2006/08/24 17:35:08 1.5 +++ /project/cello/cvsroot/cello/kt-opengl/ogl-utils.lisp 2006/08/28 18:36:40 1.6 @@ -22,17 +22,16 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. - +;;; $Id: ogl-utils.lisp,v 1.6 2006/08/28 18:36:40 fgoenninger Exp $ (in-package :kt-opengl) (defun ogl-tex-activate (tex-name) (assert tex-name) ;;(print `(ogl-tex-activate doing ,tex-name)) - (gl-bind-texture gl_texture_2d tex-name) (gl-enable gl_texture_2d) - (gl-polygon-mode gl_front_and_back gl_fill) ;; just front? - ) + (gl-bind-texture gl_texture_2d tex-name) + (gl-polygon-mode gl_front_and_back gl_fill)) ;; just front ? (defparameter *textures-1* (fgn-alloc 'gluint 1 :ignore)) @@ -47,9 +46,15 @@ (glec :ogl-texture-gen) (ff-elt *textures-1* gluint 0)) -(let (gl-s-plane gl-t-plane gl-r-plane gl-q-plane) +(let ((gl-s-plane nil) + (gl-t-plane nil) + (gl-r-plane nil) + (gl-q-plane nil)) + (defun ogl-tex-gen-setup (mode tex-env tex-wrap scale &rest planes) - ;;(trc nil "ogl-tex-gen-setup:" mode tex-env tex-wrap scale planes) + + ;;(trc "ogl-tex-gen-setup:" mode tex-env tex-wrap scale planes) + (gl-tex-envf gl_texture_env gl_texture_env_mode tex-env) (gl-tex-parameterf gl_texture_2d gl_texture_min_filter gl_linear ) (gl-tex-parameterf gl_texture_2d gl_texture_mag_filter gl_linear ) @@ -58,23 +63,23 @@ (gl-tex-parameteri gl_texture_2d gl_texture_wrap_t tex-wrap) ;-- (loop for plane in planes - do (ecase plane - (:s (gl-tex-geni gl_s gl_texture_gen_mode mode) - (gl-tex-genfv gl_s gl_object_plane - (ff-floatv-ensure gl-s-plane scale 0 0 0)) - (gl-enable gl_texture_gen_s)) - (:tee (gl-tex-geni gl_t gl_texture_gen_mode mode) - (gl-tex-genfv gl_t gl_object_plane - (ff-floatv-ensure gl-t-plane 0 scale 0 0)) - (gl-enable gl_texture_gen_t)) - (:r (gl-tex-geni gl_r gl_texture_gen_mode mode) - (gl-tex-genfv gl_r gl_object_plane - (ff-floatv-ensure gl-r-plane 0 0 scale 0)) - (gl-enable gl_texture_gen_r)) - (:q (gl-tex-geni gl_q gl_texture_gen_mode mode) - (gl-tex-genfv gl_q gl_object_plane - (ff-floatv-ensure gl-q-plane 0 0 scale 0)) - (gl-enable gl_texture_gen_q)))))) + do (ecase plane + (:s (gl-tex-geni gl_s gl_texture_gen_mode mode) + (gl-tex-genfv gl_s gl_object_plane + (ff-floatv-ensure gl-s-plane scale 0 0 0)) + (gl-enable gl_texture_gen_s)) + (:tee (gl-tex-geni gl_t gl_texture_gen_mode mode) + (gl-tex-genfv gl_t gl_object_plane + (ff-floatv-ensure gl-t-plane 0 scale 0 0)) + (gl-enable gl_texture_gen_t)) + (:r (gl-tex-geni gl_r gl_texture_gen_mode mode) + (gl-tex-genfv gl_r gl_object_plane + (ff-floatv-ensure gl-r-plane 0 0 scale 0)) + (gl-enable gl_texture_gen_r)) + (:q (gl-tex-geni gl_q gl_texture_gen_mode mode) + (gl-tex-genfv gl_q gl_object_plane + (ff-floatv-ensure gl-q-plane 0 0 scale 0)) + (gl-enable gl_texture_gen_q)))))) (defun ogl-scissor-box () (let ((box (fgn-alloc 'glint 4 :scissor)))

1 0

[cello-cvs] CVS cello/cl-magick
by fgoenninger 26 Aug '06

26 Aug '06

Update of /project/cello/cvsroot/cello/cl-magick In directory clnet:/tmp/cvs-serv28823 Modified Files: cl-magick.lisp Log Message: Changed: Loading of dynamic libs now safe also on OS X. --- /project/cello/cvsroot/cello/cl-magick/cl-magick.lisp 2006/08/23 21:10:31 1.8 +++ /project/cello/cvsroot/cello/cl-magick/cl-magick.lisp 2006/08/26 21:46:21 1.9 @@ -20,12 +20,7 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. -#+asdf -(eval-when (:load-toplevel :compile-toplevel) - (asdf:operate 'asdf:load-op 'cffi) - (asdf:operate 'asdf:load-op 'cffi-extender) - (asdf:operate 'asdf:load-op 'kt-opengl) - (asdf:operate 'asdf:load-op 'gui-geometry)) +;;; $Id: cl-magick.lisp,v 1.9 2006/08/26 21:46:21 fgoenninger Exp $ (defpackage :cl-magick (:nicknames :mgk) @@ -64,9 +59,9 @@ (path-to-wand (or *wand-template* (make-pathname - :directory '(:absolute "0dev" "user" - "graphics" "templates") - :name "metal" :type "gif")))) +#-macosx :directory '(:absolute "0dev" "user" "graphics" "templates") +#+macosx :directory '(:absolute "Users" "frgo" "Pictures") + :name "metal003" :type "gif")))) (defparameter *imagick-dll-loaded* nil) (defparameter *wands-loaded* nil) @@ -81,15 +76,6 @@ (cffi:define-foreign-library Wand (:darwin (:or "/usr/local/lib/libWand.dylib"))) -;; Order matters! First, load Wand then Magick on Darwin -#+macosx -(eval-when (:load-toplevel :execute) - (cffi:use-foreign-library Wand)) - -(eval-when (:load-toplevel :execute) - (cffi:use-foreign-library Magick)) - - ;------------------------------------------------------------------- (defun cl-magick-init () @@ -97,9 +83,13 @@ (progn ;(print "clearing magick wands") ;(wands-clear) + + ;; Order matters! First, load Wand then Magick on Darwin + #+macosx + (cffi:use-foreign-library Wand) - (assert (setq *imagick-dll-loaded* t - #+not (cffi:use-foreign-library magick)) + (assert (setq *imagick-dll-loaded* + (cffi:use-foreign-library Magick)) () "Unable to load imagick" ) (print `(magick-copyright ,(magick-get-copyright))) (print `(magick-version ,(magick-get-version *mgk-version*))) @@ -142,4 +132,3 @@ (print `(unloading foreign library ,dll)) (setf *imagick-dll-loaded* nil) (ff:unload-foreign-library dll)))) -

1 0

[cello-cvs] CVS cello/cl-magick
by fgoenninger 26 Aug '06

26 Aug '06

Update of /project/cello/cvsroot/cello/cl-magick In directory clnet:/tmp/cvs-serv28788 Modified Files: cl-magick.asd Log Message: Changed: Depends-on extended. Now loads dependencies also. --- /project/cello/cvsroot/cello/cl-magick/cl-magick.asd 2006/07/06 22:09:11 1.2 +++ /project/cello/cvsroot/cello/cl-magick/cl-magick.asd 2006/08/26 21:45:22 1.3 @@ -16,12 +16,12 @@ :licence "MIT" :description "Bindings for ImageMagick" :long-description "Poorly implemented bindings to half of ImageMagick" - :depends-on (gui-geometry) + :depends-on (:cffi :cffi-extender :utils-kt :gui-geometry :kt-opengl) :components ((:file "cl-magick") - (:file "magick-wand" :depends-on ("cl-magick")) + (:file "magick-wand" :depends-on ("cl-magick")) (:file "drawing-wand" :depends-on ("magick-wand")) - (:file "pixel-wand" :depends-on ("drawing-wand")) - (:file "mgk-utils" :depends-on ("pixel-wand")) - (:file "wand-image" :depends-on ("mgk-utils")) + (:file "pixel-wand" :depends-on ("drawing-wand")) + (:file "mgk-utils" :depends-on ("pixel-wand")) + (:file "wand-image" :depends-on ("mgk-utils")) (:file "wand-texture" :depends-on ("wand-image")) - (:file "wand-pixels" :depends-on ("wand-texture")))) + (:file "wand-pixels" :depends-on ("wand-texture"))))

1 0

[cello-cvs] CVS cello
by fgoenninger 26 Aug '06

26 Aug '06

Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv27147 Modified Files: cello.lisp Log Message: Added: Export #:cello-window --- /project/cello/cvsroot/cello/cello.lisp 2006/08/25 08:31:57 1.10 +++ /project/cello/cvsroot/cello/cello.lisp 2006/08/26 21:44:03 1.11 @@ -14,7 +14,7 @@ |# -;;; $Id: cello.lisp,v 1.10 2006/08/25 08:31:57 fgoenninger Exp $ +;;; $Id: cello.lisp,v 1.11 2006/08/26 21:44:03 fgoenninger Exp $ ;;; ============================================================================ ;;; PACKAGE DEFINITION @@ -23,19 +23,24 @@ (defpackage :cello (:nicknames :clo) (:use - #:common-lisp - #-(or ccl cormanlisp sbcl) #:clos - #:utils-kt - #:cells - #:gui-geometry - #:cffi - #:cffi-extender - #:celtk - #:kt-opengl - #:cl-openal - #:cl-ftgl - #:cl-magick) - (:export #:cello-window-event-handler #:with-layers #:visible #:ix-togl)) + #:common-lisp + #-(or ccl cormanlisp sbcl) #:clos + #:utils-kt + #:cells + #:gui-geometry + #:cffi + #:cffi-extender + #:celtk + #:kt-opengl + #:cl-openal + #:cl-ftgl + #:cl-magick) + (:export + #:cello-window + #:cello-window-event-handler + #:with-layers + #:visible + #:ix-togl)) ;;; ============================================================================ ;;; MISC

1 0

[cello-cvs] CVS cello
by fgoenninger 26 Aug '06

26 Aug '06

Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv27087 Modified Files: cello-window.lisp Log Message: Added: export #:cello-window --- /project/cello/cvsroot/cello/cello-window.lisp 2006/08/22 16:12:34 1.4 +++ /project/cello/cvsroot/cello/cello-window.lisp 2006/08/26 21:43:36 1.5 @@ -19,7 +19,6 @@ ;------------- Window --------------- ; - (defmodel cello-window (celtk:window focuser) ( (gl-name-highest :cell nil :initarg :gl-name-highest

1 0

[cello-cvs] CVS cello/cl-ftgl/ftgl-int
by fgoenninger 26 Aug '06

26 Aug '06

Update of /project/cello/cvsroot/cello/cl-ftgl/ftgl-int In directory clnet:/tmp/cvs-serv3998 Modified Files: FTGLFromC.cpp Log Message: Changed: BuildGlyph no more part of FTGL (version 2.1.2). Tried to use MakeGlyph instead... --- /project/cello/cvsroot/cello/cl-ftgl/ftgl-int/FTGLFromC.cpp 2006/08/23 20:08:43 1.2 +++ /project/cello/cvsroot/cello/cl-ftgl/ftgl-int/FTGLFromC.cpp 2006/08/26 16:09:36 1.3 @@ -62,11 +62,12 @@ extern "C" { -/* void __stdcall fgcBuildGlyphs( FTFont* f ) + /* +void __stdcall fgcBuildGlyphs( FTFont* f ) { f->BuildGlyphs(); } -*/ + */ bool __stdcall fgcSetFaceSize( FTFont* f, unsigned int faceSize, @@ -90,13 +91,14 @@ return f->Advance( string ); } -/* + + /* int __stdcall fgcCharTexture( FTFont* f, int chr ) { - return ((FTGlyph *) f->BuildGlyph( chr ))->glRendering(); + return ((FTGlyph *) f->MakeGlyph( chr ))->glRendering(); //return f->GlyphRendering( chr ); } -*/ + */ /* void FTFont::DoRender( const unsigned int chr, const unsigned int nextChr)

1 0

[cello-cvs] CVS cello/cl-ftgl/ftgl-int
by fgoenninger 26 Aug '06

26 Aug '06

Update of /project/cello/cvsroot/cello/cl-ftgl/ftgl-int In directory clnet:/tmp/cvs-serv3955 Modified Files: Makefile Log Message: Changed: Minor changes, more flexibility for Compile and Link phases through separate commands. --- /project/cello/cvsroot/cello/cl-ftgl/ftgl-int/Makefile 2006/08/23 20:07:32 1.2 +++ /project/cello/cvsroot/cello/cl-ftgl/ftgl-int/Makefile 2006/08/26 16:08:27 1.3 @@ -2,7 +2,7 @@ # MAKEFILE for libFTGLinterface # ============================================================================= -# $Id: Makefile,v 1.2 2006/08/23 20:07:32 fgoenninger Exp $ +# $Id: Makefile,v 1.3 2006/08/26 16:08:27 fgoenninger Exp $ # by Frank Goenninger, Bempflingen, Germany # August 2006 @@ -14,20 +14,26 @@ SRCS = FTGLFromC.cpp OBJS = FTGLFromC.o -INCLUDEDIRS = -I/usr/local/include/freetype2 -I/usr/local/include/freetype2/freetype -I/opt/ftgl/src/FTGL/include +INCLUDEDIRS = -I/usr/X11R6/include/freetype2 -I/usr/X11R6/include/freetype2/freetype -I/opt/ftgl/src/FTGL/include TARGET = libFTGLint.dylib -DEPLIBS = -framework Carbon -framework OpenGL -framework GLUT /usr/local/lib/libfreetype.dylib /opt/ftgl/src/FTGL/mac/build/Development/libftgl.a +DEPLIBS = -framework Carbon -framework OpenGL /usr/X11R6/lib/libfreetype.a /opt/ftgl/src/FTGL/mac/build/Development/libftgl.a + +# DEPLIBS = -framework Carbon -framework OpenGL -framework GLUT /usr/X11R6/lib/libfreetype.a /opt/ftgl/src/FTGL/mac/build/Development/libftgl.a + + +CC = gcc -O +LD = g++ -O -CC = g++ -O CCFLAGS = -dynamic -LDFLAGS = -dynamiclib -flat_namespace +# LDFLAGS = -dynamiclib -flat_namespace +LDFLAGS = -dynamiclib FTGLFromC.o: $(SRCS) $(CC) $(CCFLAGS) $(INCLUDEDIRS) -o FTGLFromC.o -c FTGLFromC.cpp all: $(OBJS) - $(CC) $(LDFLAGS) -o $(TARGET) $(DEPLIBS) FTGLFromC.o + $(LD) $(LDFLAGS) -o $(TARGET) $(DEPLIBS) FTGLFromC.o clean: rm -f $(OBJS) $(TARGET)

1 0

[cello-cvs] CVS cello/cl-ftgl
by fgoenninger 26 Aug '06

26 Aug '06

Update of /project/cello/cvsroot/cello/cl-ftgl In directory clnet:/tmp/cvs-serv3905 Modified Files: cl-ftgl.lisp Log Message: Changed: Use new scheme to locate fonts. Needed on *nixes where fonts are in several locations. --- /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp 2006/08/25 08:28:16 1.10 +++ /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp 2006/08/26 16:07:35 1.11 @@ -1,4 +1,4 @@ -;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cello; -*- +;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cl-ftgl; -*- ;;; ;;; Copyright © 2004 by Kenneth William Tilton. ;;;;; @@ -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.10 2006/08/25 08:28:16 fgoenninger Exp $ +;;; $Header: /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp,v 1.11 2006/08/26 16:07:35 fgoenninger Exp $ (defpackage #:cl-ftgl (:nicknames #:ftgl) @@ -51,8 +51,8 @@ (in-package :cl-ftgl) (define-foreign-library FTGL - (:darwin (:or "/opt/common-lisp/cello/cl-ftgl/ftgl-int/libFTGLint.dylib")) - (:windows (:or "/0dev/user/dynlib/ftgl_dynamic_MTD_d.dll"))) + (:darwin (:or "/opt/common-lisp/cello/cl-ftgl/ftgl-int/libFTGLint.dylib")) + (:windows (:or "/0dev/user/dynlib/ftgl_dynamic_MTD_d.dll"))) ;;(use-foreign-library FTGL) - frgo: This leads to problems on OS X !!! ;; -> Use function cl-ftgl-init ! @@ -63,6 +63,60 @@ (defparameter *ftgl-fonts-loaded* nil) (defparameter *ftgl-ogl* nil) +(defparameter *ftgl-font-pathnames-list* + + #+(or win32 windows) + (list + (make-pathname + :directory + '(:absolute "Windows" "fonts"))) + + #+linux + (list + (make-pathname + :directory + '(:absolute "usr" "share" "truetype"))) + + #+macosx + (list + (make-pathname + :directory + '(:absolute "System" "Library" "Fonts")) + (make-pathname + :directory + '(:absolute "Library" "Fonts")) + (make-pathname + :directory + '(:relative "~" "Library" "Fonts"))) +) + +(defparameter *ftgl-font-types-list* ;; list of font types + ;; (font filename endings) + #+(or win32 windows) + '("ttf") + + #+linux + '("ttf") + + #+macosx + '("dfont" "ttf") +) + + +(defun find-font-file (font) + (loop named pn-loop for pathname in *ftgl-font-pathnames-list* + do + (loop for ending in *ftgl-font-types-list* + do + (let ((pn (merge-pathnames (make-pathname + :name (string (ftgl-face font)) + :type ending) + pathname))) + (if (probe-file pn) + (progn + (format t "~%*** FIND-FONT-FILE: Result = ~A~%" pn) + (return-from pn-loop pn))))))) + ;; ---------------------------------------------------------------------------- ;; FOREIGN FUNCTION INTERFACE ;; ---------------------------------------------------------------------------- @@ -70,8 +124,8 @@ (defcfun ("fgcSetFaceSize" fgc-set-face-size) :unsigned-char (f :pointer)(size :int)(res :int)) -(defcfun ("fgcCharTexture" fgc-char-texture) :int - (f :pointer)(charCode :int)) +;; (defcfun ("fgcCharTexture" fgc-char-texture) :int +;; (f :pointer)(charCode :int)) (defcfun ("fgcAscender" fgc-ascender) :float (font :pointer)) @@ -88,8 +142,8 @@ (defcfun ("fgcRender" fgc-render) :void (font :pointer)(text :string)) -(defcfun ("fgcBuildGlyphs" fgc-build-glyphs) :void - (font :pointer)) +;; (defcfun ("fgcBuildGlyphs" fgc-build-glyphs) :void +;; (font :pointer)) (defcfun ("fgcFree" fgc-free) :void (font :pointer)) @@ -113,28 +167,16 @@ (defun fgc-set-face-depth (font depth) (fgcSetFaceDepth font (coerce depth 'float))) -(defparameter *font-directory-path* - (make-pathname - :directory - #+(or win32 mswindows) - '(:absolute "windows" "fonts") - #+linux - '(:absolute "usr" "share" "fonts" "truetype") - #+macosx - '(:absolute "Library" "Fonts") - )) - ;; ---------------------------------------------------------------------------- ;; FUNCTIONS/METHODS ;; ---------------------------------------------------------------------------- (defun cl-ftgl-reset () -#-mcl +#-(or mcl macosx) (setq *ftgl-loaded-p* nil) (setq *ftgl-fonts-loaded* nil)) - #+test (progn (cl-ftgl-init) @@ -145,19 +187,11 @@ (print (list "ArialHB disp font" (ftgl-get-display-font sylfaen))) )) -#+frgo -(defun cl-ftgl-test () - (setf *ftgl-ogl* t) - (cl-ftgl-init) - (let ((sylfaen (ftgl-font-ensure :texture "ArialHB" 24 96))) - (print (list "ArialHB ascender" (ftgl-get-ascender sylfaen))) - (print (list "ArialHB descender" (ftgl-get-descender sylfaen))) - (print (list "ArialHB hello world length" (ftgl-string-length sylfaen "Hello world"))) - (print (list "ArialHB disp font" (ftgl-get-display-font sylfaen))))) - (defun cl-ftgl-init () - (unless *ftgl-loaded-p* - (assert (setq *ftgl-loaded-p* (use-foreign-library ftgl))))) + (unless *ftgl-loaded-p* + (assert (setq *ftgl-loaded-p* (use-foreign-library FTGL)))) + (format *debug-io* "~%*** CL-FTGL-INIT: Loaded: ~S~%" + *ftgl-loaded-p*)) ;; frgo: Debug ... (defun ftgl-font-ensure (type face size target-res &optional (depth 0)) (let ((fspec (list type face size target-res depth))) @@ -167,7 +201,7 @@ f)))) (defun ftgl-make (type face size target-res &optional (depth 0)) - ;; (print (list "ftgl-make entry" type face size)) + (print (list "ftgl-make entry" type face size)) (funcall (ecase type (:bitmap 'make-ftgl-bitmap) (:pixmap 'make-ftgl-pixmap) @@ -222,7 +256,6 @@ (declare (ignore new-value font))) (defmethod ftgl-ready ((font ftgl-disp)) - ;(print (list "A cheerful HELLO from ftgl-ready: " font)) (ftgl-disp-ready-p font)) @@ -286,20 +319,17 @@ )) (defun ftgl-font-make (font) - ;; (print (list "ftgl-font-make: entry" font)) - (let ((path (merge-pathnames - (make-pathname :name (string (ftgl-face font)) :type "ttf") - *font-directory-path*))) - (if (probe-file path) + (let ((path (find-font-file font))) + (if path (let* ((fpath (namestring path)) (f (fgc-font-make font fpath))) (if f (progn - ;;(ogl::dump-lists 1 10000) (fgc-set-face-size f (ftgl-size font) (ftgl-target-res font)) +;; (setf (ftgl-ifont font) f) f) - (error "cannot load ~a font ~a" (type-of font) fpath))) - (error "Font not found: ~a" path)))) + (error "cannot load ~a font ~a" (type-of font) fpath))) + (error "Font not found: ~a" path)))) (defmethod ftgl-render (font s) (assert font) @@ -327,6 +357,7 @@ (fgc-bitmap-make fpath)) (defmethod fgc-font-make ((font ftgl-texture) fpath) + (format t "~%*** FGC-FONT-MAKE: fpath = ~A~%" fpath) (fgc-texture-make fpath)) (defmethod fgc-font-make ((font ftgl-extruded) fpath) @@ -341,7 +372,6 @@ (fgc-polygon-make fpath)) (defun ftgl-string-length (font cs) - ;;(trc "ftgl-string-length" (ftgl-get-metrics-font font) cs) (fgc-string-advance (ftgl-get-metrics-font font) cs)) (defmethod font-bearing-x (font &optional text)

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

cello-cvs August 2006