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

Modified Files: ffi.lisp package.lisp pal.lisp todo.txt Log Message: DRAW-TEXT now uses display lists

--- /project/pal/cvsroot/pal/ffi.lisp 2007/07/18 19:27:22 1.7 +++ /project/pal/cvsroot/pal/ffi.lisp 2007/07/18 20:41:34 1.8 @@ -438,7 +438,8 @@ (defstruct font (image nil :type (or boolean image)) (glyphs nil :type (or boolean (simple-vector 255))) - (height 0 :type u11)) + (height 0 :type u11) + (first-dl 0 :type u11))

(defstruct music music) @@ -476,6 +477,7 @@ (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)) @@ -679,12 +681,14 @@ (defconstant +gl-points+ 0) (defconstant +gl-ONE-MINUS-DST-ALPHA+ #x305) (defconstant +gl-ONE-MINUS-DST-COLOR+ #x307) +(defconstant +MAX-TEXTURE-SIZE+ #xD33) (defconstant +gl-ONE-MINUS-SRC-ALPHA+ #x303) (defconstant +gl-ONE-MINUS-SRC-COLOR+ #x301) (defconstant +gl-texture-mag-filter+ #x2800) (defconstant +gl-texture-min-filter+ #x2801) (defconstant +gl-linear+ #x2601) (defconstant +gl-rgba+ #x1908) +(defconstant +gl-compile+ #x1300) (defconstant +gl-rgb+ #x1907) (defconstant +gl-scissor-test+ #xC11) (defconstant +gl-unsigned-byte+ #x1401) @@ -859,6 +863,21 @@

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

--- /project/pal/cvsroot/pal/package.lisp 2007/07/18 19:27:22 1.7 +++ /project/pal/cvsroot/pal/package.lisp 2007/07/18 20:41:34 1.8 @@ -7,7 +7,14 @@ #:make-font #:+gl-scissor-test+ #:+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/18 19:25:57 1.13 +++ /project/pal/cvsroot/pal/pal.lisp 2007/07/18 20:41:34 1.14 @@ -693,12 +693,11 @@ (pos (v 0 0) :type vec) (width 0 :type u11) (height 0 :type u11) - (xoff 0 :type fixnum) - (dl 0 :type u11)) + (xoff 0 :type fixnum))

(defun load-font (font) - (let ((glyphs (make-array 255 :initial-element (make-glyph :width 1 :height 1 :xoff 0 :dl 0) :element-type 'glyph)) + (let ((glyphs (make-array 255 :initial-element (make-glyph :width 1 :height 1 :xoff 0) :element-type 'glyph)) (lines (with-open-file (file (data-path (concatenate 'string font ".fnt"))) (loop repeat 4 do (read-line file)) (loop for i from 0 to 94 collecting @@ -707,38 +706,59 @@ (let ((glyph (glyph-from-line line))) (setf (aref glyphs (char-code (glyph-char glyph))) glyph))) - (pal-ffi:register-resource (pal-ffi:make-font :image (load-image (concatenate 'string font ".png")) - :height (glyph-height (aref glyphs 32)) - :glyphs glyphs)))) + (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) (let ((char (elt line 0)) (coords (read-from-string (concatenate 'string "(" (subseq line 2) ")")))) (make-glyph :char char - :dl 0 :pos (v (first coords) (second coords)) :width (third coords) :height (fourth coords) :xoff (sixth coords))))

+(defun draw-glyph (image 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))) + (defun draw-text (text pos &optional font) (declare (type vec pos) (type simple-string text) (type (or font boolean) font)) (with-transformation (:pos pos) - (let* ((font (if font - font - (tag 'default-font))) - (origo (v 0 0)) - (image (pal-ffi:font-image font))) - (declare (type image image) (type vec origo)) + (let ((font (if font + font + (tag 'default-font)))) + (set-image (pal-ffi:font-image font)) (loop for char across text do - (let ((g (aref (pal-ffi:font-glyphs font) (char-code char)))) - (draw-image* image - (glyph-pos g) - origo - (glyph-width g) - (glyph-height g)) - (pal-ffi:gl-translatef (coerce (+ (glyph-width g) (glyph-xoff g)) 'single-float) 0f0 0f0)))))) + (pal-ffi:gl-call-list (+ (pal-ffi:font-first-dl font) (char-code char)))))))

(declaim (inline get-font-height)) (defun get-font-height (&optional font) --- /project/pal/cvsroot/pal/todo.txt 2007/07/18 19:27:22 1.8 +++ /project/pal/cvsroot/pal/todo.txt 2007/07/18 20:41:36 1.9 @@ -1,9 +1,5 @@ TODO:

-- Add display list support. - -- Font rendering is too slow, maybe use display lists for that? - - More drawing primitives.

- Add align, scale and angle options to DRAW-IMAGE*.