Minimize OpenGL state changes

diff --git a/library/ui/freetype/freetype-gl.factor b/library/ui/freetype/freetype-gl.factor
index 30f385ad3aeff7f25b31cbc64d9bf41d5ce89600..51dcf4669951441d6d3048b374b1212878d6fb97 100644 (file)
--- a/library/ui/freetype/freetype-gl.factor
+++ b/library/ui/freetype/freetype-gl.factor
@@ -160,17 +160,13 @@ C: font ( handle -- font )
     over glyph-size pick glyph-texture-size <sprite>
     [ bitmap>texture ] keep [ init-sprite ] keep ;
 
-: char-sprite ( open-font char sprites -- sprite )
-    #! Get a cached display list of a FreeType-rendered
-    #! glyph.
-    [ dupd <char-sprite> ] cache-nth nip ;
+: draw-char ( open-font char sprites -- )
+    [ dupd <char-sprite> ] cache-nth nip
+    sprite-dlist glCallList ;
 
-: (draw-string) ( open-font sprites string -- )
+: (draw-string) ( open-font sprites string loc -- )
     GL_TEXTURE_2D [
-        GL_MODELVIEW [
-            [
-                >r 2dup r> swap char-sprite
-                sprite-dlist glCallList
-            ] each 2drop
-        ] do-matrix
+        [
+            [ >r 2dup r> swap draw-char ] each 2drop
+        ] with-translation
     ] do-enabled ;

diff --git a/library/ui/gadgets/grid-lines.factor b/library/ui/gadgets/grid-lines.factor
index 78bee3363bd85279a82773abd888bb48625ac523..157a8ae0515533238628e51cbfa5f71e93473885 100644 (file)
--- a/library/ui/gadgets/grid-lines.factor
+++ b/library/ui/gadgets/grid-lines.factor
@@ -22,10 +22,10 @@ SYMBOL: grid-dim
 
 M: grid-lines draw-boundary
     #! Clean this up later.
-    GL_MODELVIEW [
+    origin get [
         grid-lines-color gl-color [
             grid get rect-dim half-gap v- grid-dim set
             { 0 1 } draw-grid-lines
             { 1 0 } draw-grid-lines
         ] with-grid
-    ] do-matrix ;
+    ] with-translation ;

diff --git a/library/ui/gadgets/labels.factor b/library/ui/gadgets/labels.factor
index 6799f24ef426982f26e71a5a563f2b5478400a85..3ceba9e69f246a24251467c7d94eaafdcbf70bfb 100644 (file)
--- a/library/ui/gadgets/labels.factor
+++ b/library/ui/gadgets/labels.factor
@@ -21,7 +21,8 @@ M: label pref-dim* label-size ;
 
 : draw-label ( label -- )
     dup label-color gl-color
-    dup label-font swap label-text draw-string ;
+    dup label-font swap label-text
+    origin get draw-string ;
 
 M: label draw-gadget* draw-label ;
 

diff --git a/library/ui/gadgets/lists.factor b/library/ui/gadgets/lists.factor
index f1ac40ed76f81f5e9ea2dc85c59ca41e4d70ad1b..8329b1130793f6a94f262c2fe001f62adf00f748 100644 (file)
--- a/library/ui/gadgets/lists.factor
+++ b/library/ui/gadgets/lists.factor
@@ -31,9 +31,7 @@ M: list model-changed
 
 M: list draw-gadget*
     dup list-color gl-color
-    selected-rect [
-        rect-bounds swap [ gl-fill-rect ] with-translation
-    ] when* ;
+    selected-rect [ rect-bounds gl-fill-rect ] when* ;
 
 M: list focusable-child* drop t ;
 

diff --git a/library/ui/opengl/opengl-utils.factor b/library/ui/opengl/opengl-utils.factor
index db4e99183e33a900ec1b0819ab4fce6915721eba..dabb4a24a308c1b6b1a8689fc4c2da3dc7eb8491 100644 (file)
--- a/library/ui/opengl/opengl-utils.factor
+++ b/library/ui/opengl/opengl-utils.factor
@@ -21,33 +21,19 @@ sequences ;
     swap [ glMatrixMode glPushMatrix call ] keep
     glMatrixMode glPopMatrix ; inline
 
-: top-left drop 0 0 glTexCoord2i 0.0 0.0 glVertex2d ; inline
-
-: top-right 1 0 glTexCoord2i first 0.0 glVertex2d ; inline
-
-: bottom-left 0 1 glTexCoord2i second 0.0 swap glVertex2d ; inline
-
 : gl-vertex first2 glVertex2i ; inline
 
-: bottom-right 1 1 glTexCoord2i gl-vertex ; inline
-
-: four-sides ( dim -- )
-    dup top-left dup top-right dup bottom-right bottom-left ;
-
 : gl-line ( a b -- )
     GL_LINES [ gl-vertex gl-vertex ] do-state ;
 
-: gl-fill-rect ( dim -- )
+: gl-fill-rect ( loc dim -- )
     #! Draws a two-dimensional box.
-    GL_QUADS [ four-sides ] do-state ;
+    [ first2 ] 2apply glRectd ;
 
-: gl-rect ( dim -- )
+: gl-rect ( loc dim -- )
     #! Draws a two-dimensional box.
     GL_FRONT_AND_BACK GL_LINE glPolygonMode
-    GL_MODELVIEW [
-        0.5 0.5 0.0 glTranslated { 1 1 } v-
-        GL_QUADS [ dup four-sides top-left ] do-state
-    ] do-matrix
+    gl-fill-rect
     GL_FRONT_AND_BACK GL_FILL glPolygonMode ;
 
 : (gl-poly) [ [ gl-vertex ] each ] do-state ;
@@ -120,11 +106,22 @@ C: sprite ( loc dim dim2 -- sprite )
 
 : gl-translate ( point -- ) first2 0.0 glTranslated ;
 
+: top-left drop 0 0 glTexCoord2i 0.0 0.0 glVertex2d ; inline
+
+: top-right 1 0 glTexCoord2i first 0.0 glVertex2d ; inline
+
+: bottom-left 0 1 glTexCoord2i second 0.0 swap glVertex2d ; inline
+
+: bottom-right 1 1 glTexCoord2i gl-vertex ; inline
+
+: four-sides ( dim -- )
+    dup top-left dup top-right dup bottom-right bottom-left ;
+
 : draw-sprite ( sprite -- )
     dup sprite-loc gl-translate
     GL_TEXTURE_2D over sprite-texture glBindTexture
     init-texture
-    dup sprite-dim2 gl-fill-rect
+    GL_QUADS [ dup sprite-dim2 four-sides ] do-state
     dup sprite-dim { 1 0 } v*
     swap sprite-loc v- gl-translate
     GL_TEXTURE_2D 0 glBindTexture ;
@@ -143,3 +140,6 @@ C: sprite ( loc dim dim2 -- sprite )
     sprite-texture <uint> 1 swap glDeleteTextures ;
 
 : free-sprites ( sprites -- ) [ [ free-sprite ] when* ] each ;
+
+: with-translation ( loc quot -- )
+    GL_MODELVIEW [ >r gl-translate r> call ] do-matrix ; inline

diff --git a/library/ui/paint.factor b/library/ui/paint.factor
index 0a00c06e7a79367bfc87715d3a8c279b73aee6ff..64e216fbab02d56ec1fcaaa4320fce47cbc5e1ca 100644 (file)
--- a/library/ui/paint.factor
+++ b/library/ui/paint.factor
@@ -35,18 +35,15 @@ GENERIC: draw-boundary ( gadget boundary -- )
 
 DEFER: draw-gadget
 
-: with-translation ( loc quot -- )
-    over translate over gl-translate
-    swap slip
-    vneg dup translate gl-translate ; inline
-
 : (draw-gadget) ( gadget -- )
-    dup rect-loc [
-        dup dup gadget-interior draw-interior
+    [
+        dup rect-loc translate
+        ! dup dup gadget-interior draw-interior
         dup draw-gadget*
         dup visible-children [ draw-gadget ] each
-        dup gadget-boundary draw-boundary
-    ] with-translation ;
+        ! dup gadget-boundary draw-boundary
+        drop
+    ] with-scope ;
 
 : change-clip ( gadget -- )
     >absolute clip [ rect-intersect ] change ;
@@ -85,24 +82,29 @@ M: f draw-boundary 2drop ;
 TUPLE: solid color ;
 
 ! Solid pen
-M: solid draw-interior
-    solid-color gl-color rect-dim gl-fill-rect ;
+: (solid) solid-color gl-color rect-dim >r origin get r> ;
 
-M: solid draw-boundary
-    solid-color gl-color rect-dim gl-rect ;
+M: solid draw-interior (solid) gl-fill-rect ;
+
+M: solid draw-boundary (solid) gl-rect ;
 
 ! Gradient pen
 TUPLE: gradient colors ;
 
 M: gradient draw-interior
-    over gadget-orientation swap gradient-colors rot rect-dim
-    gl-gradient ;
+    origin get [
+        over gadget-orientation
+        swap gradient-colors
+        rot rect-dim
+        gl-gradient
+    ] with-translation ;
 
 ! Polygon pen
 TUPLE: polygon color points ;
 
 : draw-polygon ( polygon quot -- )
-    >r dup polygon-color gl-color polygon-points r> each ; inline
+    >r dup polygon-color gl-color polygon-points r> each ;
+    inline
 
 M: polygon draw-boundary
     [ gl-poly ] draw-polygon drop ;

diff --git a/library/ui/text/editor.factor b/library/ui/text/editor.factor
index ccba9944130679845cc64373b4fc559c7b20f354..0cae053e228995f24aef031bde5780a3557c533a 100644 (file)
--- a/library/ui/text/editor.factor
+++ b/library/ui/text/editor.factor
@@ -128,15 +128,19 @@ M: loc-monitor model-changed
     editor get editor-focused? [
         editor get
         dup editor-caret-color gl-color
-        dup caret-loc swap caret-dim over v+ gl-line
+        dup caret-loc origin get v+
+        swap caret-dim over v+ gl-line
     ] when ;
 
+: line-translation ( n -- loc )
+    editor get line-height * 0.0 swap 2array ;
+
 : translate-lines ( n -- )
-    editor get line-height * 0.0 swap 0.0 glTranslated ;
+    line-translation gl-translate ;
 
 : draw-line ( editor str -- )
-    over editor-color gl-color
-    >r editor-font r> draw-string ;
+    >r dup editor-color gl-color editor-font r>
+    { 0 0 } draw-string ;
 
 : first-visible-line ( editor -- n )
     clip get rect-loc second origin get second -
@@ -161,12 +165,15 @@ M: loc-monitor model-changed
     \ last-visible-line get
     rot control-value <slice> ;
 
+: with-editor-translation ( n quot -- )
+    >r line-translation origin get v+ r> with-translation ;
+    inline
+
 : draw-lines ( -- )
-    GL_MODELVIEW [
-        \ first-visible-line get translate-lines
+    \ first-visible-line get [
         editor get dup visible-lines
         [ draw-line 1 translate-lines ] each-with
-    ] do-matrix ;
+    ] with-editor-translation ;
 
 : selection-start/end ( editor -- start end )
     dup editor-mark* swap editor-caret*
@@ -183,16 +190,14 @@ M: loc-monitor model-changed
     (draw-selection) ;
 
 : draw-selection ( -- )
-    GL_MODELVIEW [
-        editor get
-        dup editor-selection-color gl-color
-        selection-start/end
-        over first translate-lines
+    editor get editor-selection-color gl-color
+    editor get selection-start/end
+    over first [
         2dup [
             >r 2dup r> draw-selected-line
             1 translate-lines
         ] each-line 2drop
-    ] do-matrix ;
+    ] with-editor-translation ;
 
 M: editor draw-gadget*
     [ draw-selection draw-lines draw-caret ] with-editor ;

diff --git a/library/ui/world.factor b/library/ui/world.factor
index 139de9e0e9dd8cb9f093011134c4a77f62d45ea7..f56a613ad8d68dfe3fc1456bad7f1a4df7c642f7 100644 (file)
--- a/library/ui/world.factor
+++ b/library/ui/world.factor
@@ -64,8 +64,8 @@ M: world model-changed
 : font-sprites ( font world -- pair )
     world-fonts [ lookup-font V{ } clone 2array ] cache ;
 
-: draw-string ( font string -- )
-    >r world get font-sprites first2 r> (draw-string) ;
+: draw-string ( font string loc -- )
+    >r >r world get font-sprites first2 r> r> (draw-string) ;
 
 M: world gadget-title world-gadget gadget-title ;