Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv23927

Modified Files: ffi.lisp package.lisp pal.lisp Log Message: Much faster DRAW-TEXT. Removed display-lists

--- /project/pal/cvsroot/pal/ffi.lisp 2007/07/27 20:12:13 1.14 +++ /project/pal/cvsroot/pal/ffi.lisp 2007/07/27 21:25:40 1.15 @@ -438,8 +438,7 @@ (defstruct font (image nil :type (or boolean image)) (glyphs nil :type (or boolean (simple-vector 255))) - (height 0 :type u11) - (first-dl 0 :type u11)) + (height 0 :type u11))

(defstruct music music) @@ -478,7 +477,6 @@ (defmethod free-resource ((resource font)) (when (font-image resource) (free-resource (font-image resource)) - (gl-delete-lists (font-first-dl resource) 255) (setf (font-image resource) nil)))

(defmethod free-resource ((resource image)) @@ -849,22 +847,6 @@

(cffi:defcfun ("glGetError" gl-get-error) :int)

-(cffi:defcfun ("glGenLists" gl-gen-lists) :uint - (range :int)) - -(cffi:defcfun ("glNewList" gl-new-list) :void - (n :uint) - (mode :int)) - -(cffi:defcfun ("glEndList" gl-end-list) :void) - -(cffi:defcfun ("glCallList" gl-call-list) :void - (n :uint)) - -(cffi:defcfun ("glDeleteLists" gl-delete-lists) :void - (list :uint) - (range :int)) - (cffi:defcfun ("glGetIntegerv" %gl-get-integer) :void (value :int) (data :pointer)) --- /project/pal/cvsroot/pal/package.lisp 2007/07/24 12:55:06 1.12 +++ /project/pal/cvsroot/pal/package.lisp 2007/07/27 21:25:40 1.13 @@ -15,12 +15,6 @@ #:+gl-smooth+ #:+gl-compile+ #:+gl-points+ - #:gl-gen-lists - #:gl-new-list - #:font-first-dl - #:gl-end-list - #:gl-call-list - #:gl-delete-lists #:free #:calloc #:music-music --- /project/pal/cvsroot/pal/pal.lisp 2007/07/27 20:12:14 1.20 +++ /project/pal/cvsroot/pal/pal.lisp 2007/07/27 21:25:40 1.21 @@ -1,10 +1,9 @@ ;; Notes: -;; smoothed polygons, guess circle segment count +;; smoothed polygons, guess circle segment count, add start/end args to draw-circle ;; calculate max-texture-size ;; fix the fps ;; clean up the do-event ;; open quads and other optimisations -;; test with latest sdl libs

(declaim (optimize (speed 3) @@ -769,16 +768,8 @@ glyph))) (let ((font (pal-ffi:register-resource (pal-ffi:make-font :image (load-image (concatenate 'string font ".png")) :height (glyph-height (aref glyphs 32)) - :first-dl (pal-ffi:gl-gen-lists 255) :glyphs glyphs)))) (set-image (pal-ffi:font-image font)) - (loop - for g across (pal-ffi:font-glyphs font) - for dl from 0 to 255 - do - (pal-ffi:gl-new-list (+ (pal-ffi:font-first-dl font) dl) pal-ffi:+gl-compile+) - (draw-glyph (pal-ffi:font-image font) g) - (pal-ffi:gl-end-list)) font)))

(defun glyph-from-line (line) @@ -791,36 +782,38 @@ :height (fourth coords) :xoff (sixth coords))))

-(defun draw-glyph (image g) +(defun draw-glyph (x height image g) + (declare (type single-float x height) (type image image) (type glyph g)) (let* ((vx (vx (glyph-pos g))) (vy (vy (glyph-pos g))) (width (coerce (glyph-width g) 'single-float)) - (height (coerce (glyph-height g) 'single-float)) (tx1 (/ vx (pal-ffi:image-texture-width image))) (ty1 (/ vy (pal-ffi:image-texture-height image))) (tx2 (/ (+ vx width) (pal-ffi:image-texture-width image))) (ty2 (/ (+ vy height) (pal-ffi:image-texture-height image)))) - (with-gl pal-ffi:+gl-quads+ - (pal-ffi:gl-tex-coord2f tx1 ty1) - (pal-ffi:gl-vertex2f 0f0 0f0) - (pal-ffi:gl-tex-coord2f tx2 ty1) - (pal-ffi:gl-vertex2f width 0f0) - (pal-ffi:gl-tex-coord2f tx2 ty2) - (pal-ffi:gl-vertex2f width height) - (pal-ffi:gl-tex-coord2f tx1 ty2) - (pal-ffi:gl-vertex2f 0f0 height))) - (translate (v (+ (glyph-width g) (glyph-xoff g)) 0))) + (pal-ffi:gl-tex-coord2f tx1 ty1) + (pal-ffi:gl-vertex2f x 0f0) + (pal-ffi:gl-tex-coord2f tx2 ty1) + (pal-ffi:gl-vertex2f (+ x width) 0f0) + (pal-ffi:gl-tex-coord2f tx2 ty2) + (pal-ffi:gl-vertex2f (+ x width) height) + (pal-ffi:gl-tex-coord2f tx1 ty2) + (pal-ffi:gl-vertex2f x height) + (+ (glyph-width g) (glyph-xoff g))))

(defunct draw-text (text pos &optional font) (vec pos simple-string text (or font boolean) font) (with-transformation (:pos pos) - (let* ((font (if font + (let* ((dx 0f0) + (font (if font font (tag 'default-font))) - (first-dl (pal-ffi:font-first-dl font))) + (height (coerce (pal-ffi:font-height font) 'single-float))) (set-image (pal-ffi:font-image font)) - (loop for char across text do - (pal-ffi:gl-call-list (+ first-dl (char-code char))))))) + (with-gl pal-ffi:+gl-quads+ + (loop for char across text do + (incf dx + (draw-glyph dx height (pal-ffi:font-image font) (aref (pal-ffi:font-glyphs font) (char-code char)))))))))

(declaim (inline get-font-height)) (defunct get-font-height (&optional font)