steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Split off ui.pens from ui.render

db4
Slava Pestov 2009-02-12 03:58:42 -06:00
parent ea2a3d6758
commit 54a58cc196
42 changed files with 317 additions and 267 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/ui/gadgets/buttons/buttons-docs.factor
View File

@ -1,5 +1,5 @@
USING: help.markup help.syntax ui.gadgets ui.gadgets.labels
ui.render kernel models classes ;
ui.pens kernel models classes ;
IN: ui.gadgets.buttons
HELP: button

2
basis/ui/gadgets/buttons/buttons.factor
View File

@ -5,7 +5,7 @@ strings quotations assocs combinators classes colors colors.constants
classes.tuple opengl opengl.gl math.vectors ui.commands ui.gadgets
ui.gadgets.borders ui.gadgets.labels ui.gadgets.theme
ui.gadgets.tracks ui.gadgets.packs ui.gadgets.worlds ui.gestures
ui.render math.rectangles locals alien.c-types
ui.pens ui.pens.solid ui.pens.caching math.rectangles locals
specialized-arrays.float fry combinators.smart ;
IN: ui.gadgets.buttons

4
basis/ui/gadgets/editors/editors.factor
View File

@ -7,8 +7,8 @@ colors.constants combinators assocs math.order fry calendar alarms
continuations ui.clipboards ui.commands ui.gadgets ui.gadgets.borders
ui.gadgets.buttons ui.gadgets.labels ui.gadgets.scrollers
ui.gadgets.theme ui.gadgets.menus ui.gadgets.wrappers ui.render
ui.gadgets.line-support ui.text ui.gestures math.rectangles splitting
unicode.categories fonts ;
ui.pens.solid ui.gadgets.line-support ui.text ui.gestures
math.rectangles splitting unicode.categories fonts ;
IN: ui.gadgets.editors
TUPLE: editor < gadget

2
basis/ui/gadgets/grid-lines/grid-lines-docs.factor
View File

@ -1,5 +1,5 @@
USING: ui.gadgets help.markup help.syntax ui.gadgets.grids
ui.render colors ;
ui.pens colors ;
IN: ui.gadgets.grid-lines
HELP: grid-lines

2
basis/ui/gadgets/grid-lines/grid-lines.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors math namespaces opengl opengl.gl
sequences math.vectors ui.gadgets ui.gadgets.grids
sequences math.vectors ui.pens ui.gadgets ui.gadgets.grids
ui.gadgets.grids.private ui.render math.rectangles
fry locals arrays assocs ;
IN: ui.gadgets.grid-lines

3
basis/ui/gadgets/icons/icons.factor
View File

@ -1,6 +1,7 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors ui.images ui.render ui.gadgets ;
USING: kernel accessors ui.images ui.pens
ui.pens.image ui.gadgets ;
IN: ui.gadgets.icons
TUPLE: icon < gadget ;

13
basis/ui/gadgets/labelled/labelled-docs.factor
View File

@ -9,14 +9,6 @@ HELP: <labelled-gadget>
{ $values { "gadget" gadget } { "title" string } { "newgadget" "a new " { $link <labelled-gadget> } } }
{ $description "Creates a new " { $link labelled-gadget } " display " { $snippet "gadget" } " with " { $snippet "title" } " on top." } ;
HELP: closable-gadget
{ $class-description "A closable gadget displays a title bar with a close box on top of another gadget. Clicking the close box invokes a quotation. Closable gadgets are created by calling " { $link <closable-gadget> } "." } ;
HELP: <closable-gadget>
{ $values { "gadget" gadget } { "title" string } { "quot" { $quotation "( button -- )" } } }
{ $description "Creates a new " { $link closable-gadget } ". Clicking the close box calls " { $snippet "quot" } "." }
{ $notes "The quotation can find the " { $link closable-gadget } " instance, or any other parent gadget by calling " { $link find-parent } " with the gadget it receives on the stack." } ;
HELP: <labelled-pane>
{ $values { "model" model } { "quot" { $quotation "( value -- )" } } { "scrolls?" "a boolean" } { "title" string } { "gadget" "a new " { $link gadget } } }
{ $description "Creates a new control delegating to a " { $link pane } ", and wraps it in a " { $link labelled-gadget } ". When the value of the model changes, the value is pushed on the stack and the quotation is called using " { $link with-pane } "." } ;
@ -26,9 +18,6 @@ HELP: <labelled-pane>
ARTICLE: "ui.gadgets.labelled" "Labelled gadgets"
"The " { $vocab-link "ui.gadgets.labelled" } " vocabulary implements labelled borders around child gadgets."
{ $subsection labelled-gadget }
{ $subsection <labelled-gadget> }
"Or a labelled border with a close box:"
{ $subsection closable-gadget }
{ $subsection <closable-gadget> } ;
{ $subsection <labelled-gadget> } ;
ABOUT: "ui.gadgets.labelled"

4
basis/ui/gadgets/labels/labels.factor
View File

@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays hashtables io kernel math math.functions
namespaces make opengl sequences strings splitting ui.gadgets
ui.gadgets.tracks ui.gadgets.packs fonts ui.render ui.text
colors colors.constants models combinators ;
ui.gadgets.tracks ui.gadgets.packs fonts ui.render ui.pens.solid
ui.text colors colors.constants models combinators ;
IN: ui.gadgets.labels
! A label gadget draws a string.

3
basis/ui/gadgets/sliders/sliders-docs.factor
View File

@ -1,4 +1,5 @@
USING: help.markup help.syntax ui.gadgets models models.range ;
USING: help.markup help.syntax ui.gadgets models models.range
ui.gadgets.sliders.private ;
IN: ui.gadgets.sliders
HELP: elevator

4
basis/ui/gadgets/sliders/sliders.factor
View File

@ -3,8 +3,8 @@
USING: accessors arrays assocs kernel math namespaces sequences
vectors models models.range math.vectors math.functions quotations
colors colors.constants math.rectangles fry combinators ui.gestures
ui.gadgets ui.gadgets.buttons ui.gadgets.tracks math.order
ui.gadgets.theme ui.gadgets.icons ui.render ;
ui.pens ui.gadgets ui.gadgets.buttons ui.gadgets.tracks math.order
ui.gadgets.theme ui.gadgets.icons ui.pens.tile ui.pens.image ;
IN: ui.gadgets.sliders
TUPLE: slider < track elevator thumb saved line ;

8
basis/ui/gadgets/theme/theme.factor
View File

@ -1,11 +1,15 @@
! Copyright (C) 2005, 2009 Slava Pestov.
! Copyright (C) 2006, 2007 Alex Chapman.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel sequences ui.gadgets ui.render
ui.text colors colors.gray colors.constants accessors ;
USING: arrays kernel sequences ui.gadgets ui.pens.solid
ui.pens.gradient ui.text ui.images colors colors.gray
colors.constants accessors io.pathnames ;
QUALIFIED: colors
IN: ui.gadgets.theme
: theme-image ( name -- image-name )
"resource:basis/ui/gadgets/theme/" prepend-path ".tiff" append <image-name> ;
: solid-interior ( gadget color -- gadget )
<solid> >>interior ; inline

2
basis/ui/gadgets/worlds/worlds-docs.factor
View File

@ -1,6 +1,6 @@
USING: ui.gadgets ui.render ui.text ui.text.private
ui.gestures ui.backend help.markup help.syntax
models opengl opengl.sprites strings ;
models opengl strings ;
IN: ui.gadgets.worlds
HELP: user-input

2
basis/ui/gestures/gestures-docs.factor
View File

@ -1,4 +1,4 @@
USING: ui.gadgets ui.gadgets.worlds help.markup help.syntax
USING: ui.gadgets help.markup help.syntax
hashtables strings kernel system ;
IN: ui.gestures

1
basis/ui/pens/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

1
basis/ui/pens/caching/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

4
basis/ui/pens/caching/caching-tests.factor Normal file
View File

@ -0,0 +1,4 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test ui.pens.caching ;
IN: ui.pens.caching.tests

16
basis/ui/pens/caching/caching.factor Normal file
View File

@ -0,0 +1,16 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel ;
IN: ui.pens.caching
! A pen that caches vertex arrays, etc
TUPLE: caching-pen last-dim ;
GENERIC: recompute-pen ( gadget pen -- )
: compute-pen ( gadget pen -- )
2dup [ dim>> ] [ last-dim>> ] bi* eq? [
2drop
] [
[ swap dim>> >>last-dim drop ] [ recompute-pen ] 2bi
] if ;

1
basis/ui/pens/gradient/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

6
basis/ui/pens/gradient/gradient-docs.factor Normal file
View File

@ -0,0 +1,6 @@
IN: ui.pens.gradient
USING: help.markup help.syntax ui.pens colors ;
HELP: gradient
{ $class-description "A class implementing the " { $link draw-interior } " generic word to draw a smoothly shaded transition between colors. The " { $snippet "colors" } " slot stores a sequence of " { $link color } " instances, and the gradient is drawn in the direction given by the " { $snippet "orientation" } " slot of the gadget." }
{ $notes "See " { $link "colors" } "." } ;

4
basis/ui/pens/gradient/gradient-tests.factor Normal file
View File

@ -0,0 +1,4 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test ui.pens.gradient ;
IN: ui.pens.gradient.tests

44
basis/ui/pens/gradient/gradient.factor Normal file
View File

@ -0,0 +1,44 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors math math.vectors locals sequences
specialized-arrays.float colors arrays combinators
opengl opengl.gl ui.pens ui.pens.caching ;
IN: ui.pens.gradient
! Gradient pen
TUPLE: gradient < caching-pen colors last-vertices last-colors ;
: <gradient> ( colors -- gradient ) gradient new swap >>colors ;
<PRIVATE
:: gradient-vertices ( direction dim colors -- seq )
direction dim v* dim over v- swap
colors length dup 1- v/n [ v*n ] with map
swap [ over v+ 2array ] curry map
concat concat >float-array ;
: gradient-colors ( colors -- seq )
[ >rgba-components 4array dup 2array ] map concat concat
>float-array ;
M: gradient recompute-pen ( gadget gradient -- )
[ nip ] [ [ [ orientation>> ] [ dim>> ] bi ] [ colors>> ] bi* ] 2bi
[ gradient-vertices >>last-vertices ]
[ gradient-colors >>last-colors ]
bi drop ;
: draw-gradient ( colors -- )
GL_COLOR_ARRAY [
[ GL_QUAD_STRIP 0 ] dip length 2 * glDrawArrays
] do-enabled-client-state ;
PRIVATE>
M: gradient draw-interior
{
[ compute-pen ]
[ last-vertices>> gl-vertex-pointer ]
[ last-colors>> gl-color-pointer ]
[ colors>> draw-gradient ]
} cleave ;

1
basis/ui/pens/image/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

4
basis/ui/pens/image/image-tests.factor Normal file
View File

@ -0,0 +1,4 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test ui.pens.image ;
IN: ui.pens.image.tests

19
basis/ui/pens/image/image.factor Normal file
View File

@ -0,0 +1,19 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors sequences fry math
opengl ui.pens ui.images ;
IN: ui.pens.image
! Image pen
TUPLE: image-pen image fill? ;
: <image-pen> ( image -- pen ) f image-pen boa ;
M: image-pen draw-interior
[ dim>> ] [ [ image>> ] [ fill?>> ] bi ] bi*
[ draw-scaled-image ] [
[ image-dim [ - 2/ ] 2map ] keep
'[ _ draw-image ] with-translation
] if ;
M: image-pen pen-pref-dim nip image>> image-dim ;

24
basis/ui/pens/pens-docs.factor Normal file
View File

@ -0,0 +1,24 @@
IN: ui.pens
USING: help.markup help.syntax kernel ui.gadgets ;
HELP: draw-interior
{ $values { "interior" object } { "gadget" gadget } }
{ $contract "Draws the interior of a gadget by making OpenGL calls. The " { $snippet "interior" } " slot may be set to objects implementing this generic word." } ;
HELP: draw-boundary
{ $values { "boundary" object } { "gadget" gadget } }
{ $contract "Draws the boundary of a gadget by making OpenGL calls. The " { $snippet "boundary" } " slot may be set to objects implementing this generic word." } ;
ARTICLE: "ui-pen-protocol" "UI pen protocol"
"The " { $snippet "interior" } " and " { $snippet "boundary" } " slots of a gadget facilitate easy factoring and sharing of drawing logic. Objects stored in these slots must implement the pen protocol:"
{ $subsection draw-interior }
{ $subsection draw-boundary }
"The default value of these slots is the " { $link f } " singleton, which implements the above protocol by doing nothing."
$nl
"Some other pre-defined implementations:"
{ $vocab-subsection "ui.pens.gradient" }
{ $vocab-subsection "ui.pens.image" }
{ $vocab-subsection "ui.pens.polygon" }
{ $vocab-subsection "ui.pens.solid" }
{ $vocab-subsection "ui.pens.tile" }
"Custom implementations must follow the guidelines set forth in " { $link "ui-paint-custom" } "." ;

4
basis/ui/pens/pens-tests.factor Normal file
View File

@ -0,0 +1,4 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test ui.pens ;
IN: ui.pens.tests

12
basis/ui/pens/pens.factor Normal file
View File

@ -0,0 +1,12 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel ;
IN: ui.pens
GENERIC: draw-interior ( gadget interior -- )
GENERIC: draw-boundary ( gadget boundary -- )
GENERIC: pen-pref-dim ( gadget pen -- dim )
M: object pen-pref-dim 2drop { 0 0 } ;

1
basis/ui/pens/polygon/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

14
basis/ui/pens/polygon/polygon-docs.factor Normal file
View File

@ -0,0 +1,14 @@
IN: ui.pens.polygon
USING: help.markup help.syntax ;
HELP: polygon
{ $class-description "A class implementing the " { $link draw-boundary } " and " { $link draw-interior } " generic words to draw a solid outline or a solid filled polygon, respectively. Instances of " { $link polygon } " have two slots:"
{ $list
{ { $snippet "color" } " - a " { $link color } }
{ { $snippet "points" } " - a sequence of points" }
}
} ;
HELP: <polygon>
{ $values { "color" color } { "points" "a sequence of points" } { "polygon" polygon } }
{ $description "Creates a new instance of " { $link polygon } "." } ;

4
basis/ui/pens/polygon/polygon-tests.factor Normal file
View File

@ -0,0 +1,4 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test ui.pens.polygon ;
IN: ui.pens.polygon.tests

29
basis/ui/pens/polygon/polygon.factor Normal file
View File

@ -0,0 +1,29 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: ;
IN: ui.pens.polygon
! Polygon pen
TUPLE: polygon color
interior-vertices
interior-count
boundary-vertices
boundary-count ;
: <polygon> ( color points -- polygon )
dup close-path [ [ concat >float-array ] [ length ] bi ] bi@
polygon boa ;
M: polygon draw-boundary
nip
[ color>> gl-color ]
[ boundary-vertices>> gl-vertex-pointer ]
[ [ GL_LINE_STRIP 0 ] dip boundary-count>> glDrawArrays ]
tri ;
M: polygon draw-interior
nip
[ color>> gl-color ]
[ interior-vertices>> gl-vertex-pointer ]
[ [ GL_POLYGON 0 ] dip interior-count>> glDrawArrays ]
tri ;

1
basis/ui/pens/solid/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

6
basis/ui/pens/solid/solid-docs.factor Normal file
View File

@ -0,0 +1,6 @@
IN: ui.pens.solid
USING: help.markup help.syntax ui.pens colors ;
HELP: solid
{ $class-description "A class implementing the " { $link draw-boundary } " and " { $link draw-interior } " generic words to draw a solid outline or a solid fill, respectively. The " { $snippet "color" } " slot stores an instance of " { $link color } "." }
{ $notes "See " { $link "colors" } "." } ;

4
basis/ui/pens/solid/solid-tests.factor Normal file
View File

@ -0,0 +1,4 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test ui.pens.solid ;
IN: ui.pens.solid.tests

31
basis/ui/pens/solid/solid.factor Normal file
View File

@ -0,0 +1,31 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors opengl ui.pens ui.pens.caching ;
IN: ui.pens.solid
! Solid fill/border
TUPLE: solid < caching-pen color interior-vertices boundary-vertices ;
: <solid> ( color -- solid ) solid new swap >>color ;
M: solid recompute-pen
swap dim>>
[ (fill-rect-vertices) >>interior-vertices ]
[ (rect-vertices) >>boundary-vertices ]
bi drop ;
<PRIVATE
! Solid pen
: (solid) ( gadget pen -- )
[ compute-pen ] [ color>> gl-color ] bi ;
PRIVATE>
M: solid draw-interior
[ (solid) ] [ interior-vertices>> gl-vertex-pointer ] bi
(gl-fill-rect) ;
M: solid draw-boundary
[ (solid) ] [ boundary-vertices>> gl-vertex-pointer ] bi
(gl-rect) ;

1
basis/ui/pens/tile/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

4
basis/ui/pens/tile/tile-tests.factor Normal file
View File

@ -0,0 +1,4 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test ui.pens.tile ;
IN: ui.pens.tile.tests

48
basis/ui/pens/tile/tile.factor Normal file
View File

@ -0,0 +1,48 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors math.vectors ui.images opengl fry
combinators ui.pens ;
IN: ui.pens.tile
! Tile pen
TUPLE: tile-pen left center right ;
: <tile-pen> ( left center right -- pen )
tile-pen boa ;
: >tile-pen< ( pen -- left center right )
[ left>> ] [ center>> ] [ right>> ] tri ; inline
M: tile-pen pen-pref-dim
swap [
>tile-pen< [ image-dim ] tri@
[ vmax vmax ] [ v+ v+ ] 3bi
] dip orientation>> set-axis ;
: compute-tile-xs ( gadget pen -- x1 x2 x3 )
[ 2drop { 0 0 } ]
[ nip left>> image-dim ]
[ [ dim>> ] [ right>> image-dim ] bi* v- ]
2tri ;
: compute-tile-widths ( gadget pen -- w1 w2 w3 )
[ nip left>> image-dim ]
[ [ dim>> ] [ [ left>> ] [ right>> ] bi [ image-dim ] bi@ ] bi* v+ v- ]
[ nip right>> image-dim ]
2tri ;
: render-tile ( tile x width gadget -- )
[ orientation>> '[ _ v* ] dip ] keep
'[
_ _ [ dim>> swap ] [ orientation>> ] bi set-axis
swap draw-scaled-image
] with-translation ;
M: tile-pen draw-interior ( gadget pen -- )
{
[ nip >tile-pen< ]
[ compute-tile-xs ]
[ compute-tile-widths ]
[ drop ]
} 2cleave
[ render-tile ] curry tri-curry@ tri-curry* tri* ;

65
basis/ui/render/render-docs.factor
View File

@ -1,4 +1,4 @@
USING: ui.gadgets ui.gestures help.markup help.syntax
USING: ui.gadgets ui.pens ui.gestures help.markup help.syntax
kernel classes strings opengl opengl.gl models
math.rectangles math colors ;
IN: ui.render
@ -14,8 +14,8 @@ HELP: gadget
{ { $snippet "visible?" } " - a boolean indicating if the gadget should display and receive user input." }
{ { $snippet "root?" } " - if set to " { $link t } ", layout changes in this gadget will not propagate to the gadget's parent." }
{ { $snippet "clipped?" } " - a boolean indicating if clipping will be enabled when drawing this gadget's children." }
{ { $snippet "interior" } " - an object whose class implements the " { $link draw-interior } " generic word." }
{ { $snippet "boundary" } " - an object whose class implements the " { $link draw-boundary } " generic word." }
{ { $snippet "interior" } " - an implementation of the " { $link "ui-pen-protocol" } }
{ { $snippet "boundary" } " - an implementation of the " { $link "ui-pen-protocol" } }
{ { $snippet "model" } " - a " { $link model } " or " { $link f } "; see " { $link "ui-control-impl" } }
}
"Gadgets subclass the " { $link rect } " class, and thus all instances have " { $snippet "loc" } " and " { $snippet "dim" } " instances holding their location and dimensions." }
@ -30,49 +30,6 @@ HELP: draw-gadget*
{ $contract "Draws the gadget by making OpenGL calls. The top-left corner of the gadget should be drawn at the location stored in the " { $link origin } " variable." }
{ $notes "This word should not be called directly. To force a gadget to redraw, call " { $link relayout-1 } "." } ;
HELP: draw-interior
{ $values { "interior" object } { "gadget" gadget } }
{ $contract "Draws the interior of a gadget by making OpenGL calls. The " { $snippet "interior" } " slot may be set to objects implementing this generic word." } ;
HELP: draw-boundary
{ $values { "boundary" object } { "gadget" gadget } }
{ $contract "Draws the boundary of a gadget by making OpenGL calls. The " { $snippet "boundary" } " slot may be set to objects implementing this generic word." } ;
HELP: solid
{ $class-description "A class implementing the " { $link draw-boundary } " and " { $link draw-interior } " generic words to draw a solid outline or a solid fill, respectively. The " { $snippet "color" } " slot stores an instance of " { $link color } "." }
{ $notes "See " { $link "colors" } "." } ;
HELP: gradient
{ $class-description "A class implementing the " { $link draw-interior } " generic word to draw a smoothly shaded transition between colors. The " { $snippet "colors" } " slot stores a sequence of " { $link color } " instances, and the gradient is drawn in the direction given by the " { $snippet "orientation" } " slot of the gadget." }
{ $notes "See " { $link "colors" } "." } ;
HELP: polygon
{ $class-description "A class implementing the " { $link draw-boundary } " and " { $link draw-interior } " generic words to draw a solid outline or a solid filled polygon, respectively. Instances of " { $link polygon } " have two slots:"
{ $list
{ { $snippet "color" } " - a " { $link color } }
{ { $snippet "points" } " - a sequence of points" }
}
} ;
HELP: <polygon>
{ $values { "color" color } { "points" "a sequence of points" } { "polygon" polygon } }
{ $description "Creates a new instance of " { $link polygon } "." } ;
HELP: <polygon-gadget>
{ $values { "color" color } { "points" "a sequence of points" } { "gadget" "a new " { $link gadget } } }
{ $description "Creates a gadget which is drawn as a solid filled polygon. The gadget's size is the minimum bounding box containing all the points of the polygon." } ;
ARTICLE: "gadgets-polygons" "Polygon gadgets"
"A polygon gadget renders a simple shaded polygon."
{ $subsection <polygon-gadget> }
"Some pre-made polygons:"
{ $subsection arrow-up }
{ $subsection arrow-right }
{ $subsection arrow-down }
{ $subsection arrow-left }
{ $subsection close-box }
"Polygon gadgets are rendered by the " { $link polygon } " pen protocol implementation." ;
ARTICLE: "ui-paint" "Customizing gadget appearance"
"The UI carries out the following steps when drawing a gadget:"
{ $list
@ -85,23 +42,9 @@ ARTICLE: "ui-paint" "Customizing gadget appearance"
{ $subsection "ui-pen-protocol" }
{ $subsection "ui-paint-custom" } ;
ARTICLE: "ui-pen-protocol" "UI pen protocol"
"The " { $snippet "interior" } " and " { $snippet "boundary" } " slots of a gadget facilitate easy factoring and sharing of drawing logic. Objects stored in these slots must implement the pen protocol:"
{ $subsection draw-interior }
{ $subsection draw-boundary }
"The default value of these slots is the " { $link f } " singleton, which implements the above protocol by doing nothing."
$nl
"Some other pre-defined implementations:"
{ $subsection solid }
{ $subsection gradient }
{ $subsection polygon }
"Custom implementations must follow the guidelines set forth in " { $link "ui-paint-custom" } "." ;
ARTICLE: "ui-paint-coord" "The UI co-ordinate system"
"The UI uses a co-ordinate system where the y axis is oriented down. The OpenGL " { $link GL_MODELVIEW } " matrix is not saved or restored when rendering a gadget. Instead, the origin of the gadget relative to the OpenGL context is stored in a variable:"
"The UI uses a co-ordinate system where the y axis is oriented down. The OpenGL " { $link GL_MODELVIEW } " matrix is saved or restored when rendering a gadget, and the origin is translated to the gadget's origin within the window. The current origin is stored in a variable:"
{ $subsection origin }
"Custom drawing implementations can translate co-ordinates manually, or save and restore the " { $link GL_MODELVIEW } " matrix using a word such as " { $link with-translation } "."
$nl
"Gadgets must not draw outside of their bounding box, however clipping is not enforced by default, for performance reasons. This can be changed by setting the " { $slot "clipped?" } " slot to " { $link t } " in the gadget's constructor." ;
ABOUT: "ui-paint"

180
basis/ui/render/render.factor
View File

@ -1,10 +1,8 @@
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types arrays hashtables io io.pathnames
kernel math namespaces opengl opengl.gl opengl.glu sequences strings
vectors combinators math.vectors ui.gadgets ui.images colors fry
colors.constants math.order math.rectangles locals
specialized-arrays.float ;
USING: math.rectangles math.vectors namespaces kernel accessors
combinators sequences opengl opengl.gl opengl.glu colors.constants
ui.gadgets ui.pens ;
IN: ui.render
SYMBOL: clip
@ -46,14 +44,6 @@ GENERIC: draw-gadget* ( gadget -- )
M: gadget draw-gadget* drop ;
GENERIC: draw-interior ( gadget interior -- )
GENERIC: draw-boundary ( gadget boundary -- )
GENERIC: pen-pref-dim ( gadget pen -- dim )
M: object pen-pref-dim 2drop { 0 0 } ;
SYMBOL: origin
{ 0 0 } origin set-global
@ -96,166 +86,4 @@ DEFER: draw-gadget
{ [ dup visible?>> not ] [ drop ] }
{ [ dup clipped?>> not ] [ (draw-gadget) ] }
[ [ (draw-gadget) ] with-clipping ]
} cond ;
! A pen that caches vertex arrays, etc
TUPLE: caching-pen last-dim ;
GENERIC: recompute-pen ( gadget pen -- )
: compute-pen ( gadget pen -- )
2dup [ dim>> ] [ last-dim>> ] bi* = [
2drop
] [
[ swap dim>> >>last-dim drop ] [ recompute-pen ] 2bi
] if ;
! Solid fill/border
TUPLE: solid < caching-pen color interior-vertices boundary-vertices ;
: <solid> ( color -- solid ) solid new swap >>color ;
M: solid recompute-pen
swap dim>>
[ (fill-rect-vertices) >>interior-vertices ]
[ (rect-vertices) >>boundary-vertices ]
bi drop ;
<PRIVATE
! Solid pen
: (solid) ( gadget pen -- )
[ compute-pen ] [ color>> gl-color ] bi ;
PRIVATE>
M: solid draw-interior
[ (solid) ] [ interior-vertices>> gl-vertex-pointer ] bi
(gl-fill-rect) ;
M: solid draw-boundary
[ (solid) ] [ boundary-vertices>> gl-vertex-pointer ] bi
(gl-rect) ;
! Gradient pen
TUPLE: gradient < caching-pen colors last-vertices last-colors ;
: <gradient> ( colors -- gradient ) gradient new swap >>colors ;
<PRIVATE
:: gradient-vertices ( direction dim colors -- seq )
direction dim v* dim over v- swap
colors length dup 1- v/n [ v*n ] with map
swap [ over v+ 2array ] curry map
concat concat >float-array ;
: gradient-colors ( colors -- seq )
[ >rgba-components 4array dup 2array ] map concat concat
>float-array ;
M: gradient recompute-pen ( gadget gradient -- )
[ nip ] [ [ [ orientation>> ] [ dim>> ] bi ] [ colors>> ] bi* ] 2bi
[ gradient-vertices >>last-vertices ]
[ gradient-colors >>last-colors ]
bi drop ;
: draw-gradient ( colors -- )
GL_COLOR_ARRAY [
[ GL_QUAD_STRIP 0 ] dip length 2 * glDrawArrays
] do-enabled-client-state ;
PRIVATE>
M: gradient draw-interior
{
[ compute-pen ]
[ last-vertices>> gl-vertex-pointer ]
[ last-colors>> gl-color-pointer ]
[ colors>> draw-gradient ]
} cleave ;
! Polygon pen
TUPLE: polygon color
interior-vertices
interior-count
boundary-vertices
boundary-count ;
: <polygon> ( color points -- polygon )
dup close-path [ [ concat >float-array ] [ length ] bi ] bi@
polygon boa ;
M: polygon draw-boundary
nip
[ color>> gl-color ]
[ boundary-vertices>> gl-vertex-pointer ]
[ [ GL_LINE_STRIP 0 ] dip boundary-count>> glDrawArrays ]
tri ;
M: polygon draw-interior
nip
[ color>> gl-color ]
[ interior-vertices>> gl-vertex-pointer ]
[ [ GL_POLYGON 0 ] dip interior-count>> glDrawArrays ]
tri ;
: theme-image ( name -- image-name )
"resource:basis/ui/gadgets/theme/" prepend-path ".tiff" append <image-name> ;
! Image pen
TUPLE: image-pen image fill? ;
: <image-pen> ( image -- pen ) f image-pen boa ;
M: image-pen draw-interior
[ dim>> ] [ [ image>> ] [ fill?>> ] bi ] bi*
[ draw-scaled-image ] [
[ image-dim [ - 2/ ] 2map ] keep
'[ _ draw-image ] with-translation
] if ;
M: image-pen pen-pref-dim nip image>> image-dim ;
! Tile pen
TUPLE: tile-pen left center right ;
: <tile-pen> ( left center right -- pen )
tile-pen boa ;
: >tile-pen< ( pen -- left center right )
[ left>> ] [ center>> ] [ right>> ] tri ; inline
M: tile-pen pen-pref-dim
swap [
>tile-pen< [ image-dim ] tri@
[ vmax vmax ] [ v+ v+ ] 3bi
] dip orientation>> set-axis ;
: compute-tile-xs ( gadget pen -- x1 x2 x3 )
[ 2drop { 0 0 } ]
[ nip left>> image-dim ]
[ [ dim>> ] [ right>> image-dim ] bi* v- ]
2tri ;
: compute-tile-widths ( gadget pen -- w1 w2 w3 )
[ nip left>> image-dim ]
[ [ dim>> ] [ [ left>> ] [ right>> ] bi [ image-dim ] bi@ ] bi* v+ v- ]
[ nip right>> image-dim ]
2tri ;
: render-tile ( tile x width gadget -- )
[ orientation>> '[ _ v* ] dip ] keep
'[
_ _ [ dim>> swap ] [ orientation>> ] bi set-axis
swap draw-scaled-image
] with-translation ;
M: tile-pen draw-interior ( gadget pen -- )
{
[ nip >tile-pen< ]
[ compute-tile-xs ]
[ compute-tile-widths ]
[ drop ]
} 2cleave
[ render-tile ] curry tri-curry@ tri-curry* tri* ;
} cond ;

2
basis/ui/tools/listener/completion/completion.factor
View File

@ -8,7 +8,7 @@ generic.standard.engines.tuple fonts definitions.icons ui.images
ui.commands ui.operations ui.gadgets ui.gadgets.editors
ui.gadgets.glass ui.gadgets.scrollers ui.gadgets.tables
ui.gadgets.tracks ui.gadgets.labelled ui.gadgets.theme
ui.gadgets.worlds ui.gadgets.wrappers ui.gestures ui.render
ui.gadgets.worlds ui.gadgets.wrappers ui.gestures ui.pens.solid
ui.tools.listener.history combinators vocabs ui.tools.listener.popups ;
IN: ui.tools.listener.completion

2
basis/ui/tools/listener/listener.factor
View File

@ -7,7 +7,7 @@ documents documents.elements fry hashtables help help.markup io
io.styles kernel lexer listener math models models.delay models.filter
namespaces parser prettyprint quotations sequences strings threads
tools.vocabs vocabs vocabs.loader vocabs.parser words ui ui.commands
ui.render ui.gadgets ui.gadgets.buttons ui.gadgets.editors
ui.pens.solid ui.gadgets ui.gadgets.buttons ui.gadgets.editors
ui.gadgets.labelled ui.gadgets.panes ui.gadgets.scrollers
ui.gadgets.status-bar ui.gadgets.tracks ui.gadgets.borders ui.gestures
ui.operations ui.tools.browser ui.tools.common ui.tools.debugger