diff --git a/basis/opengl/textures/textures.factor b/basis/opengl/textures/textures.factor index 3efe924fb5..cdd421ddde 100755 --- a/basis/opengl/textures/textures.factor +++ b/basis/opengl/textures/textures.factor @@ -2,8 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs cache colors.constants destructors fry kernel opengl opengl.gl combinators images images.tesselation grouping -specialized-arrays.float locals sequences math math.vectors -math.matrices generalizations fry columns arrays ; +specialized-arrays.float sequences math math.vectors +math.matrices generalizations fry arrays ; IN: opengl.textures : gen-texture ( -- id ) [ glGenTextures ] (gen-gl-object) ; @@ -19,61 +19,42 @@ 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_BYTE ; M: BGRX component-order>format drop GL_BGRA_EXT GL_UNSIGNED_BYTE ; -GENERIC: draw-texture ( texture -- ) +SLOT: display-list + +: draw-texture ( texture -- ) display-list>> [ glCallList ] when* ; GENERIC: draw-scaled-texture ( dim texture -- ) > first2 [ next-power-of-2 ] bi@ 0 ] + [ component-order>> component-order>format f ] bi + glTexImage2D ; -: power-of-2-bitmap ( rows dim size -- bitmap dim ) - '[ - first2 - [ [ _ ] dip '[ _ group _ repeat-last ] map ] - [ repeat-last ] - bi* - ] keep ; +: (tex-sub-image) ( image -- ) + [ GL_TEXTURE_2D 0 0 0 ] dip + [ dim>> first2 ] [ component-order>> component-order>format ] [ bitmap>> ] tri + glTexSubImage2D ; -: image-rows ( image -- rows ) - [ bitmap>> ] - [ dim>> first ] - [ component-order>> bytes-per-pixel ] - tri * group ; inline - -: power-of-2-image ( image -- image ) - dup dim>> [ [ 0 = ] [ power-of-2? ] bi or ] all? [ - clone dup - [ image-rows ] - [ dim>> [ next-power-of-2 ] map ] - [ component-order>> bytes-per-pixel ] tri - power-of-2-bitmap - [ >>bitmap ] [ >>dim ] bi* - ] unless ; - -:: make-texture ( image -- id ) +: make-texture ( image -- id ) + #! We use glTexSubImage2D to work around the power of 2 texture size + #! limitation 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 + [ (tex-image) ] [ (tex-sub-image) ] bi ] 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 ; + GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_NEAREST glTexParameteri + GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_NEAREST glTexParameteri + GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_CLAMP_TO_EDGE glTexParameteri + GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_CLAMP_TO_EDGE glTexParameteri ; : with-texturing ( quot -- ) GL_TEXTURE_2D [ @@ -101,7 +82,7 @@ TUPLE: single-texture image loc dim texture-coords texture display-list disposed : texture-coords ( texture -- coords ) [ - [ dim>> ] [ image>> dim>> ] bi v/ + [ dim>> ] [ image>> dim>> [ next-power-of-2 ] map ] bi v/ { { 0 0 } { 1 0 } { 1 1 } { 0 1 } } [ v* ] with map ] keep @@ -111,9 +92,8 @@ TUPLE: single-texture image loc dim texture-coords texture display-list disposed : make-texture-display-list ( texture -- dlist ) GL_COMPILE [ [ dim>> ] keep draw-textured-rect ] make-dlist ; -: ( image loc dim -- texture ) - [ power-of-2-image ] 2dip - single-texture new swap >>dim swap >>loc swap >>image +: ( image loc -- texture ) + single-texture new swap >>loc swap [ >>image ] [ dim>> >>dim ] bi dup image>> dim>> product 0 = [ dup texture-coords >>texture-coords dup image>> make-texture >>texture @@ -124,21 +104,19 @@ M: single-texture dispose* [ texture>> [ delete-texture ] when* ] [ display-list>> [ delete-dlist ] when* ] bi ; -M: single-texture draw-texture display-list>> [ glCallList ] when* ; - M: single-texture draw-scaled-texture dup texture>> [ draw-textured-rect ] [ 2drop ] if ; TUPLE: multi-texture grid display-list loc disposed ; : image-locs ( image-grid -- loc-grid ) - [ first [ dim>> first ] map ] [ 0 [ dim>> second ] map ] bi + [ first [ dim>> first ] map ] [ [ first dim>> second ] map ] bi [ 0 [ + ] accumulate nip ] bi@ cross-zip flip ; : ( image-grid loc -- grid ) [ dup image-locs ] dip - '[ [ _ v+ over dim>> |dispose ] 2map ] 2map ; + '[ [ _ v+ |dispose ] 2map ] 2map ; : draw-textured-grid ( grid -- ) [ [ [ dim>> ] keep (draw-textured-rect) ] each ] each ; @@ -165,18 +143,13 @@ TUPLE: multi-texture grid display-list loc disposed ; f multi-texture boa ] with-destructors ; -M: multi-texture draw-texture display-list>> [ glCallList ] when* ; - M: multi-texture dispose* grid>> [ [ dispose ] each ] each ; CONSTANT: max-texture-size { 512 512 } PRIVATE> -: small-texture? ( dim -- ? ) - max-texture-size [ <= ] 2all? ; - -: ( image loc dim -- texture ) - pick dim>> small-texture? +: ( image loc -- texture ) + over dim>> max-texture-size [ <= ] 2all? [ ] - [ drop [ max-texture-size tesselate ] dip ] if ; \ No newline at end of file + [ [ max-texture-size tesselate ] dip ] if ; \ No newline at end of file diff --git a/basis/ui/images/images.factor b/basis/ui/images/images.factor index 8e36f2a3b1..2b1caa8ab9 100755 --- a/basis/ui/images/images.factor +++ b/basis/ui/images/images.factor @@ -20,7 +20,7 @@ PRIVATE> : rendered-image ( path -- texture ) world get image-texture-cache - [ cached-image [ { 0 0 } ] keep dim>> ] cache ; + [ cached-image { 0 0 } ] cache ; : draw-image ( image-name -- ) rendered-image draw-texture ; diff --git a/basis/ui/text/core-text/core-text.factor b/basis/ui/text/core-text/core-text.factor index 404624da95..0d720ac0b1 100755 --- a/basis/ui/text/core-text/core-text.factor +++ b/basis/ui/text/core-text/core-text.factor @@ -20,9 +20,7 @@ M: core-text-renderer flush-layout-cache : rendered-line ( font string -- texture ) world get world-text-handle [ - cached-line - [ image>> ] [ loc>> ] [ image>> dim>> ] tri - + cached-line [ image>> ] [ loc>> ] bi ] 2cache ; M: core-text-renderer draw-string ( font string -- ) diff --git a/basis/ui/text/pango/pango.factor b/basis/ui/text/pango/pango.factor index 46328d11d5..92c4fe5c75 100755 --- a/basis/ui/text/pango/pango.factor +++ b/basis/ui/text/pango/pango.factor @@ -16,9 +16,7 @@ M: pango-renderer flush-layout-cache : rendered-layout ( font string -- texture ) world get world-text-handle [ - cached-layout - [ image>> ] [ text-position vneg ] [ image>> dim>> ] tri - + cached-layout [ image>> ] [ text-position vneg ] bi ] 2cache ; M: pango-renderer draw-string ( font string -- ) diff --git a/basis/ui/text/uniscribe/uniscribe.factor b/basis/ui/text/uniscribe/uniscribe.factor index dcec4ab17e..d56da86b86 100755 --- a/basis/ui/text/uniscribe/uniscribe.factor +++ b/basis/ui/text/uniscribe/uniscribe.factor @@ -16,7 +16,7 @@ M: uniscribe-renderer flush-layout-cache : rendered-script-string ( font string -- texture ) world get world-text-handle - [ cached-script-string [ image>> { 0 0 } ] [ size>> ] bi ] + [ cached-script-string image>> { 0 0 } ] 2cache ; M: uniscribe-renderer draw-string ( font string -- ) diff --git a/basis/windows/uniscribe/uniscribe.factor b/basis/windows/uniscribe/uniscribe.factor index 53d2d9918f..7cfda41dc9 100755 --- a/basis/windows/uniscribe/uniscribe.factor +++ b/basis/windows/uniscribe/uniscribe.factor @@ -71,11 +71,8 @@ TUPLE: script-string font string metrics ssa size image disposed ; : draw-script-string ( dc script-string -- ) [ font>> set-dc-colors ] keep (draw-script-string) ; -: script-string-bitmap-size ( script-string -- dim ) - size>> dup small-texture? [ [ next-power-of-2 ] map ] when ; - :: make-script-string-image ( dc script-string -- image ) - script-string script-string-bitmap-size dc + script-string size>> dc [ dc script-string draw-script-string ] make-bitmap-image ; : set-dc-font ( dc font -- )