[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