diff --git a/basis/opengl/texture-cache/texture-cache.factor b/basis/opengl/texture-cache/texture-cache.factor index 17d8db3c41..ab9f8c7244 100644 --- a/basis/opengl/texture-cache/texture-cache.factor +++ b/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 ; -:: ( dim bitmap format type -- texture ) - dim bitmap format type make-texture - dim over make-texture-display-list 0 f texture boa ; +TUPLE: texture-info dim bitmap format type ; + +C: texture-info + +: ( 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 ; -: ( -- cache ) +: ( renderer -- cache ) texture-cache new + swap >>renderer >>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 ] - [ format>> ] - [ type>> ] - tri - ] cache + '[ _ renderer>> render-texture ] cache display-list>> ; M: texture-cache dispose* diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor index 625c80817c..622d388894 100755 --- a/basis/ui/gadgets/editors/editors.factor +++ b/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>> ] when* - ] keep font>> swap { 0 0 } draw-text ; + ] keep font>> swap draw-text ; M: editor draw-gadget* - origin get [ - [ compute-selection selected-lines set ] - [ draw-lines ] - [ draw-caret ] - tri - ] with-translation ; + dup compute-selection selected-lines [ + [ draw-lines ] [ draw-caret ] bi + ] with-variable ; 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 ; diff --git a/basis/ui/gadgets/labels/labels.factor b/basis/ui/gadgets/labels/labels.factor index 89548538ee..32037310ee 100644 --- a/basis/ui/gadgets/labels/labels.factor +++ b/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* - >label< origin get draw-text ; +M: label draw-gadget* >label< draw-text ; M: label gadget-text* string>> % ; diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor index e89321c542..787a9be748 100644 --- a/basis/ui/gadgets/tables/tables.factor +++ b/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-columns ] - [ draw-lines ] - [ draw-focused-row ] - [ draw-moused-row ] - } cleave - ] with-translation + { + [ draw-selected-row ] + [ draw-columns ] + [ draw-lines ] + [ draw-focused-row ] + [ draw-moused-row ] + } cleave ] if ; M: table pref-dim* diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor index 749db69b52..f35a17583d 100644 --- a/basis/ui/gadgets/worlds/worlds.factor +++ b/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 -fry math.vectors ui.gadgets ui.gestures ui.render ui.text ui.text.private -ui.backend ui.gadgets.tracks math.rectangles ; +namespaces opengl opengl.texture-cache sequences io combinators +combinators.short-circuit fry math.vectors math.rectangles cache +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 -- ? ) diff --git a/basis/ui/render/render.factor b/basis/ui/render/render.factor index 054b65b219..9e3e0cae57 100755 --- a/basis/ui/render/render.factor +++ b/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 translate - dup interior>> [ - origin get [ dupd draw-interior ] with-translation - ] when* - dup draw-gadget* - dup visible-children [ draw-gadget ] each - dup boundary>> [ - origin get [ dupd draw-boundary ] with-translation - ] when* - drop - ] with-scope ; + dup loc>> origin get v+ origin [ + [ + origin get [ + [ dup interior>> dup [ draw-interior ] [ 2drop ] if ] + [ draw-gadget* ] + bi + ] with-translation + ] + [ visible-children [ draw-gadget ] each ] + [ + dup boundary>> dup [ + origin get [ draw-boundary ] with-translation + ] [ 2drop ] if + ] tri + ] with-variable ; : >absolute ( rect -- rect ) origin get offset-rect ; diff --git a/basis/ui/text/core-text/core-text.factor b/basis/ui/text/core-text/core-text.factor index 4b906ea02d..72fcfdd827 100644 --- a/basis/ui/text/core-text/core-text.factor +++ b/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 - - GL_BGRA_EXT >>format - GL_UNSIGNED_INT_8_8_8_8_REV >>type - core-text-renderer >>renderer - >>text-handle drop ; + core-text-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 + ; 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 -- ) - [ rendered-line glCallList ] with-translation ; +M: core-text-renderer draw-string ( font string -- ) + rendered-line glCallList ; M: core-text-renderer x>offset ( x font string -- n ) [ 2drop 0 ] [ diff --git a/basis/ui/text/freetype/freetype-docs.factor b/basis/ui/text/freetype/freetype-docs.factor index cf72e9af2f..724e7b94f1 100644 --- a/basis/ui/text/freetype/freetype-docs.factor +++ b/basis/ui/text/freetype/freetype-docs.factor @@ -34,7 +34,7 @@ HELP: { $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" } ; diff --git a/basis/ui/text/freetype/freetype.factor b/basis/ui/text/freetype/freetype.factor index fc7534666f..c8ac178d52 100644 --- a/basis/ui/text/freetype/freetype.factor +++ b/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 - widths open-font draw-background - line selection? [ widths open-font line draw-selection ] when - font foreground>> gl-color - string widths sums [ [ open-font sprites ] 2dip draw-char ] 2each - ] with-translation + font background>> gl-color + widths open-font draw-background + line selection? [ widths open-font line draw-selection ] when + font foreground>> gl-color + string widths sums [ [ open-font sprites ] 2dip draw-char ] 2each ] do-enabled ; : run-char-widths ( open-font string -- widths ) diff --git a/basis/ui/text/text-docs.factor b/basis/ui/text/text-docs.factor index 468e43191d..4ac2fbbaa8 100644 --- a/basis/ui/text/text-docs.factor +++ b/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 diff --git a/basis/ui/text/text.factor b/basis/ui/text/text.factor index f814aded09..671e10c543 100644 --- a/basis/ui/text/text.factor +++ b/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 - 0.0 swap string-height 0.0 glTranslated + [ draw-string ] + [ [ 0.0 ] 2dip string-height 0.0 glTranslated ] 2bi ] with each - ] with-translation ; \ No newline at end of file + ] do-matrix ; \ No newline at end of file diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor index 50cacd6448..56c9b15c24 100644 --- a/basis/ui/ui.factor +++ b/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 ;