IN: ui.gadgets.borders.tests
-USING: tools.test accessors namespaces kernel
-ui.gadgets ui.gadgets.borders math.rectangles ;
+USING: tools.test accessors namespaces kernel ui.gadgets
+ui.gadgets.borders ui.gadgets.borders.private math.rectangles ;
[ { 110 210 } ] [ <gadget> { 100 200 } >>dim { 5 5 } <border> pref-dim ] unit-test
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays ui.gadgets kernel math
+USING: accessors arrays ui.gadgets kernel math fry
namespaces vectors sequences math.vectors math.rectangles ;
IN: ui.gadgets.borders
{ min-dim initial: { 0 0 } } ;
: new-border ( child class -- border )
- new-gadget swap add-gadget ; inline
+ new swap add-gadget ; inline
: <border> ( child gap -- border )
swap border new-border
: <filled-border> ( child gap -- border )
<border> { 1 1 } >>fill ;
+: border-pref-dim ( border child-dim -- pref-dim )
+ '[ size>> 2 v*n _ v+ ] [ min-dim>> ] bi vmax ;
+
M: border pref-dim*
- [ [ size>> 2 v*n ] [ gadget-child pref-dim ] bi v+ ]
- [ min-dim>> ] bi vmax ;
+ dup gadget-child pref-dim border-pref-dim ;
M: border baseline
[ size>> second ] [ gadget-child baseline ] bi
dup [ + ] [ nip ] if ;
+<PRIVATE
+
: border-major-dim ( border -- dim )
[ dim>> ] [ size>> 2 v*n ] bi v- ;
: border-child-rect ( border -- rect )
dup border-dim [ border-loc ] keep <rect> ;
+PRIVATE>
+
M: border layout*
[ border-child-rect ] [ gadget-child ] bi set-rect-bounds ;
'[ _ _ elt-string ] <filter> ;
! Fields wrap an editor
-TUPLE: field < wrapper editor min-width max-width ;
+TUPLE: field < border editor min-cols max-cols ;
: field-theme ( gadget -- gadget )
+ { 2 2 } >>size
+ { 1 0 } >>fill
COLOR: gray <solid> >>boundary ; inline
: <field-border> ( gadget -- border )
field-theme ;
: new-field ( class -- gadget )
- [ <editor> dup <field-border> ] dip new-wrapper swap >>editor ; inline
+ [ <editor> ] dip new-border
+ dup gadget-child >>editor
+ field-theme ; inline
-: column-width ( editor n -- width )
- [ editor>> font>> ] [ CHAR: \s <string> ] bi* text-width ;
+! For line-gadget-width
+M: field font>> editor>> font>> ;
M: field pref-dim*
- [ call-next-method ]
- [ dup min-width>> dup [ column-width 0 2array vmax ] [ 2drop ] if ]
- [ dup max-width>> dup [ column-width 1/0. 2array vmin ] [ 2drop ] if ]
- tri ;
+ dup
+ [ editor>> pref-dim ] keep
+ [ line-gadget-width ] [ drop second ] 2bi 2array
+ border-pref-dim ;
TUPLE: model-field < field field-model ;
: <search-field> ( browser -- field )
'[ _ search-browser ] <action-field>
- 10 >>min-width
- 10 >>max-width ;
+ 10 >>min-cols
+ 10 >>max-cols ;
: <browser-toolbar> ( browser -- toolbar )
horizontal <track>