Working on ui.images; change draw-gadget to translate to origin for you
parent
f14d6b79c6
commit
d1a5bf2073
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2009 Slava Pestov.
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors assocs cache colors.constants destructors fry
|
USING: accessors assocs cache colors.constants destructors fry
|
||||||
kernel locals opengl opengl.gl ;
|
kernel opengl opengl.gl combinators ;
|
||||||
IN: opengl.texture-cache
|
IN: opengl.texture-cache
|
||||||
|
|
||||||
TUPLE: texture texture display-list age disposed ;
|
TUPLE: texture texture display-list age disposed ;
|
||||||
|
@ -21,32 +21,34 @@ TUPLE: texture texture display-list age disposed ;
|
||||||
] do-enabled
|
] do-enabled
|
||||||
] make-dlist ;
|
] 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*
|
M: texture dispose*
|
||||||
[ texture>> delete-texture ]
|
[ texture>> delete-texture ]
|
||||||
[ display-list>> delete-dlist ] bi ;
|
[ 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
|
texture-cache new
|
||||||
|
swap >>renderer
|
||||||
<cache-assoc> >>cache ;
|
<cache-assoc> >>cache ;
|
||||||
|
|
||||||
GENERIC: render-texture ( key renderer -- dim bitmap )
|
GENERIC: render-texture ( key renderer -- texture-info )
|
||||||
|
|
||||||
: get-texture ( key texture-cache -- dlist )
|
: get-texture ( key texture-cache -- dlist )
|
||||||
dup check-disposed
|
dup check-disposed
|
||||||
[ cache>> ] keep
|
[ cache>> ] keep
|
||||||
'[
|
'[ _ renderer>> render-texture <texture> ] cache
|
||||||
_
|
|
||||||
[ renderer>> render-texture ]
|
|
||||||
[ format>> ]
|
|
||||||
[ type>> ]
|
|
||||||
tri <texture>
|
|
||||||
] cache
|
|
||||||
display-list>> ;
|
display-list>> ;
|
||||||
|
|
||||||
M: texture-cache dispose*
|
M: texture-cache dispose*
|
||||||
|
|
|
@ -172,15 +172,12 @@ M: editor draw-line ( line index editor -- )
|
||||||
[
|
[
|
||||||
[ selected-lines get at ] dip
|
[ selected-lines get at ] dip
|
||||||
'[ first2 _ selection-color>> <selection> ] when*
|
'[ first2 _ selection-color>> <selection> ] when*
|
||||||
] keep font>> swap { 0 0 } draw-text ;
|
] keep font>> swap draw-text ;
|
||||||
|
|
||||||
M: editor draw-gadget*
|
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*
|
M: editor pref-dim*
|
||||||
[ font>> ] [ control-value ] bi text-dim ;
|
[ font>> ] [ control-value ] bi text-dim ;
|
||||||
|
@ -260,7 +257,7 @@ M: editor gadget-text* editor-string % ;
|
||||||
swap caret>> set-model ;
|
swap caret>> set-model ;
|
||||||
|
|
||||||
: editor-cut ( editor clipboard -- )
|
: editor-cut ( editor clipboard -- )
|
||||||
dupd gadget-copy remove-selection ;
|
[ gadget-copy ] [ drop remove-selection ] 2bi ;
|
||||||
|
|
||||||
: delete/backspace ( editor quot -- )
|
: delete/backspace ( editor quot -- )
|
||||||
over gadget-selection? [
|
over gadget-selection? [
|
||||||
|
@ -281,7 +278,7 @@ M: editor gadget-text* editor-string % ;
|
||||||
'[ _ prev-elt ] change-caret ;
|
'[ _ prev-elt ] change-caret ;
|
||||||
|
|
||||||
: editor-prev ( editor elt -- )
|
: editor-prev ( editor elt -- )
|
||||||
dupd editor-select-prev mark>caret ;
|
[ editor-select-prev ] [ drop mark>caret ] 2bi ;
|
||||||
|
|
||||||
: editor-select-next ( editor elt -- )
|
: editor-select-next ( editor elt -- )
|
||||||
'[ _ next-elt ] change-caret ;
|
'[ _ next-elt ] change-caret ;
|
||||||
|
|
|
@ -55,8 +55,7 @@ M: label baseline
|
||||||
>label< dup string? [ first ] unless
|
>label< dup string? [ first ] unless
|
||||||
line-metrics ascent>> round ;
|
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>> % ;
|
M: label gadget-text* string>> % ;
|
||||||
|
|
||||||
|
|
|
@ -128,7 +128,7 @@ M: table layout*
|
||||||
|
|
||||||
: draw-column ( font column width align -- )
|
: draw-column ( font column width align -- )
|
||||||
over [
|
over [
|
||||||
[ 2dup ] 2dip column-loc draw-text
|
[ 2dup ] 2dip column-loc [ draw-text ] with-translation
|
||||||
] dip table-gap + 0 2array gl-translate ;
|
] dip table-gap + 0 2array gl-translate ;
|
||||||
|
|
||||||
: column-alignment ( table -- seq )
|
: column-alignment ( table -- seq )
|
||||||
|
@ -152,15 +152,13 @@ M: table draw-line ( row index table -- )
|
||||||
|
|
||||||
M: table draw-gadget*
|
M: table draw-gadget*
|
||||||
dup control-value empty? [ drop ] [
|
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 ;
|
] if ;
|
||||||
|
|
||||||
M: table pref-dim*
|
M: table pref-dim*
|
||||||
|
|
|
@ -1,16 +1,17 @@
|
||||||
! Copyright (C) 2005, 2009 Slava Pestov.
|
! Copyright (C) 2005, 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors arrays assocs continuations kernel math models call
|
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
|
IN: ui.gadgets.worlds
|
||||||
|
|
||||||
TUPLE: world < track
|
TUPLE: world < track
|
||||||
active? focused?
|
active? focused?
|
||||||
glass
|
glass
|
||||||
title status
|
title status
|
||||||
text-handle handle
|
text-handle handle images
|
||||||
window-loc ;
|
window-loc ;
|
||||||
|
|
||||||
: find-world ( gadget -- world/f ) [ world? ] find-parent ;
|
: find-world ( gadget -- world/f ) [ world? ] find-parent ;
|
||||||
|
@ -62,7 +63,12 @@ M: world children-on nip children>> ;
|
||||||
|
|
||||||
: (draw-world) ( world -- )
|
: (draw-world) ( world -- )
|
||||||
dup handle>> [
|
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 ;
|
] with-gl-context ;
|
||||||
|
|
||||||
: draw-world? ( world -- ? )
|
: draw-world? ( world -- ? )
|
||||||
|
|
|
@ -54,25 +54,28 @@ SYMBOL: origin
|
||||||
{ 0 0 } origin set-global
|
{ 0 0 } origin set-global
|
||||||
|
|
||||||
: visible-children ( gadget -- seq )
|
: 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 ;
|
: translate ( rect/point -- ) loc>> origin [ v+ ] change ;
|
||||||
|
|
||||||
DEFER: draw-gadget
|
DEFER: draw-gadget
|
||||||
|
|
||||||
: (draw-gadget) ( 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 )
|
: >absolute ( rect -- rect )
|
||||||
origin get offset-rect ;
|
origin get offset-rect ;
|
||||||
|
|
|
@ -11,17 +11,16 @@ IN: ui.text.core-text
|
||||||
SINGLETON: core-text-renderer
|
SINGLETON: core-text-renderer
|
||||||
|
|
||||||
M: core-text-renderer init-text-rendering
|
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
|
M: core-text-renderer string-dim
|
||||||
[ " " string-dim { 0 1 } v* ] [ cached-line dim>> ] if-empty ;
|
[ " " string-dim { 0 1 } v* ] [ cached-line dim>> ] if-empty ;
|
||||||
|
|
||||||
M: core-text-renderer render-texture
|
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
|
M: core-text-renderer finish-text-rendering
|
||||||
text-handle>> purge-texture-cache
|
text-handle>> purge-texture-cache
|
||||||
|
@ -30,8 +29,8 @@ M: core-text-renderer finish-text-rendering
|
||||||
: rendered-line ( font string -- display-list )
|
: rendered-line ( font string -- display-list )
|
||||||
2array world get text-handle>> get-texture ;
|
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 )
|
M: core-text-renderer x>offset ( x font string -- n )
|
||||||
[ 2drop 0 ] [
|
[ 2drop 0 ] [
|
||||||
|
|
|
@ -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 } "." } ;
|
{ $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)
|
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." }
|
{ $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." }
|
{ $notes "This is a low-level word, UI code should use " { $link draw-string } " or " { $link draw-text } " instead." }
|
||||||
{ $side-effects "sprites" } ;
|
{ $side-effects "sprites" } ;
|
||||||
|
|
|
@ -196,19 +196,17 @@ M: freetype-renderer string-height ( font string -- h )
|
||||||
open-font height>> 2array gl-fill-rect
|
open-font height>> 2array gl-fill-rect
|
||||||
] with-translation ;
|
] with-translation ;
|
||||||
|
|
||||||
M:: freetype-renderer draw-string ( font line loc -- )
|
M:: freetype-renderer draw-string ( font line -- )
|
||||||
line dup selection? [ string>> ] when :> string
|
line dup selection? [ string>> ] when :> string
|
||||||
font open-font :> open-font
|
font open-font :> open-font
|
||||||
open-font world get font-sprites :> sprites
|
open-font world get font-sprites :> sprites
|
||||||
open-font string char-widths :> widths
|
open-font string char-widths :> widths
|
||||||
GL_TEXTURE_2D [
|
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 ;
|
] do-enabled ;
|
||||||
|
|
||||||
: run-char-widths ( open-font string -- widths )
|
: run-char-widths ( open-font string -- widths )
|
||||||
|
|
|
@ -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." } ;
|
{ $description "Outputs the dimensions of a piece of text, which is either a single-line string or an array of lines." } ;
|
||||||
|
|
||||||
HELP: draw-string
|
HELP: draw-string
|
||||||
{ $values { "font" font } { "string" string } { "loc" "a pair of integers" } }
|
{ $values { "font" font } { "string" string } }
|
||||||
{ $contract "Draws a line of text." } ;
|
{ $contract "Draws a line of text." } ;
|
||||||
|
|
||||||
HELP: draw-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." } ;
|
{ $description "Draws a piece of text." } ;
|
||||||
|
|
||||||
HELP: x>offset
|
HELP: x>offset
|
||||||
|
|
|
@ -26,7 +26,7 @@ M: object string-width string-dim first ;
|
||||||
|
|
||||||
M: object string-height string-dim second ;
|
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 -- )
|
HOOK: free-fonts font-renderer ( world -- )
|
||||||
|
|
||||||
|
@ -54,16 +54,16 @@ M: array text-dim
|
||||||
|
|
||||||
HOOK: line-metrics font-renderer ( font string -- metrics )
|
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: string draw-text draw-string ;
|
||||||
|
|
||||||
M: selection draw-text draw-string ;
|
M: selection draw-text draw-string ;
|
||||||
|
|
||||||
M: array draw-text
|
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 each
|
||||||
] with-translation ;
|
] do-matrix ;
|
|
@ -62,6 +62,7 @@ M: world graft*
|
||||||
{
|
{
|
||||||
[ handle>> select-gl-context ]
|
[ handle>> select-gl-context ]
|
||||||
[ text-handle>> dispose ]
|
[ text-handle>> dispose ]
|
||||||
|
[ images>> [ dispose ] when* ]
|
||||||
[ hand-clicked close-global ]
|
[ hand-clicked close-global ]
|
||||||
[ hand-gadget close-global ]
|
[ hand-gadget close-global ]
|
||||||
} cleave ;
|
} cleave ;
|
||||||
|
|
Loading…
Reference in New Issue