Various UI cosmetic fixes

db4
Slava Pestov 2009-02-14 20:46:35 -06:00
parent dd3a21f4f0
commit 4c86bd0951
9 changed files with 23 additions and 25 deletions

View File

@ -130,7 +130,7 @@ M: editor ungraft*
[ first2 swap ] dip [ editor-line ] [ font>> ] bi swap offset>x round ;
: loc>point ( loc editor -- loc )
[ loc>x ] [ [ first ] dip line>y ] 2bi 2array ;
[ loc>x ] [ [ first ] dip line>y ceiling ] 2bi 2array ;
: caret-loc ( editor -- loc )
[ editor-caret ] keep loc>point ;

View File

@ -9,12 +9,6 @@ HELP: <labeled-gadget>
{ $values { "gadget" gadget } { "title" string } { "newgadget" "a new " { $link <labeled-gadget> } } }
{ $description "Creates a new " { $link labeled-gadget } " display " { $snippet "gadget" } " with " { $snippet "title" } " on top." } ;
HELP: <labeled-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 labeled-gadget } ". When the value of the model changes, the value is pushed on the stack and the quotation is called using " { $link with-pane } "." } ;
{ <labeled-pane> <pane-control> } related-words
ARTICLE: "ui.gadgets.labeled" "Labelled gadgets"
"The " { $vocab-link "ui.gadgets.labeled" } " vocabulary implements labeled borders around child gadgets."
{ $subsection labeled-gadget }

View File

@ -85,6 +85,7 @@ M: f >label drop <gadget> ;
: label-on-left/right ( -- track )
horizontal <track>
0 >>fill
+baseline+ >>align
{ 5 5 } >>gap ; inline
PRIVATE>

View File

@ -1,6 +1,6 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays combinators fry kernel math math.order
USING: accessors arrays combinators fry kernel math math.functions math.order
math.ranges math.vectors namespaces opengl sequences ui.gadgets
ui.render ui.text ;
IN: ui.gadgets.line-support
@ -18,7 +18,7 @@ M: gadget line-height font>> font-metrics height>> ;
: y>line ( y gadget -- n ) line-height /i ;
: line>y ( n gadget -- y ) line-height * ;
: line>y ( n gadget -- y ) line-height * >integer ;
: validate-line ( m gadget -- n )
control-value [ drop f ] [ length 1- min 0 max ] if-empty ;
@ -48,6 +48,6 @@ GENERIC: draw-line ( line index gadget -- )
[ line-height ]
[ ]
} cleave '[
0 over _ * 2array
0 over _ * >integer 2array
[ _ draw-line ] with-translation
] each-slice-index ;

View File

@ -3,7 +3,8 @@
USING: colors.constants kernel locals math.rectangles
namespaces sequences ui.commands ui.gadgets ui.gadgets.borders
ui.gadgets.buttons ui.gadgets.glass ui.gadgets.packs
ui.gadgets.worlds ui.gestures ui.operations ;
ui.gadgets.worlds ui.gestures ui.operations ui.pens.solid
accessors ;
IN: ui.gadgets.menus
: show-menu ( owner menu -- )

View File

@ -23,7 +23,7 @@ TUPLE: pack < gadget
[ { 0 0 } ] dip '[ v+ _ v+ ] accumulate nip ;
: numerically-aligned-locs ( sizes pack -- seq )
[ align>> ] [ dim>> ] bi '[ [ _ _ ] dip v- n*v ] map ;
[ align>> ] [ dim>> ] bi '[ [ _ _ ] dip v- [ * >integer ] with map ] map ;
: baseline-aligned-locs ( pack -- seq )
children>> baseline-align [ 0 swap 2array ] map ;
@ -39,7 +39,7 @@ TUPLE: pack < gadget
: round-dims ( seq -- newseq )
[ { 0 0 } ] dip
[ swap v- dup [ ceiling >fixnum ] map [ swap v- ] keep ] map
[ swap v- dup [ ceiling ] map [ swap v- ] keep ] map
nip ;
PRIVATE>

View File

@ -3,10 +3,10 @@
USING: arrays hashtables io kernel namespaces sequences io.styles
strings quotations math opengl combinators memoize math.vectors
sorting splitting assocs classes.tuple models continuations
destructors accessors math.rectangles fry fonts ui.images ui.gadgets
ui.gadgets.private ui.gadgets.borders ui.gadgets.buttons
ui.gadgets.labels ui.gadgets.scrollers ui.gadgets.paragraphs
ui.gadgets.incremental ui.gadgets.packs
destructors accessors math.rectangles fry fonts ui.pens.solid
ui.images ui.gadgets ui.gadgets.private ui.gadgets.borders
ui.gadgets.buttons ui.gadgets.labels ui.gadgets.scrollers
ui.gadgets.paragraphs ui.gadgets.incremental ui.gadgets.packs
ui.gadgets.menus ui.clipboards ui.gestures ui.traverse ui.render
ui.text ui.gadgets.presentations ui.gadgets.grids ui.gadgets.tracks
ui.gadgets.icons ui.gadgets.grid-lines colors call ;

View File

@ -1,8 +1,8 @@
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: math.rectangles math.vectors namespaces kernel accessors
combinators sequences opengl opengl.gl opengl.glu colors.constants
ui.gadgets ui.pens ;
combinators sequences opengl opengl.gl opengl.glu colors
colors.constants ui.gadgets ui.pens ;
IN: ui.render
SYMBOL: clip

View File

@ -6,12 +6,12 @@ sequences models models.history tools.apropos
ui.commands ui.gadgets ui.gadgets.panes ui.gadgets.scrollers
ui.gadgets.tracks ui.gestures ui.gadgets.buttons ui.gadgets.packs
ui.gadgets.editors ui.gadgets.labels ui.gadgets.status-bar
ui.tools.common ui ;
ui.gadgets.borders ui.tools.common ui ;
IN: ui.tools.browser
TUPLE: browser-gadget < tool pane scroller search-field ;
{ 550 400 } browser-gadget set-tool-dim
{ 650 400 } browser-gadget set-tool-dim
: show-help ( link browser-gadget -- )
model>> dup add-history
@ -29,17 +29,19 @@ TUPLE: browser-gadget < tool pane scroller search-field ;
10 >>max-width ;
: <browser-toolbar> ( browser -- toolbar )
<shelf>
horizontal <track>
0 >>fill
1/2 >>align
{ 5 5 } >>gap
over <toolbar> add-gadget
swap search-field>> "Search:" label-on-left add-gadget ;
over <toolbar> f track-add
swap search-field>> "Search:" label-on-left 1 track-add ;
: <browser-gadget> ( link -- gadget )
vertical browser-gadget new-track
1 >>fill
swap >link <history> >>model
dup <search-field> >>search-field
dup <browser-toolbar> f track-add
dup <browser-toolbar> { 3 3 } <border> { 1 0 } >>fill f track-add
dup <help-pane> >>pane
dup pane>> <scroller> >>scroller
dup scroller>> 1 track-add ;