[pal-cvs] CVS pal
tneste
tneste at common-lisp.net
Fri Jul 27 21:25:40 UTC 2007
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)
More information about the Pal-cvs
mailing list