From 7fdf7cc906cfb6d8ca7f5f56b800215e72a1d45f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 18 Jan 2009 20:10:08 -0600
Subject: [PATCH] Clean up OpenGL code a bit
---
basis/opengl/opengl-docs.factor | 29 +++--------
basis/opengl/opengl.factor | 61 ++++++-----------------
basis/opengl/sprites/authors.txt | 1 +
basis/opengl/sprites/sprites-docs.factor | 18 +++++++
basis/opengl/sprites/sprites-tests.factor | 4 ++
basis/opengl/sprites/sprites.factor | 39 +++++++++++++++
basis/ui/freetype/freetype.factor | 23 +++++----
7 files changed, 96 insertions(+), 79 deletions(-)
create mode 100644 basis/opengl/sprites/authors.txt
create mode 100644 basis/opengl/sprites/sprites-docs.factor
create mode 100644 basis/opengl/sprites/sprites-tests.factor
create mode 100644 basis/opengl/sprites/sprites.factor
diff --git a/basis/opengl/opengl-docs.factor b/basis/opengl/opengl-docs.factor
index b1ea89178b..f2a41773c0 100644
--- a/basis/opengl/opengl-docs.factor
+++ b/basis/opengl/opengl-docs.factor
@@ -1,9 +1,9 @@
-USING: help.markup help.syntax io kernel math quotations
-opengl.gl assocs vocabs.loader sequences accessors ;
+USING: alien help.markup help.syntax io kernel math quotations
+opengl.gl assocs vocabs.loader sequences accessors colors ;
IN: opengl
HELP: gl-color
-{ $values { "color" "a color specifier" } }
+{ $values { "color" color } }
{ $description "Wrapper for " { $link glColor4d } " taking a color specifier." } ;
HELP: gl-error
@@ -60,21 +60,10 @@ HELP: do-attribs
{ $values { "bits" integer } { "quot" quotation } }
{ $description "Wraps a quotation in " { $link glPushAttrib } "/" { $link glPopAttrib } " calls." } ;
-HELP: sprite
-{ $class-description "A sprite is an OpenGL texture together with a display list which renders a textured quad. Sprites are used to draw text in the UI. Sprites have the following slots:"
- { $list
- { { $snippet "dlist" } " - an OpenGL display list ID" }
- { { $snippet "texture" } " - an OpenGL texture ID" }
- { { $snippet "loc" } " - top-left corner of the sprite" }
- { { $snippet "dim" } " - dimensions of the sprite" }
- { { $snippet "dim2" } " - dimensions of the sprite, rounded up to the nearest powers of two" }
- }
-} ;
-
-HELP: gray-texture
-{ $values { "sprite" sprite } { "pixmap" "an alien or byte array" } { "id" "an OpenGL texture ID" } }
-{ $description "Creates a new OpenGL texture from a 1 byte per pixel image whose dimensions are equal to " { $snippet "dim2" } "." } ;
-
+HELP: make-texture
+ { $values { "dim" "a pair of integers" } { "pixmap" c-ptr } { "type" "an OpenGL texture type" } { "id" "an OpenGL texture ID" } }
+{ $description "Creates a new OpenGL texture from a pixmap image whose dimensions are equal to " { $snippet "dim" } "." } ;
+
HELP: gen-dlist
{ $values { "id" integer } }
{ $description "Wrapper for " { $link glGenLists } " to handle the common case of generating a single display list ID." } ;
@@ -87,10 +76,6 @@ HELP: gl-translate
{ $values { "point" "a pair of integers" } }
{ $description "Wrapper for " { $link glTranslated } " taking a point object." } ;
-HELP: free-sprites
-{ $values { "sprites" "a sequence of " { $link sprite } " instances" } }
-{ $description "Deallocates native resources associated toa sequence of sprites." } ;
-
HELP: with-translation
{ $values { "loc" "a pair of integers" } { "quot" quotation } }
{ $description "Calls the quotation with a translation by " { $snippet "loc" } " pixels applied to the current " { $link GL_MODELVIEW } " matrix, restoring the matrix when the quotation is done." } ;
diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor
index f5868ee7a1..8bf703bf62 100644
--- a/basis/opengl/opengl.factor
+++ b/basis/opengl/opengl.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
! Portions copyright (C) 2007 Eduardo Cavazos.
! Portions copyright (C) 2008 Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
@@ -188,31 +188,26 @@ MACRO: set-draw-buffers ( buffers -- )
: gl-look-at ( eye focus up -- )
[ first3 ] tri@ gluLookAt ;
-TUPLE: sprite loc dim dim2 dlist texture ;
-
-: <sprite> ( loc dim dim2 -- sprite )
- f f sprite boa ;
-
-: sprite-size2 ( sprite -- w h ) dim2>> first2 ;
-
-: sprite-width ( sprite -- w ) dim>> first ;
-
-: gray-texture ( sprite pixmap -- id )
- gen-texture [
+: make-texture ( dim pixmap type -- id )
+ [ gen-texture ] 3dip swap '[
GL_TEXTURE_BIT [
GL_TEXTURE_2D swap glBindTexture
- [
- [ GL_TEXTURE_2D 0 GL_RGBA ] dip
- sprite-size2 0 GL_LUMINANCE_ALPHA
- GL_UNSIGNED_BYTE
- ] dip glTexImage2D
+ GL_TEXTURE_2D
+ 0
+ GL_RGBA
+ _ first2
+ 0
+ _
+ GL_UNSIGNED_BYTE
+ _
+ glTexImage2D
] do-attribs
] keep ;
-
+
: gen-dlist ( -- id ) 1 glGenLists ;
: make-dlist ( type quot -- id )
- gen-dlist [ rot glNewList call glEndList ] keep ; inline
+ [ gen-dlist ] 2dip '[ _ glNewList @ glEndList ] keep ; inline
: init-texture ( -- )
GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR glTexParameteri
@@ -225,34 +220,8 @@ TUPLE: sprite loc dim dim2 dlist texture ;
: rect-texture-coords ( -- )
float-array{ 0 0 1 0 1 1 0 1 } gl-texture-coord-pointer ;
-: draw-sprite ( sprite -- )
- GL_TEXTURE_COORD_ARRAY [
- dup loc>> gl-translate
- GL_TEXTURE_2D over texture>> glBindTexture
- init-texture rect-texture-coords
- dim2>> fill-rect-vertices
- (gl-fill-rect)
- GL_TEXTURE_2D 0 glBindTexture
- ] do-enabled-client-state ;
-
-: make-sprite-dlist ( sprite -- id )
- GL_MODELVIEW [
- GL_COMPILE [ draw-sprite ] make-dlist
- ] do-matrix ;
-
-: init-sprite ( texture sprite -- )
- swap >>texture
- dup make-sprite-dlist >>dlist drop ;
-
: delete-dlist ( id -- ) 1 glDeleteLists ;
-: free-sprite ( sprite -- )
- [ dlist>> delete-dlist ]
- [ texture>> delete-texture ] bi ;
-
-: free-sprites ( sprites -- )
- [ nip [ free-sprite ] when* ] assoc-each ;
-
: with-translation ( loc quot -- )
GL_MODELVIEW [ [ gl-translate ] dip call ] do-matrix ; inline
@@ -269,4 +238,4 @@ TUPLE: sprite loc dim dim2 dlist texture ;
GL_PROJECTION glMatrixMode
glLoadIdentity
GL_MODELVIEW glMatrixMode
- glLoadIdentity ;
+ glLoadIdentity ;
\ No newline at end of file
diff --git a/basis/opengl/sprites/authors.txt b/basis/opengl/sprites/authors.txt
new file mode 100644
index 0000000000..d4f5d6b3ae
--- /dev/null
+++ b/basis/opengl/sprites/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
\ No newline at end of file
diff --git a/basis/opengl/sprites/sprites-docs.factor b/basis/opengl/sprites/sprites-docs.factor
new file mode 100644
index 0000000000..5f59001dd3
--- /dev/null
+++ b/basis/opengl/sprites/sprites-docs.factor
@@ -0,0 +1,18 @@
+IN: opengl.sprites
+USING: help.markup help.syntax ;
+
+HELP: sprite
+{ $class-description "A sprite is an OpenGL texture together with a display list which renders a textured quad. Sprites are used to draw text in the UI. Sprites have the following slots:"
+ { $list
+ { { $snippet "dlist" } " - an OpenGL display list ID" }
+ { { $snippet "texture" } " - an OpenGL texture ID" }
+ { { $snippet "loc" } " - top-left corner of the sprite" }
+ { { $snippet "dim" } " - dimensions of the sprite" }
+ { { $snippet "dim2" } " - dimensions of the sprite, rounded up to the nearest powers of two" }
+ }
+} ;
+
+HELP: free-sprites
+{ $values { "sprites" "a sequence of " { $link sprite } " instances" } }
+{ $description "Deallocates native resources associated toa sequence of sprites." } ;
+
diff --git a/basis/opengl/sprites/sprites-tests.factor b/basis/opengl/sprites/sprites-tests.factor
new file mode 100644
index 0000000000..e52f8ea7ef
--- /dev/null
+++ b/basis/opengl/sprites/sprites-tests.factor
@@ -0,0 +1,4 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test opengl.sprites ;
+IN: opengl.sprites.tests
diff --git a/basis/opengl/sprites/sprites.factor b/basis/opengl/sprites/sprites.factor
new file mode 100644
index 0000000000..e74382f3a7
--- /dev/null
+++ b/basis/opengl/sprites/sprites.factor
@@ -0,0 +1,39 @@
+! Copyright (C) 2005, 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel accessors sequences opengl opengl.gl assocs ;
+IN: opengl.sprites
+
+TUPLE: sprite loc dim dim2 dlist texture ;
+
+: <sprite> ( loc dim dim2 -- sprite )
+ f f sprite boa ;
+
+: sprite-size2 ( sprite -- w h ) dim2>> first2 ;
+
+: sprite-width ( sprite -- w ) dim>> first ;
+
+: draw-sprite ( sprite -- )
+ GL_TEXTURE_COORD_ARRAY [
+ dup loc>> gl-translate
+ GL_TEXTURE_2D over texture>> glBindTexture
+ init-texture rect-texture-coords
+ dim2>> fill-rect-vertices
+ (gl-fill-rect)
+ GL_TEXTURE_2D 0 glBindTexture
+ ] do-enabled-client-state ;
+
+: make-sprite-dlist ( sprite -- id )
+ GL_MODELVIEW [
+ GL_COMPILE [ draw-sprite ] make-dlist
+ ] do-matrix ;
+
+: init-sprite ( texture sprite -- )
+ swap >>texture
+ dup make-sprite-dlist >>dlist drop ;
+
+: free-sprite ( sprite -- )
+ [ dlist>> delete-dlist ]
+ [ texture>> delete-texture ] bi ;
+
+: free-sprites ( sprites -- )
+ [ nip [ free-sprite ] when* ] assoc-each ;
\ No newline at end of file
diff --git a/basis/ui/freetype/freetype.factor b/basis/ui/freetype/freetype.factor
index 89ce36af63..e8debb6763 100644
--- a/basis/ui/freetype/freetype.factor
+++ b/basis/ui/freetype/freetype.factor
@@ -1,7 +1,7 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.accessors alien.c-types arrays io kernel libc
-math math.vectors namespaces opengl opengl.gl assocs
+math math.vectors namespaces opengl opengl.gl opengl.sprites assocs
sequences io.files io.styles continuations freetype
ui.gadgets.worlds ui.render ui.backend byte-arrays accessors
locals specialized-arrays.direct.uchar ;
@@ -128,8 +128,9 @@ M: freetype-renderer string-height ( open-font string -- h )
drop height>> ;
: glyph-size ( glyph -- dim )
- dup glyph-hori-advance ft-ceil
- swap glyph-height ft-ceil 2array ;
+ [ glyph-hori-advance ft-ceil ]
+ [ glyph-height ft-ceil ]
+ bi 2array ;
: render-glyph ( font char -- bitmap )
load-glyph dup
@@ -157,17 +158,17 @@ M: freetype-renderer string-height ( open-font string -- h )
width [ glyph glyph-bitmap-width ]
width2 [ width next-power-of-2 2 * ] |
bitmap [
- [let | bitmap' [ bitmap rows width * <direct-uchar-array> ] |
- 0 0
- rows [ bitmap' texture width width2 copy-row ] times
- 2drop
- ]
+ bitmap rows width * <direct-uchar-array> :> bitmap'
+ 0 0
+ rows [ bitmap' texture width width2 copy-row ] times
+ 2drop
] when
] ;
: bitmap>texture ( glyph sprite -- id )
- tuck sprite-size2 * 2 * <byte-array>
- [ copy-bitmap ] keep gray-texture ;
+ tuck dim2>> product 2 * <byte-array>
+ [ copy-bitmap ] keep [ dim2>> ] dip
+ GL_LUMINANCE_ALPHA make-texture ;
: glyph-texture-loc ( glyph font -- loc )
[ drop glyph-hori-bearing-x ft-floor ]