opengl.textures: clean up code, only create power-of-2 textures, make API nicer
							parent
							
								
									31553f5d50
								
							
						
					
					
						commit
						676806ce39
					
				| 
						 | 
				
			
			@ -1,4 +1,51 @@
 | 
			
		|||
! Copyright (C) 2009 Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: tools.test opengl.textures ;
 | 
			
		||||
USING: tools.test opengl.textures opengl.textures.private
 | 
			
		||||
images kernel namespaces ;
 | 
			
		||||
IN: opengl.textures.tests
 | 
			
		||||
 | 
			
		||||
[ ] [
 | 
			
		||||
    { 3 5 }
 | 
			
		||||
    RGB
 | 
			
		||||
    B{
 | 
			
		||||
        1 2 3 4 5 6 7 8 9
 | 
			
		||||
        10 11 12 13 14 15 16 17 18
 | 
			
		||||
        19 20 21 22 23 24 25 26 27
 | 
			
		||||
        28 29 30 31 32 33 34 35 36
 | 
			
		||||
        37 38 39 40 41 42 43 44 45
 | 
			
		||||
    } image boa "image" set
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
[
 | 
			
		||||
    T{ image
 | 
			
		||||
        { dim { 4 8 } }
 | 
			
		||||
        { component-order RGB }
 | 
			
		||||
        { bitmap
 | 
			
		||||
          B{
 | 
			
		||||
              1 2 3 4 5 6 7 8 9 0 0 0
 | 
			
		||||
              10 11 12 13 14 15 16 17 18 0 0 0
 | 
			
		||||
              19 20 21 22 23 24 25 26 27 0 0 0
 | 
			
		||||
              28 29 30 31 32 33 34 35 36 0 0 0
 | 
			
		||||
              37 38 39 40 41 42 43 44 45 0 0 0
 | 
			
		||||
              0 0 0 0 0 0 0 0 0 0 0 0
 | 
			
		||||
              0 0 0 0 0 0 0 0 0 0 0 0
 | 
			
		||||
              0 0 0 0 0 0 0 0 0 0 0 0
 | 
			
		||||
          }
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
] [
 | 
			
		||||
    "image" get power-of-2-image
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
[
 | 
			
		||||
    T{ image
 | 
			
		||||
       { dim { 0 0 } }
 | 
			
		||||
       { component-order R32G32B32 }
 | 
			
		||||
       { bitmap B{ } } }
 | 
			
		||||
] [
 | 
			
		||||
    T{ image
 | 
			
		||||
       { dim { 0 0 } }
 | 
			
		||||
       { component-order R32G32B32 }
 | 
			
		||||
       { bitmap B{ } }
 | 
			
		||||
    } power-of-2-image
 | 
			
		||||
] unit-test
 | 
			
		||||
| 
						 | 
				
			
			@ -1,58 +1,17 @@
 | 
			
		|||
! 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 ;
 | 
			
		||||
USING: accessors assocs cache colors.constants destructors fry kernel
 | 
			
		||||
opengl opengl.gl combinators images grouping specialized-arrays.float
 | 
			
		||||
locals sequences math math.vectors generalizations ;
 | 
			
		||||
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 ;
 | 
			
		||||
: gen-texture ( -- id ) [ glGenTextures ] (gen-gl-object) ;
 | 
			
		||||
 | 
			
		||||
: rect-texture-coords ( -- )
 | 
			
		||||
    float-array{ 0 0 1 0 1 1 0 1 } gl-texture-coord-pointer ;
 | 
			
		||||
: delete-texture ( id -- ) [ glDeleteTextures ] (delete-gl-object) ;
 | 
			
		||||
 | 
			
		||||
: gen-texture ( -- id )
 | 
			
		||||
    [ glGenTextures ] (gen-gl-object) ;
 | 
			
		||||
TUPLE: texture texture-coords texture display-list disposed ;
 | 
			
		||||
 | 
			
		||||
:: 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 ;
 | 
			
		||||
<PRIVATE
 | 
			
		||||
 | 
			
		||||
GENERIC: component-order>format ( component-order -- format type )
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -60,15 +19,88 @@ M: RGBA component-order>format drop GL_RGBA GL_UNSIGNED_BYTE ;
 | 
			
		|||
M: ARGB component-order>format drop GL_BGRA_EXT GL_UNSIGNED_INT_8_8_8_8_REV ;
 | 
			
		||||
M: BGRA component-order>format drop GL_BGRA_EXT GL_UNSIGNED_INT_8_8_8_8 ;
 | 
			
		||||
 | 
			
		||||
: power-of-2-bitmap ( rows dim size -- bitmap dim )
 | 
			
		||||
    '[
 | 
			
		||||
        [ [ [ _ group ] map ] dip first '[ _ over peek pad-tail concat ] map ]
 | 
			
		||||
        [ second over peek pad-tail ] bi
 | 
			
		||||
        concat
 | 
			
		||||
    ] keep ;
 | 
			
		||||
 | 
			
		||||
: image-rows ( image -- rows )
 | 
			
		||||
    [ bitmap>> ]
 | 
			
		||||
    [ dim>> first ]
 | 
			
		||||
    [ component-order>> bytes-per-component ]
 | 
			
		||||
    tri * group ; inline
 | 
			
		||||
 | 
			
		||||
: power-of-2-image ( image -- image )
 | 
			
		||||
    dup dim>> [ 0 = ] all? [
 | 
			
		||||
        clone dup
 | 
			
		||||
        [ image-rows ]
 | 
			
		||||
        [ dim>> [ next-power-of-2 ] map ]
 | 
			
		||||
        [ component-order>> bytes-per-component ] tri
 | 
			
		||||
        power-of-2-bitmap
 | 
			
		||||
        [ >>bitmap ] [ >>dim ] bi*
 | 
			
		||||
    ] unless ;
 | 
			
		||||
 | 
			
		||||
:: make-texture ( image -- id )
 | 
			
		||||
    gen-texture [
 | 
			
		||||
        GL_TEXTURE_BIT [
 | 
			
		||||
            GL_TEXTURE_2D swap glBindTexture
 | 
			
		||||
            GL_TEXTURE_2D
 | 
			
		||||
            0
 | 
			
		||||
            GL_RGBA
 | 
			
		||||
            image dim>> first2
 | 
			
		||||
            0
 | 
			
		||||
            image component-order>> component-order>format
 | 
			
		||||
            image bitmap>>
 | 
			
		||||
            glTexImage2D
 | 
			
		||||
        ] do-attribs
 | 
			
		||||
    ] keep ;
 | 
			
		||||
 | 
			
		||||
: 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 glTexParameteri
 | 
			
		||||
    GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT glTexParameteri ;
 | 
			
		||||
 | 
			
		||||
: draw-textured-rect ( dim texture -- )
 | 
			
		||||
    GL_TEXTURE_2D [
 | 
			
		||||
        GL_TEXTURE_BIT [
 | 
			
		||||
            GL_TEXTURE_COORD_ARRAY [
 | 
			
		||||
                COLOR: white gl-color
 | 
			
		||||
                [ [ GL_TEXTURE_2D ] dip texture>> glBindTexture ]
 | 
			
		||||
                [ init-texture texture-coords>> gl-texture-coord-pointer ] bi
 | 
			
		||||
                fill-rect-vertices (gl-fill-rect)
 | 
			
		||||
                GL_TEXTURE_2D 0 glBindTexture
 | 
			
		||||
            ] do-enabled-client-state
 | 
			
		||||
        ] do-attribs
 | 
			
		||||
    ] do-enabled ;
 | 
			
		||||
 | 
			
		||||
: texture-coords ( dim -- coords )
 | 
			
		||||
    [ dup next-power-of-2 /f ] map
 | 
			
		||||
    { { 0 0 } { 1 0 } { 1 1 } { 0 1 } } [ v* ] with map
 | 
			
		||||
    float-array{ } join ;
 | 
			
		||||
 | 
			
		||||
: make-texture-display-list ( dim texture -- dlist )
 | 
			
		||||
    GL_COMPILE [ draw-textured-rect ] make-dlist ;
 | 
			
		||||
 | 
			
		||||
PRIVATE>
 | 
			
		||||
 | 
			
		||||
: <texture> ( image -- texture )
 | 
			
		||||
    [
 | 
			
		||||
    dup dim>> { 0 0 } = [ drop texture new ] [
 | 
			
		||||
        [ dim>> ]
 | 
			
		||||
        [ bitmap>> ]
 | 
			
		||||
        [ component-order>> component-order>format ]
 | 
			
		||||
        tri make-texture
 | 
			
		||||
    ] [ dim>> ] bi
 | 
			
		||||
    over make-texture-display-list f texture boa ;
 | 
			
		||||
        [ dim>> texture-coords ]
 | 
			
		||||
        [ power-of-2-image make-texture ] tri
 | 
			
		||||
        f f texture boa
 | 
			
		||||
        [ nip ] [ make-texture-display-list ] 2bi >>display-list
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
M: texture dispose*
 | 
			
		||||
    [ texture>> delete-texture ]
 | 
			
		||||
    [ display-list>> delete-dlist ] bi ;
 | 
			
		||||
    [ texture>> [ delete-texture ] when* ]
 | 
			
		||||
    [ display-list>> [ delete-dlist ] when* ] bi ;
 | 
			
		||||
 | 
			
		||||
: draw-texture ( texture -- )
 | 
			
		||||
    display-list>> [ glCallList ] when* ;
 | 
			
		||||
 | 
			
		||||
: draw-scaled-texture ( dim texture -- )
 | 
			
		||||
    dup texture>> [ draw-textured-rect ] [ 2drop ] if ;
 | 
			
		||||
| 
						 | 
				
			
			@ -22,10 +22,10 @@ PRIVATE>
 | 
			
		|||
    world get image-texture-cache [ cached-image <texture> ] cache ;
 | 
			
		||||
 | 
			
		||||
: draw-image ( image-name -- )
 | 
			
		||||
    rendered-image display-list>> glCallList ;
 | 
			
		||||
    rendered-image draw-texture ;
 | 
			
		||||
 | 
			
		||||
: draw-scaled-image ( dim image-name -- )
 | 
			
		||||
    rendered-image texture>> draw-textured-rect ;
 | 
			
		||||
    rendered-image draw-scaled-texture ;
 | 
			
		||||
 | 
			
		||||
: image-dim ( image-name -- dim )
 | 
			
		||||
    cached-image dim>> ;
 | 
			
		||||
| 
						 | 
				
			
			@ -5,7 +5,7 @@ core-text.fonts kernel hashtables namespaces sequences
 | 
			
		|||
ui.gadgets.worlds ui.text ui.text.private opengl opengl.gl
 | 
			
		||||
opengl.textures destructors combinators core-foundation
 | 
			
		||||
core-foundation.strings math math.vectors init colors colors.constants
 | 
			
		||||
cache arrays ;
 | 
			
		||||
cache arrays images ;
 | 
			
		||||
IN: ui.text.core-text
 | 
			
		||||
 | 
			
		||||
SINGLETON: core-text-renderer
 | 
			
		||||
| 
						 | 
				
			
			@ -23,10 +23,12 @@ M: core-text-renderer finish-text-rendering
 | 
			
		|||
    cached-lines get purge-cache ;
 | 
			
		||||
 | 
			
		||||
: rendered-line ( font string -- texture )
 | 
			
		||||
    world get text-handle>> [ cached-line image>> <texture> ] 2cache ;
 | 
			
		||||
    world get text-handle>>
 | 
			
		||||
    [ cached-line image>> <texture> ]
 | 
			
		||||
    2cache ;
 | 
			
		||||
 | 
			
		||||
M: core-text-renderer draw-string ( font string -- )
 | 
			
		||||
    rendered-line display-list>> glCallList ;
 | 
			
		||||
    rendered-line draw-texture ;
 | 
			
		||||
 | 
			
		||||
M: core-text-renderer x>offset ( x font string -- n )
 | 
			
		||||
    [ 2drop 0 ] [
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue