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 ; - -: ( 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 ; + +: ( 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 * ] | - 0 0 - rows [ bitmap' texture width width2 copy-row ] times - 2drop - ] + bitmap rows width * :> bitmap' + 0 0 + rows [ bitmap' texture width width2 copy-row ] times + 2drop ] when ] ; : bitmap>texture ( glyph sprite -- id ) - tuck sprite-size2 * 2 * - [ copy-bitmap ] keep gray-texture ; + tuck dim2>> product 2 * + [ copy-bitmap ] keep [ dim2>> ] dip + GL_LUMINANCE_ALPHA make-texture ; : glyph-texture-loc ( glyph font -- loc ) [ drop glyph-hori-bearing-x ft-floor ]