opengl.textures: use GL_ARB_texture_non_power_of_two if available

basis/opengl/textures/textures.factor

@@ -3,9 +3,11 @@
 USING: accessors assocs cache colors.constants destructors fry kernel
 opengl opengl.gl combinators images images.tesselation grouping
 specialized-arrays.float sequences math math.vectors
-math.matrices generalizations fry arrays ;
+math.matrices generalizations fry arrays namespaces ;
 IN: opengl.textures
 
+SYMBOL: non-power-of-2-textures?
+
 : gen-texture ( -- id ) [ glGenTextures ] (gen-gl-object) ;
 
 : delete-texture ( id -- ) [ glDeleteTextures ] (delete-gl-object) ;
@@ -29,9 +31,14 @@ GENERIC: draw-scaled-texture ( dim texture -- )
 
 TUPLE: single-texture image dim loc texture-coords texture display-list disposed ;
 
+: adjust-texture-dim ( dim -- dim' )
+    non-power-of-2-textures? get [
+        [ next-power-of-2 ] map
+    ] unless ;
+
 : (tex-image) ( image -- )
     [ GL_TEXTURE_2D 0 GL_RGBA ] dip
-    [ dim>> first2 [ next-power-of-2 ] bi@ 0 ]
+    [ dim>> adjust-texture-dim first2 0 ]
     [ component-order>> component-order>format f ] bi
     glTexImage2D ;
 
@@ -81,7 +88,7 @@ TUPLE: single-texture image dim loc texture-coords texture display-list disposed
     ] with-texturing ;
 
 : texture-coords ( texture -- coords )
-    [ [ dim>> ] [ image>> dim>> [ next-power-of-2 ] map ] bi v/ ]
+    [ [ dim>> ] [ image>> dim>> adjust-texture-dim ] bi v/ ]
     [
         image>> upside-down?>>
         { { 0 1 } { 1 1 } { 1 0 } { 0 0 } }

basis/ui/backend/backend.factor

@@ -1,6 +1,6 @@
-! Copyright (C) 2006, 2007 Slava Pestov.
+! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel namespaces opengl opengl.gl ;
+USING: kernel namespaces opengl opengl.gl fry ;
 IN: ui.backend
 
 SYMBOL: ui-backend
@@ -28,7 +28,7 @@ GENERIC: flush-gl-context ( handle -- )
 HOOK: offscreen-pixels ui-backend ( world -- alien w h )
 
 : with-gl-context ( handle quot -- )
-    swap [ select-gl-context call ] keep
+    '[ select-gl-context @ ]
-    flush-gl-context gl-error ; inline
+    [ flush-gl-context gl-error ] bi ; inline
 
 HOOK: (with-ui) ui-backend ( quot -- )

basis/ui/gadgets/worlds/worlds.factor

@@ -1,9 +1,10 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs continuations kernel math models
-namespaces opengl sequences io combinators combinators.short-circuit
+namespaces opengl opengl.capabilities opengl.textures sequences io
-fry math.vectors math.rectangles cache ui.gadgets ui.gestures
+combinators combinators.short-circuit fry math.vectors math.rectangles
-ui.render ui.backend ui.gadgets.tracks ui.commands ;
+cache ui.gadgets ui.gestures ui.render ui.backend ui.gadgets.tracks
+ui.commands ;
 IN: ui.gadgets.worlds
 
 TUPLE: world < track
@@ -76,8 +77,13 @@ SYMBOL: flush-layout-cache-hook
 
 flush-layout-cache-hook [ [ ] ] initialize
 
+: check-extensions ( -- )
+    "2.0" { "GL_ARB_texture_non_power_of_two" } has-gl-version-or-extensions?
+    non-power-of-2-textures? set ;
+
 : (draw-world) ( world -- )
     dup handle>> [
+        check-extensions
         {
             [ init-gl ]
             [ draw-gadget ]