[pal-cvs] CVS pal
tneste
tneste at common-lisp.net
Wed Jul 18 20:41:36 UTC 2007
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*.
More information about the Pal-cvs
mailing list