Split off ui.pens from ui.render

basis/ui/gadgets/buttons/buttons-docs.factor

@@ -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

basis/ui/gadgets/buttons/buttons.factor

@@ -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
 

basis/ui/gadgets/editors/editors.factor

@@ -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
+ui.pens.solid ui.gadgets.line-support ui.text ui.gestures
-unicode.categories fonts ;
+math.rectangles splitting unicode.categories fonts ;
 IN: ui.gadgets.editors
 
 TUPLE: editor < gadget

basis/ui/gadgets/grid-lines/grid-lines-docs.factor

@@ -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

basis/ui/gadgets/grid-lines/grid-lines.factor

@@ -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

basis/ui/gadgets/icons/icons.factor

@@ -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 ;

basis/ui/gadgets/labelled/labelled-docs.factor

@@ -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> }
+{ $subsection <labelled-gadget> } ;
-"Or a labelled border with a close box:"
-{ $subsection closable-gadget }
-{ $subsection <closable-gadget> } ;
 
 ABOUT: "ui.gadgets.labelled"

basis/ui/gadgets/labels/labels.factor

@@ -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
+ui.gadgets.tracks ui.gadgets.packs fonts ui.render ui.pens.solid
-colors colors.constants models combinators ;
+ui.text colors colors.constants models combinators ;
 IN: ui.gadgets.labels
 
 ! A label gadget draws a string.

basis/ui/gadgets/sliders/sliders-docs.factor

@@ -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

basis/ui/gadgets/sliders/sliders.factor

@@ -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.pens ui.gadgets ui.gadgets.buttons ui.gadgets.tracks math.order
-ui.gadgets.theme ui.gadgets.icons ui.render ;
+ui.gadgets.theme ui.gadgets.icons ui.pens.tile ui.pens.image ;
 IN: ui.gadgets.sliders
 
 TUPLE: slider < track elevator thumb saved line ;

basis/ui/gadgets/theme/theme.factor

@@ -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
+USING: arrays kernel sequences ui.gadgets ui.pens.solid
-ui.text colors colors.gray colors.constants accessors ;
+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
 

basis/ui/gadgets/worlds/worlds-docs.factor

@@ -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

basis/ui/gestures/gestures-docs.factor

@@ -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
 

basis/ui/pens/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/ui/pens/caching/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/ui/pens/caching/caching-tests.factor

@@ -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

basis/ui/pens/caching/caching.factor

@@ -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 ;

basis/ui/pens/gradient/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/ui/pens/gradient/gradient-docs.factor

@@ -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" } "." } ;

basis/ui/pens/gradient/gradient-tests.factor

@@ -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

basis/ui/pens/gradient/gradient.factor

@@ -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 ;

basis/ui/pens/image/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/ui/pens/image/image-tests.factor

@@ -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

basis/ui/pens/image/image.factor

@@ -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 ;

basis/ui/pens/pens-docs.factor

@@ -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" } "." ;

basis/ui/pens/pens-tests.factor

@@ -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

basis/ui/pens/pens.factor

@@ -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 } ;

basis/ui/pens/polygon/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/ui/pens/polygon/polygon-docs.factor

@@ -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 } "." } ;

basis/ui/pens/polygon/polygon-tests.factor

@@ -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

basis/ui/pens/polygon/polygon.factor

@@ -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 ;

basis/ui/pens/solid/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/ui/pens/solid/solid-docs.factor

@@ -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" } "." } ;

basis/ui/pens/solid/solid-tests.factor

@@ -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

basis/ui/pens/solid/solid.factor

@@ -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) ;

basis/ui/pens/tile/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/ui/pens/tile/tile-tests.factor

@@ -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

basis/ui/pens/tile/tile.factor

@@ -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* ;

basis/ui/render/render-docs.factor

@@ -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 "interior" } " - an implementation of the " { $link "ui-pen-protocol" } }
-        { { $snippet "boundary" } " - an object whose class implements the " { $link draw-boundary } " generic word." }
+        { { $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"

basis/ui/render/render.factor

@@ -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
+USING: math.rectangles math.vectors namespaces kernel accessors
-kernel math namespaces opengl opengl.gl opengl.glu sequences strings
+combinators sequences opengl opengl.gl opengl.glu colors.constants
-vectors combinators math.vectors ui.gadgets ui.images colors fry
+ui.gadgets ui.pens ;
-colors.constants math.order math.rectangles locals
-specialized-arrays.float ;
 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
@@ -97,165 +87,3 @@ DEFER: draw-gadget
         { [ 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* ;

basis/ui/tools/listener/completion/completion.factor

@@ -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
 

basis/ui/tools/listener/listener.factor

@@ -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