Working on ui.images; change draw-gadget to translate to origin for you

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

@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs cache colors.constants destructors fry
-kernel locals opengl opengl.gl ;
+kernel opengl opengl.gl combinators ;
 IN: opengl.texture-cache
 
 TUPLE: texture texture display-list age disposed ;
@@ -21,32 +21,34 @@ TUPLE: texture texture display-list age disposed ;
         ] do-enabled
     ] make-dlist ;
 
-:: <texture> ( dim bitmap format type -- texture )
+TUPLE: texture-info dim bitmap format type ;
-    dim bitmap format type make-texture
+
-    dim over make-texture-display-list 0 f texture boa ;
+C: <texture-info> texture-info
+
+: <texture> ( info -- texture )
+    [
+        { [ dim>> ] [ bitmap>> ] [ format>> ] [ type>> ] }
+        cleave make-texture
+    ] [ dim>> ] bi
+    over make-texture-display-list 0 f texture boa ;
 
 M: texture dispose*
     [ texture>> delete-texture ]
     [ display-list>> delete-dlist ] bi ;
 
-TUPLE: texture-cache format type renderer cache disposed ;
+TUPLE: texture-cache renderer cache disposed ;
 
-: <texture-cache> ( -- cache )
+: <texture-cache> ( renderer -- cache )
     texture-cache new
+        swap >>renderer
         <cache-assoc> >>cache ;
 
-GENERIC: render-texture ( key renderer -- dim bitmap )
+GENERIC: render-texture ( key renderer -- texture-info )
 
 : get-texture ( key texture-cache -- dlist )
     dup check-disposed
     [ cache>> ] keep
-    '[
+    '[ _ renderer>> render-texture <texture> ] cache
-        _
-        [ renderer>> render-texture ]
-        [ format>> ]
-        [ type>> ]
-        tri <texture>
-    ] cache
     display-list>> ;
 
 M: texture-cache dispose*

basis/ui/gadgets/editors/editors.factor

@@ -172,15 +172,12 @@ M: editor draw-line ( line index editor -- )
     [
         [ selected-lines get at ] dip
         '[ first2 _ selection-color>> <selection> ] when*
-    ] keep font>> swap { 0 0 } draw-text ;
+    ] keep font>> swap draw-text ;
 
 M: editor draw-gadget*
-    origin get [
+    dup compute-selection selected-lines [
-        [ compute-selection selected-lines set ]
+        [ draw-lines ] [ draw-caret ] bi
-        [ draw-lines ]
+    ] with-variable ;
-        [ draw-caret ]
-        tri
-    ] with-translation ;
 
 M: editor pref-dim*
     [ font>> ] [ control-value ] bi text-dim ;
@@ -260,7 +257,7 @@ M: editor gadget-text* editor-string % ;
     swap caret>> set-model ;
 
 : editor-cut ( editor clipboard -- )
-    dupd gadget-copy remove-selection ;
+    [ gadget-copy ] [ drop remove-selection ] 2bi ;
 
 : delete/backspace ( editor quot -- )
     over gadget-selection? [
@@ -281,7 +278,7 @@ M: editor gadget-text* editor-string % ;
     '[ _ prev-elt ] change-caret ;
 
 : editor-prev ( editor elt -- )
-    dupd editor-select-prev mark>caret ;
+    [ editor-select-prev ] [ drop mark>caret ] 2bi ;
 
 : editor-select-next ( editor elt -- )
     '[ _ next-elt ] change-caret ;

basis/ui/gadgets/labels/labels.factor

@@ -55,8 +55,7 @@ M: label baseline
     >label< dup string? [ first ] unless
     line-metrics ascent>> round ;
 
-M: label draw-gadget*
+M: label draw-gadget* >label< draw-text ;
-    >label< origin get draw-text ;
 
 M: label gadget-text* string>> % ;
 

basis/ui/gadgets/tables/tables.factor

@@ -128,7 +128,7 @@ M: table layout*
 
 : draw-column ( font column width align -- )
     over [
-        [ 2dup ] 2dip column-loc draw-text
+        [ 2dup ] 2dip column-loc [ draw-text ] with-translation
     ] dip table-gap + 0 2array gl-translate ;
 
 : column-alignment ( table -- seq )
@@ -152,15 +152,13 @@ M: table draw-line ( row index table -- )
 
 M: table draw-gadget*
     dup control-value empty? [ drop ] [
-        origin get [
+        {
-            {
+            [ draw-selected-row ]
-                [ draw-selected-row ]
+            [ draw-columns ]
-                [ draw-columns ]
+            [ draw-lines ]
-                [ draw-lines ]
+            [ draw-focused-row ]
-                [ draw-focused-row ]
+            [ draw-moused-row ]
-                [ draw-moused-row ]
+        } cleave
-            } cleave
-        ] with-translation
     ] if ;
 
 M: table pref-dim*

basis/ui/gadgets/worlds/worlds.factor

@@ -1,16 +1,17 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs continuations kernel math models call
-namespaces opengl sequences io combinators combinators.short-circuit
+namespaces opengl opengl.texture-cache sequences io combinators
-fry math.vectors ui.gadgets ui.gestures ui.render ui.text ui.text.private
+combinators.short-circuit fry math.vectors math.rectangles cache
-ui.backend ui.gadgets.tracks math.rectangles ;
+ui.gadgets ui.gestures ui.render ui.text ui.text.private ui.backend
+ui.gadgets.tracks ;
 IN: ui.gadgets.worlds
 
 TUPLE: world < track
 active? focused?
 glass
 title status
-text-handle handle
+text-handle handle images
 window-loc ;
 
 : find-world ( gadget -- world/f ) [ world? ] find-parent ;
@@ -62,7 +63,12 @@ M: world children-on nip children>> ;
 
 : (draw-world) ( world -- )
     dup handle>> [
-        [ init-gl ] [ draw-gadget ] [ finish-text-rendering ] tri
+        {
+            [ init-gl ]
+            [ draw-gadget ]
+            [ finish-text-rendering ]
+            [ images>> [ purge-texture-cache ] when* ]
+        } cleave
     ] with-gl-context ;
 
 : draw-world? ( world -- ? )

basis/ui/render/render.factor

@@ -54,25 +54,28 @@ SYMBOL: origin
 { 0 0 } origin set-global
 
 : visible-children ( gadget -- seq )
-    clip get origin get vneg offset-rect swap children-on ;
+    [ clip get origin get vneg offset-rect ] dip children-on ;
 
 : translate ( rect/point -- ) loc>> origin [ v+ ] change ;
 
 DEFER: draw-gadget
 
 : (draw-gadget) ( gadget -- )
-    [
+    dup loc>> origin get v+ origin [
-        dup translate
+        [
-        dup interior>> [
+            origin get [
-            origin get [ dupd draw-interior ] with-translation
+                [ dup interior>> dup [ draw-interior ] [ 2drop ] if ]
-        ] when*
+                [ draw-gadget* ]
-        dup draw-gadget*
+                bi
-        dup visible-children [ draw-gadget ] each
+            ] with-translation
-        dup boundary>> [
+        ]
-            origin get [ dupd draw-boundary ] with-translation
+        [ visible-children [ draw-gadget ] each ]
-        ] when*
+        [
-        drop
+            dup boundary>> dup [
-    ] with-scope ;
+                origin get [ draw-boundary ] with-translation
+            ] [ 2drop ] if
+        ] tri
+    ] with-variable ;
 
 : >absolute ( rect -- rect )
     origin get offset-rect ;

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

@@ -11,17 +11,16 @@ IN: ui.text.core-text
 SINGLETON: core-text-renderer
 
 M: core-text-renderer init-text-rendering
-    <texture-cache>
+    core-text-renderer <texture-cache> >>text-handle drop ;
-        GL_BGRA_EXT >>format
-        GL_UNSIGNED_INT_8_8_8_8_REV >>type
-        core-text-renderer >>renderer
-    >>text-handle drop ;
 
 M: core-text-renderer string-dim
     [ " " string-dim { 0 1 } v* ] [ cached-line dim>> ] if-empty ;
 
 M: core-text-renderer render-texture
-    drop first2 cached-line [ dim>> ] [ bitmap>> ] bi ;
+    drop first2 cached-line
+    [ 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
@@ -30,8 +29,8 @@ M: core-text-renderer finish-text-rendering
 : rendered-line ( font string -- display-list )
     2array world get text-handle>> get-texture ;
 
-M: core-text-renderer draw-string ( font string loc -- )
+M: core-text-renderer draw-string ( font string -- )
-    [ rendered-line glCallList ] with-translation ;
+    rendered-line glCallList ;
 
 M: core-text-renderer x>offset ( x font string -- n )
     [ 2drop 0 ] [

basis/ui/text/freetype/freetype-docs.factor

@@ -34,7 +34,7 @@ HELP: <char-sprite>
 { $description "Renders a character to an OpenGL texture and records a display list which draws a quad with this texture. This word allocates native resources which must be freed by " { $link free-sprites } "." } ;
 
 HELP: (draw-string)
-{ $values { "font" freetype-font } { "sprites" "a vector of " { $link sprite } " instances" } { "string" string } { "loc" "a pair of integers" } }
+{ $values { "font" freetype-font } { "sprites" "a vector of " { $link sprite } " instances" } { "string" string } }
 { $description "Draws a line of text." }
 { $notes "This is a low-level word, UI code should use " { $link draw-string } " or " { $link draw-text } " instead." }
 { $side-effects "sprites" } ;

basis/ui/text/freetype/freetype.factor

@@ -196,19 +196,17 @@ M: freetype-renderer string-height ( font string -- h )
         open-font height>> 2array gl-fill-rect
     ] with-translation ;
 
-M:: freetype-renderer draw-string ( font line loc -- )
+M:: freetype-renderer draw-string ( font line -- )
     line dup selection? [ string>> ] when :> string
     font open-font :> open-font
     open-font world get font-sprites :> sprites
     open-font string char-widths :> widths
     GL_TEXTURE_2D [
-        loc [
+        font background>> gl-color
-            font background>> gl-color
+        widths open-font draw-background
-            widths open-font draw-background
+        line selection? [ widths open-font line draw-selection ] when
-            line selection? [ widths open-font line draw-selection ] when
+        font foreground>> gl-color
-            font foreground>> gl-color
+        string widths sums [ [ open-font sprites ] 2dip draw-char ] 2each
-            string widths sums [ [ open-font sprites ] 2dip draw-char ] 2each
-        ] with-translation
     ] do-enabled ;
 
 : run-char-widths ( open-font string -- widths )

basis/ui/text/text-docs.factor

@@ -29,11 +29,11 @@ HELP: text-dim
 { $description "Outputs the dimensions of a piece of text, which is either a single-line string or an array of lines." } ;
 
 HELP: draw-string
-{ $values { "font" font } { "string" string } { "loc" "a pair of integers" } }
+{ $values { "font" font } { "string" string } }
 { $contract "Draws a line of text." } ;
 
 HELP: draw-text
-{ $values { "font" font } { "text" "a string or an array of strings" } { "loc" "a pair of integers" } }
+{ $values { "font" font } { "text" "a string or an array of strings" } }
 { $description "Draws a piece of text." } ;
 
 HELP: x>offset

basis/ui/text/text.factor

@@ -26,7 +26,7 @@ M: object string-width string-dim first ;
 
 M: object string-height string-dim second ;
 
-HOOK: draw-string font-renderer ( font string loc -- )
+HOOK: draw-string font-renderer ( font string -- )
 
 HOOK: free-fonts font-renderer ( world -- )
 
@@ -54,16 +54,16 @@ M: array text-dim
 
 HOOK: line-metrics font-renderer ( font string -- metrics )
 
-GENERIC# draw-text 1 ( font text loc -- )
+GENERIC: draw-text ( font text -- )
 
 M: string draw-text draw-string ;
 
 M: selection draw-text draw-string ;
 
 M: array draw-text
-    [
+    GL_MODELVIEW [
         [
-            2dup { 0 0 } draw-string
+            [ draw-string ]
-            0.0 swap string-height 0.0 glTranslated
+            [ [ 0.0 ] 2dip string-height 0.0 glTranslated ] 2bi
         ] with each
-    ] with-translation ;
+    ] do-matrix ;

basis/ui/ui.factor

@@ -62,6 +62,7 @@ M: world graft*
     {
         [ handle>> select-gl-context ]
         [ text-handle>> dispose ]
+        [ images>> [ dispose ] when* ]
         [ hand-clicked close-global ]
         [ hand-gadget close-global ]
     } cleave ;