cello-cvs

cello-cvs@common-lisp.net

227 discussions

[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

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

26 Aug '06

Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv3756 Modified Files: cello.asd Log Message: Nothing really changed. --- /project/cello/cvsroot/cello/cello.asd 2006/07/06 22:09:10 1.4 +++ /project/cello/cvsroot/cello/cello.asd 2006/08/26 16:04:46 1.5 @@ -3,7 +3,6 @@ ;(declaim (optimize (debug 2) (speed 1) (safety 1) (compilation-speed 1))) (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) - (in-package :asdf) #+(or allegro lispworks cmu mcl cormanlisp sbcl scl)

1 0

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

26 Aug '06

Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv3716 Added Files: kt-opengl-gears.lisp Log Message: Non-working (!!!) first Commit to CVS. --- /project/cello/cvsroot/cello/kt-opengl/kt-opengl-gears.lisp 2006/08/26 16:03:57 NONE +++ /project/cello/cvsroot/cello/kt-opengl/kt-opengl-gears.lisp 2006/08/26 16:03:57 1.1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- ;;; gears.lisp --- Celtk/Togl version of cl-opengl Lisp version of gears.c (GLUT Mesa demos). ;;; ;;; Simple program with rotating 3-D gear wheels. (defpackage :gears (:use :common-lisp :clos :utils-kt :cells :celtk :cello)) (in-package :gears) (defvar *startx*) (defvar *starty*) (defvar *xangle0*) (defvar *yangle0*) (defvar *xangle*) (defvar *yangle*) (defparameter *vTime* 100) (defun gears () ;; ACL project manager needs a zero-argument function, in project package (let ((*startx* nil) (*starty* nil) (*xangle0* nil) (*yangle0* nil) (*xangle* 0.2) (*yangle* 0.0)) (test-window 'gears-demo))) (defmodel gears-demo (window) ((gear-ct :cell t :initform (c-in 1) :accessor gear-ct :initarg :gear-ct) (scale :cell t :initform (c-in 1) :accessor scale :initarg :scale)) (:default-initargs :title$ "Rotating Gear Widget Test" :kids (c? (the-kids (mk-stack (:packing (c?pack-self "-side left -fill both")) (mk-label :text "Click and drag to rotate image") (mk-row () (mk-label :text "Spin delay (ms):") (mk-entry :id :vtime :md-value (c-in "10")) (mk-button-ex (" Quit " (tk-eval "destroy .")))) (make-instance 'gears :fm-parent *parent* :width 400 :height 400 :timer-interval (c? (let ((n$ (md-value (fm-other :vtime)))) (format nil "~a" (max 1 (or (parse-integer n$ :junk-allowed t) 0))))) :double 1 ;; "yes" :event-handler (c? (lambda (self xe) (case (tk-event-type (xsv type xe)) (:virtualevent (trc "canvas virtual" (xsv name xe))) (:buttonpress (RotStart self (xsv x-root xe) (xsv y-root xe))) (:motionnotify (RotMove self (xsv x-root xe) (xsv y-root xe))) (:buttonrelease (setf *startx* nil))))))))))) (defun RotStart (self x y) (setf *startx* x) (setf *starty* y) (setf *xangle0* (rotx self)) (setf *yangle0* (roty self))) (defun RotMove (self x y) (when *startx* (setf *xangle* (+ *xangle0* (- x *startx*))) (setf *yangle* (+ *yangle0* (- y *starty*))) (setf (rotx self) *xangle*) (setf (roty self) *yangle*))) (defconstant +pif+ (coerce pi 'single-float)) (defmodel gears (togl) ((rotx :initform (c-in 40) :accessor rotx :initarg :rotx) (roty :initform (c-in 25) :accessor roty :initarg :roty) (rotz :initform (c-in 10) :accessor rotz :initarg :rotz) (gear1 :initarg :gear1 :accessor gear1 :initform (c_? (trc "making list!!!!! 1") (let ((dl (gl:gen-lists 1))) (gl:with-new-list (dl :compile) (gl:material :front :ambient-and-diffuse #(0.8 0.1 0.0 1.0)) (draw-gear 1.0 4.0 1.0 20 0.7)) dl))) (gear2 :initarg :gear2 :accessor gear2 :initform (c_? (let ((dl (gl:gen-lists 1))) (gl:with-new-list (dl :compile) (gl:material :front :ambient-and-diffuse #(0.0 0.8 0.2 1.0)) (draw-gear 0.5 2.0 2.0 10 0.7)) dl))) (gear3 :initarg :gear3 :accessor gear3 :initform (c_? (let ((dl (gl:gen-lists 1))) (gl:with-new-list (dl :compile) (gl:material :front :ambient-and-diffuse #(0.2 0.2 1.0 1.0)) (draw-gear 1.3 2.0 0.5 10 0.7)) dl))) (angle :initform (c-in 0.0) :accessor angle :initarg :angle) (frame-count :cell nil :initform 0 :accessor frame-count) (t0 :cell nil :initform 0 :accessor t0) ; (width :initarg :wdith :initform 400 :accessor width) (height :initarg :wdith :initform 400 :accessor height))) (defmethod togl-timer-using-class ((self gears)) (trc nil "enter gear timer" self (togl-ptr self) (get-internal-real-time)) (incf (^angle) 5.0) (Togl_PostRedisplay (togl-ptr self)) ;(loop until (zerop (ctk::Tcl_DoOneEvent 2))) ) (defmethod togl-create-using-class ((self gears)) (gl:light :light0 :position #(5.0 5.0 10.0 0.0)) (gl:enable :cull-face :lighting :light0 :depth-test) (gl:material :front :ambient-and-diffuse #(0.8 0.1 0.0 1.0)) (gl:enable :normalize) (truc self)) (defmethod togl-reshape-using-class ((self gears)) (trc "reshape") (truc self t) ) (defun truc (self &optional truly) (let ((width (Togl_width (togl-ptr self))) (height (Togl_height (togl-ptr self)))) (trc "enter gear reshape" self width (width self)) (gl:viewport 0 (- height (height self)) (width self) (height self)) (unless truly (gl:matrix-mode :projection) (gl:load-identity) (let ((h (/ height width))) (gl:frustum -1 1 (- h) h 5 60))) (progn (gl:matrix-mode :modelview) (gl:load-identity) (gl:translate 0 0 -30)))) (defmethod togl-display-using-class ((self gears) &aux (scale (scale (upper self gears-demo)))) (declare (ignorable scale)) (gl:clear-color 0 0 0 1) (gl:clear :color-buffer-bit :depth-buffer-bit) (gl:with-pushed-matrix (gl:rotate (^rotx) 1 0 0) (gl:rotate (^roty) 0 1 0) (gl:rotate (^rotz) 0 0 1) (gl:with-pushed-matrix (gl:translate -3 -2 0) (gl:rotate (^angle) 0 0 1) (gl:call-list (^gear1))) (gl:with-pushed-matrix (gl:translate 3.1 -2 0) (gl:rotate (- (* -2 (^angle)) 9) 0 0 1) (gl:call-list (^gear2))) (gl:with-pushed-matrix ; gear3 (gl:translate -3.1 4.2 0.0) (gl:rotate (- (* -2 (^angle)) 25) 0 0 1) (gl:call-list (^gear3)))) (Togl_SwapBuffers (togl-ptr self)) #+shhh (print-frame-rate self)) (defun draw-gear (inner-radius outer-radius width n-teeth tooth-depth) "Draw a gear." (declare (single-float inner-radius outer-radius width tooth-depth) (fixnum n-teeth)) (let ((r0 inner-radius) (r1 (- outer-radius (/ tooth-depth 2.0))) (r2 (+ outer-radius (/ tooth-depth 2.0))) (da (/ (* 2.0 +pif+) n-teeth 4.0))) (gl:shade-model :flat) (gl:normal 0 0 1) ;; Draw front face. (gl:with-primitives :quad-strip (dotimes (i (1+ n-teeth)) (let ((angle (/ (* i 2.0 +pif+) n-teeth))) (gl:vertex (* r0 (cos angle)) (* r0 (sin angle)) (* width 0.5)) (gl:vertex (* r1 (cos angle)) (* r1 (sin angle)) (* width 0.5)) (gl:vertex (* r0 (cos angle)) (* r0 (sin angle)) (* width 0.5)) (gl:vertex (* r1 (cos (+ angle (* 3 da)))) (* r1 (sin (+ angle (* 3 da)))) (* width 0.5))))) ;; Draw front sides of teeth. (gl:with-primitives :quads (dotimes (i n-teeth) (let ((angle (/ (* i 2.0 +pif+) n-teeth))) (gl:vertex (* r1 (cos angle)) (* r1 (sin angle)) (* width 0.5)) (gl:vertex (* r2 (cos (+ angle da))) (* r2 (sin (+ angle da))) (* width 0.5)) (gl:vertex (* r2 (cos (+ angle (* 2 da)))) (* r2 (sin (+ angle (* 2 da)))) (* width 0.5)) (gl:vertex (* r1 (cos (+ angle (* 3 da)))) (* r1 (sin (+ angle (* 3 da)))) (* width 0.5))))) (gl:normal 0 0 -1) ;; Draw back face. (gl:with-primitives :quad-strip (dotimes (i (1+ n-teeth)) (let ((angle (/ (* i 2.0 +pif+) n-teeth))) (gl:vertex (* r1 (cos angle)) (* r1 (sin angle)) (* width -0.5)) (gl:vertex (* r0 (cos angle)) (* r0 (sin angle)) (* width -0.5)) (gl:vertex (* r1 (cos (+ angle (* 3 da)))) (* r1 (sin (+ angle (* 3 da)))) (* width -0.5)) (gl:vertex (* r0 (cos angle)) (* r0 (sin angle)) (* width -0.5))))) ;; Draw back sides of teeth. (gl:with-primitives :quads (dotimes (i n-teeth) (let ((angle (/ (* i 2.0 +pif+) n-teeth))) (gl:vertex (* r1 (cos (+ angle (* 3 da)))) (* r1 (sin (+ angle (* 3 da)))) (* (- width) 0.5)) (gl:vertex (* r2 (cos (+ angle (* 2 da)))) (* r2 (sin (+ angle (* 2 da)))) (* (- width) 0.5)) (gl:vertex (* r2 (cos (+ angle da))) (* r2 (sin (+ angle da))) (* (- width) 0.5)) (gl:vertex (* r1 (cos angle)) (* r1 (sin angle)) (* (- width) 0.5))))) ;; Draw outward faces of teeth. (gl:with-primitives :quad-strip (dotimes (i n-teeth) (let ((angle (/ (* i 2.0 +pif+) n-teeth))) (gl:vertex (* r1 (cos angle)) (* r1 (sin angle)) (* width 0.5)) (gl:vertex (* r1 (cos angle)) (* r1 (sin angle)) (* (- width) 0.5)) (let* ((u (- (* r2 (cos (+ angle da))) (* r1 (cos angle)))) (v (- (* r2 (sin (+ angle da))) (* r1 (sin angle)))) (len (sqrt (+ (* u u) (* v v))))) (setq u (/ u len)) (setq v (/ u len)) (gl:normal v (- u) 0.0) (gl:vertex (* r2 (cos (+ angle da))) (* r2 (sin (+ angle da))) (* width 0.5)) (gl:vertex (* r2 (cos (+ angle da))) (* r2 (sin (+ angle da))) (* (- width) 0.5)) (gl:normal (cos angle) (sin angle) 0.0) (gl:vertex (* r2 (cos (+ angle (* 2 da)))) (* r2 (sin (+ angle (* 2 da)))) (* width 0.5)) (gl:vertex (* r2 (cos (+ angle (* 2 da)))) (* r2 (sin (+ angle (* 2 da)))) (* (- width) 0.5)) (setq u (- (* r1 (cos (+ angle (* 3 da)))) (* r2 (cos (+ angle (* 2 da)))))) (setq v (- (* r1 (sin (+ angle (* 3 da)))) (* r2 (sin (+ angle (* 2 da)))))) (gl:normal v (- u) 0.0) (gl:vertex (* r1 (cos (+ angle (* 3 da)))) (* r1 (sin (+ angle (* 3 da)))) (* width 0.5)) (gl:vertex (* r1 (cos (+ angle (* 3 da)))) (* r1 (sin (+ angle (* 3 da)))) (* (- width) 0.5)) (gl:normal (cos angle) (sin angle) 0.0)))) (gl:vertex (* r1 (cos 0)) (* r1 (sin 0)) (* width 0.5)) (gl:vertex (* r1 (cos 0)) (* r1 (sin 0)) (* (- width) 0.5))) ;; Draw inside radius cylinder. (gl:shade-model :smooth) (gl:with-primitives :quad-strip (dotimes (i (1+ n-teeth)) (let ((angle (/ (* i 2.0 +pif+) n-teeth))) (gl:normal (- (cos angle)) (- (sin angle)) 0.0) (gl:vertex (* r0 (cos angle)) (* r0 (sin angle)) (* (- width) 0.5)) (gl:vertex (* r0 (cos angle)) (* r0 (sin angle)) (* width 0.5))))))) (defun print-frame-rate (window) (with-slots (frame-count t0) window (incf frame-count) (let ((time (get-internal-real-time))) (when (= t0 0) (setq t0 time)) (when (>= (- time t0) (* 5 internal-time-units-per-second)) (let* ((seconds (/ (- time t0) internal-time-units-per-second)) (fps (/ frame-count seconds))) (declare (ignorable fps)) #+shh (format *terminal-io* "~D frames in ~3,1F seconds = ~6,3F FPS~%" frame-count seconds fps)) (setq t0 time) (setq frame-count 0)))))

1 0

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

25 Aug '06

Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv2105 Modified Files: kt-opengl.lisp Log Message: Added: Id string for CVS info. --- /project/cello/cvsroot/cello/kt-opengl/kt-opengl.lisp 2006/06/05 01:47:50 1.3 +++ /project/cello/cvsroot/cello/kt-opengl/kt-opengl.lisp 2006/08/25 08:39:26 1.4 @@ -21,6 +21,8 @@ ;;; 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 $ + (pushnew :kt-opengl *features*) (defpackage #:kt-opengl

1 0

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

25 Aug '06

Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv1838 Modified Files: coordinate-xform.lisp Log Message: Added: Id string for CVS info. --- /project/cello/cvsroot/cello/coordinate-xform.lisp 2005/05/31 14:39:44 1.1 +++ /project/cello/cvsroot/cello/coordinate-xform.lisp 2006/08/25 08:36:12 1.2 @@ -20,6 +20,8 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. +;;; $Id: coordinate-xform.lisp,v 1.2 2006/08/25 08:36:12 fgoenninger Exp $ + (in-package :cello) (defconstant *reference-dpi* 1440)

1 0

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

25 Aug '06

Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv1598 Modified Files: cello.lisp Log Message: Deleted: Removed ASDF load of dependent packages. --- /project/cello/cvsroot/cello/cello.lisp 2006/08/23 21:13:49 1.9 +++ /project/cello/cvsroot/cello/cello.lisp 2006/08/25 08:31:57 1.10 @@ -14,25 +14,7 @@ |# -;;; $Id: cello.lisp,v 1.9 2006/08/23 21:13:49 fgoenninger Exp $ - -;;; ============================================================================ -;;; PACKAGES CELLO DEPENDS ON -;;; ============================================================================ - -;;; Note: Order matters! - -#+asdf -(eval-when (:load-toplevel :compile-toplevel :execute) - (asdf:operate 'asdf:load-op 'cells) - (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) - (asdf:operate 'asdf:load-op 'Celtk) - (asdf:operate 'asdf:load-op 'cl-openal) - (asdf:operate 'asdf:load-op 'cl-ftgl) - (asdf:operate 'asdf:load-op 'cl-magick)) +;;; $Id: cello.lisp,v 1.10 2006/08/25 08:31:57 fgoenninger Exp $ ;;; ============================================================================ ;;; PACKAGE DEFINITION

1 0

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

25 Aug '06

Update of /project/cello/cvsroot/cello/cl-ftgl In directory clnet:/tmp/cvs-serv32313 Modified Files: cl-ftgl.lisp Log Message: Changed: Loading of dynamic lib not done on toplevel anymore. Now only in function cl-ftgl-init. Changed: #+test: Use font ArialHB instead of Sylfaen (Sylfaen does not exist on OS X by default). Added: New function cl-ftgl-test. --- /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp 2006/08/23 20:11:18 1.9 +++ /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp 2006/08/25 08:28:16 1.10 @@ -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.9 2006/08/23 20:11:18 fgoenninger Exp $ +;;; $Header: /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp,v 1.10 2006/08/25 08:28:16 fgoenninger Exp $ (defpackage #:cl-ftgl (:nicknames #:ftgl) @@ -54,7 +54,8 @@ (: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) +;;(use-foreign-library FTGL) - frgo: This leads to problems on OS X !!! +;; -> Use function cl-ftgl-init ! (defparameter *gui-style-default-face* 'sylfaen) (defparameter *gui-style-button-face* 'sylfaen) @@ -137,13 +138,23 @@ #+test (progn (cl-ftgl-init) - (let ((sylfaen (ftgl-font-ensure :texture "Sylfaen" 24 96))) - (print (list "sylfaen ascender" (ftgl-get-ascender sylfaen))) - (print (list "sylfaen descender" (ftgl-get-descender sylfaen))) - (print (list "sylfaen hello world length" (ftgl-string-length sylfaen "Hello world"))) - (print (list "sylfaen disp font" (ftgl-get-display-font sylfaen))) + (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))) )) +#+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))))) @@ -336,4 +347,3 @@ (defmethod font-bearing-x (font &optional text) (declare (ignorable font text)) 0) -

1 0

[cello-cvs] CVS cello/cl-openal
by ktilton 24 Aug '06

24 Aug '06

Update of /project/cello/cvsroot/cello/cl-openal In directory clnet:/tmp/cvs-serv2556/cl-openal Modified Files: cl-openal.lpr Log Message: --- /project/cello/cvsroot/cello/cl-openal/cl-openal.lpr 2006/08/21 04:28:28 1.7 +++ /project/cello/cvsroot/cello/cl-openal/cl-openal.lpr 2006/08/24 17:35:08 1.8 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Jul 24, 2006 15:27)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Aug 17, 2006 12:24)"; cg: "1.81"; -*- (in-package :cg-user)

1 0

[cello-cvs] CVS cello/kt-opengl
by ktilton 24 Aug '06

24 Aug '06

Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv2556/kt-opengl Modified Files: ogl-utils.lisp Log Message: --- /project/cello/cvsroot/cello/kt-opengl/ogl-utils.lisp 2006/08/21 04:28:29 1.4 +++ /project/cello/cvsroot/cello/kt-opengl/ogl-utils.lisp 2006/08/24 17:35:08 1.5 @@ -81,6 +81,12 @@ (gl-get-integerv gl_scissor_box box) box)) +(ukt::export! ogl-current-color) +(defun ogl-current-color () + (let ((rgba (fgn-alloc 'glint 4 :ogl-current-color))) + (gl-get-integerv gl_current_color rgba) + rgba)) + (defun ogl-bounds (ff-box) (loop for n below 4 collecting (eltgli ff-box n)))

1 0

← Newer
1
...
8
9
10
11
12
13
14
...
23
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

cello-cvs