Split off opengl.textures from opengl.texture-cache; use image tuples instead of texture-info

basis/core-text/core-text.factor

@@ -1,12 +1,11 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays alien alien.c-types alien.syntax kernel
+USING: arrays alien alien.c-types alien.syntax kernel destructors
-destructors accessors fry words hashtables strings
+accessors fry words hashtables strings sequences memoize assocs math
-sequences memoize assocs math math.functions locals init
+math.functions locals init namespaces combinators fonts colors cache
-namespaces combinators fonts colors cache core-foundation
+images endian core-foundation core-foundation.strings
-core-foundation.strings core-foundation.attributed-strings
+core-foundation.attributed-strings core-foundation.utilities
-core-foundation.utilities core-graphics core-graphics.types
+core-graphics core-graphics.types core-text.fonts core-text.utilities ;
-core-text.fonts core-text.utilities ;
 IN: core-text
 
 TYPEDEF: void* CTLineRef
@@ -47,7 +46,7 @@ ERROR: not-a-string object ;
         CTLineCreateWithAttributedString
     ] with-destructors ;
 
-TUPLE: line font line metrics dim bitmap disposed ;
+TUPLE: line font line metrics image disposed ;
 
 : compute-line-metrics ( line -- line-metrics )
     0 <CGFloat> 0 <CGFloat> 0 <CGFloat>
@@ -78,6 +77,13 @@ TUPLE: line font line metrics dim bitmap disposed ;
 : set-text-position ( context metrics -- )
     [ 0 ] dip descent>> ceiling CGContextSetTextPosition ;
 
+: <line-image> ( dim bitmap -- image )
+    <image>
+        swap >>bitmap
+        swap >>dim
+        BGRA >>component-order
+        native-endianness >>byte-order ;
+
 :: <line> ( font string -- line )
     [
         [let* | open-font [ font cache-font CFRetain |CFRelease ]
@@ -92,7 +98,7 @@ TUPLE: line font line metrics dim bitmap disposed ;
                     [ [ line ] dip CTLineDraw ]
                 } cleave
             ] with-bitmap-context
-            [ open-font line metrics dim ] dip
+            [ open-font line metrics dim ] dip <line-image>
         ]
         f line boa
     ] with-destructors ;

basis/opengl/opengl-docs.factor

@@ -30,23 +30,14 @@ HELP: gl-rect
 { $values { "dim" "a pair of integers" } }
 { $description "Draws the outline of a rectangle with the top-left corner at the origin and the given dimensions." } ;
 
-HELP: gen-texture
-{ $values { "id" integer } }
-{ $description "Wrapper for " { $link glGenTextures } " to handle the common case of generating a single texture ID." } ;
-
 HELP: gen-gl-buffer
 { $values { "id" integer } }
 { $description "Wrapper for " { $link glGenBuffers } " to handle the common case of generating a single buffer ID." } ;
 
-HELP: delete-texture
-{ $values { "id" integer } }
-{ $description "Wrapper for " { $link glDeleteTextures } " to handle the common case of deleting a single texture ID." } ;
-
 HELP: delete-gl-buffer
 { $values { "id" integer } }
 { $description "Wrapper for " { $link glDeleteBuffers } " to handle the common case of deleting a single buffer ID." } ;
 
-{ gen-texture delete-texture } related-words
 { gen-gl-buffer delete-gl-buffer } related-words
 
 HELP: bind-texture-unit
@@ -61,10 +52,6 @@ HELP: do-attribs
 { $values { "bits" integer } { "quot" quotation } }
 { $description "Wraps a quotation in " { $link glPushAttrib } "/" { $link glPopAttrib } " calls." } ;
 
-HELP: make-texture
-{ $values { "dim" "a pair of integers" } { "pixmap" c-ptr } { "format" "an OpenGL texture format, for example " { $link GL_UNSIGNED_BYTE } } { "type" "an OpenGL texture type, for example " { $link GL_RGBA } } { "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." } ;
@@ -81,7 +68,6 @@ 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." } ;
 
-
 ARTICLE: "gl-utilities" "OpenGL utility words"
 "The " { $vocab-link "opengl" } " vocabulary implements some utility words to give OpenGL a more Factor-like feel."
 $nl
@@ -90,7 +76,6 @@ $nl
 "Wrappers:"
 { $subsection gl-color }
 { $subsection gl-translate }
-{ $subsection gen-texture }
 { $subsection bind-texture-unit }
 "Combinators:"
 { $subsection do-enabled }

basis/opengl/opengl.factor

@@ -106,31 +106,9 @@ MACRO: all-enabled-client-state ( seq quot -- )
 : gl-fill-rect ( dim -- )
     fill-rect-vertices (gl-fill-rect) ;
 
-: init-texture ( -- )
-    GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR glTexParameteri
-    GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR glTexParameteri
-    GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT glTexParameterf
-    GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT glTexParameterf ;
-
-: rect-texture-coords ( -- )
-    float-array{ 0 0 1 0 1 1 0 1 } gl-texture-coord-pointer ;
-
 : do-attribs ( bits quot -- )
     swap glPushAttrib call glPopAttrib ; inline
 
-: draw-textured-rect ( dim texture -- )
-    GL_TEXTURE_2D [
-        GL_TEXTURE_BIT [
-            GL_TEXTURE_COORD_ARRAY [
-                COLOR: white gl-color
-                GL_TEXTURE_2D swap glBindTexture
-                init-texture rect-texture-coords
-                fill-rect-vertices (gl-fill-rect)
-                GL_TEXTURE_2D 0 glBindTexture
-            ] do-enabled-client-state
-        ] do-attribs
-    ] do-enabled ;
-
 : circle-steps ( steps -- angles )
     dup length v/n 2 pi * v*n ;
 
@@ -161,18 +139,12 @@ MACRO: all-enabled-client-state ( seq quot -- )
 : (gen-gl-object) ( quot -- id )
     [ 1 0 <uint> ] dip keep *uint ; inline
 
-: gen-texture ( -- id )
-    [ glGenTextures ] (gen-gl-object) ;
-
 : gen-gl-buffer ( -- id )
     [ glGenBuffers ] (gen-gl-object) ;
 
 : (delete-gl-object) ( id quot -- )
     [ 1 swap <uint> ] dip call ; inline
 
-: delete-texture ( id -- )
-    [ glDeleteTextures ] (delete-gl-object) ;
-
 : delete-gl-buffer ( id -- )
     [ glDeleteBuffers ] (delete-gl-object) ;
 
@@ -207,22 +179,6 @@ MACRO: set-draw-buffers ( buffers -- )
 : gl-look-at ( eye focus up -- )
     [ first3 ] tri@ gluLookAt ;
 
-:: make-texture ( dim pixmap format type -- id )
-    gen-texture [
-        GL_TEXTURE_BIT [
-            GL_TEXTURE_2D swap glBindTexture
-            GL_TEXTURE_2D
-            0
-            GL_RGBA
-            dim first2
-            0
-            format
-            type
-            pixmap
-            glTexImage2D
-        ] do-attribs
-    ] keep ;
-
 : gen-dlist ( -- id ) 1 glGenLists ;
 
 : make-dlist ( type quot -- id )

basis/opengl/texture-cache/texture-cache.factor

@@ -1,29 +1,9 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs cache colors.constants destructors fry
-kernel opengl opengl.gl combinators ;
+opengl.textures kernel ;
 IN: opengl.texture-cache
 
-TUPLE: texture texture display-list disposed ;
-
-: make-texture-display-list ( dim texture -- dlist )
-    GL_COMPILE [ draw-textured-rect ] make-dlist ;
-
-TUPLE: texture-info dim bitmap format type ;
-
-C: <texture-info> texture-info
-
-: <texture> ( info -- texture )
-    [
-        { [ dim>> ] [ bitmap>> ] [ format>> ] [ type>> ] }
-        cleave make-texture
-    ] [ dim>> ] bi
-    over make-texture-display-list f texture boa ;
-
-M: texture dispose*
-    [ texture>> delete-texture ]
-    [ display-list>> delete-dlist ] bi ;
-
 TUPLE: texture-cache renderer cache disposed ;
 
 : <texture-cache> ( renderer -- cache )
@@ -31,7 +11,7 @@ TUPLE: texture-cache renderer cache disposed ;
         swap >>renderer
         <cache-assoc> >>cache ;
 
-GENERIC: render-texture ( key renderer -- texture-info )
+GENERIC: render-texture ( key renderer -- image )
 
 : get-texture ( key texture-cache -- texture )
     dup check-disposed

basis/opengl/textures/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/opengl/textures/textures-docs.factor

@@ -0,0 +1,15 @@
+IN: opengl.textures
+USING: help.markup help.syntax opengl.gl math alien ;
+
+HELP: gen-texture
+{ $values { "id" integer } }
+{ $description "Wrapper for " { $link glGenTextures } " to handle the common case of generating a single texture ID." } ;
+
+HELP: delete-texture
+{ $values { "id" integer } }
+{ $description "Wrapper for " { $link glDeleteTextures } " to handle the common case of deleting a single texture ID." } ;
+
+HELP: make-texture
+{ $values { "dim" "a pair of integers" } { "pixmap" c-ptr } { "format" "an OpenGL texture format, for example " { $link GL_UNSIGNED_BYTE } } { "type" "an OpenGL texture type, for example " { $link GL_RGBA } } { "id" "an OpenGL texture ID" } }
+{ $description "Creates a new OpenGL texture from a pixmap image whose dimensions are equal to " { $snippet "dim" } "." } ;
+  

basis/opengl/textures/textures-tests.factor

@@ -0,0 +1,4 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test opengl.textures ;
+IN: opengl.textures.tests

basis/opengl/textures/textures.factor

@@ -0,0 +1,81 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs cache colors.constants destructors fry
+kernel opengl opengl.gl combinators images endian
+specialized-arrays.float locals sequences ;
+IN: opengl.textures
+
+: init-texture ( -- )
+    GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR glTexParameteri
+    GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR glTexParameteri
+    GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT glTexParameterf
+    GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT glTexParameterf ;
+
+: rect-texture-coords ( -- )
+    float-array{ 0 0 1 0 1 1 0 1 } gl-texture-coord-pointer ;
+
+: gen-texture ( -- id )
+    [ glGenTextures ] (gen-gl-object) ;
+
+:: make-texture ( dim pixmap format type -- id )
+    gen-texture [
+        GL_TEXTURE_BIT [
+            GL_TEXTURE_2D swap glBindTexture
+            GL_TEXTURE_2D
+            0
+            GL_RGBA
+            dim first2
+            0
+            format
+            type
+            pixmap
+            glTexImage2D
+        ] do-attribs
+    ] keep ;
+
+: draw-textured-rect ( dim texture -- )
+    GL_TEXTURE_2D [
+        GL_TEXTURE_BIT [
+            GL_TEXTURE_COORD_ARRAY [
+                COLOR: white gl-color
+                GL_TEXTURE_2D swap glBindTexture
+                init-texture rect-texture-coords
+                fill-rect-vertices (gl-fill-rect)
+                GL_TEXTURE_2D 0 glBindTexture
+            ] do-enabled-client-state
+        ] do-attribs
+    ] do-enabled ;
+
+: delete-texture ( id -- )
+    [ glDeleteTextures ] (delete-gl-object) ;
+
+TUPLE: texture texture display-list disposed ;
+
+: make-texture-display-list ( dim texture -- dlist )
+    GL_COMPILE [ draw-textured-rect ] make-dlist ;
+
+GENERIC: component-order>format ( component-order -- format )
+
+M: RGBA component-order>format drop GL_RGBA ;
+M: BGRA component-order>format drop GL_BGRA_EXT ;
+
+: byte-order>type ( byte-order -- format )
+    native-endianness eq?
+    GL_UNSIGNED_INT_8_8_8_8_REV
+    GL_UNSIGNED_BYTE
+    ? ;
+
+: <texture> ( image -- texture )
+    [
+        {
+            [ dim>> ]
+            [ bitmap>> ]
+            [ component-order>> component-order>format ]
+            [ byte-order>> byte-order>type ]
+        } cleave make-texture
+    ] [ dim>> ] bi
+    over make-texture-display-list f texture boa ;
+
+M: texture dispose*
+    [ texture>> delete-texture ]
+    [ display-list>> delete-dlist ] bi ;

basis/ui/images/images.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces cache images accessors assocs kernel
+USING: namespaces cache images images.loader accessors assocs kernel
-opengl opengl.gl opengl.texture-cache ui.gadgets.worlds ;
+opengl opengl.gl opengl.textures opengl.texture-cache ui.gadgets.worlds ;
 IN: ui.images
 
 TUPLE: image-name path ;
@@ -17,17 +17,16 @@ image-cache [ <cache-assoc> ] initialize
 PRIVATE>
 
 : cached-image ( image-name -- image )
-    path>> image-cache get [ <image> ] cache ;
+    path>> image-cache get [ load-image ] cache ;
 
 <PRIVATE
 
 SINGLETON: image-renderer
 
 M: image-renderer render-texture
-    drop
+    drop cached-image ;
-    cached-image
+
-    [ dim>> ] [ bitmap>> ] bi
+SLOT: images
-    GL_RGBA GL_UNSIGNED_BYTE <texture-info> ;
 
 : image-texture-cache ( world -- texture-cache )
     [ [ image-renderer <texture-cache> ] unless* ] change-images

basis/ui/text/core-text/core-text.factor

@@ -14,13 +14,12 @@ M: core-text-renderer init-text-rendering
     core-text-renderer <texture-cache> >>text-handle drop ;
 
 M: core-text-renderer string-dim
-    [ " " string-dim { 0 1 } v* ] [ cached-line dim>> ] if-empty ;
+    [ " " string-dim { 0 1 } v* ]
+    [ cached-line image>> dim>> ]
+    if-empty ;
 
 M: core-text-renderer render-texture
-    drop first2 cached-line
+    drop first2 cached-line image>> ;
-    [ dim>> ] [ bitmap>> ] bi
-    GL_BGRA_EXT GL_UNSIGNED_INT_8_8_8_8_REV
-    <texture-info> ;
 
 M: core-text-renderer finish-text-rendering
     text-handle>> purge-texture-cache