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

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -130,7 +130,7 @@ M: editor ungraft*
[ first2 swap ] dip [ editor-line ] [ font>> ] bi swap offset>x round ; [ first2 swap ] dip [ editor-line ] [ font>> ] bi swap offset>x round ;
: loc>point ( loc editor -- loc ) : 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 ) : caret-loc ( editor -- loc )
[ editor-caret ] keep loc>point ; [ editor-caret ] keep loc>point ;

6
basis/ui/gadgets/labeled/labeled-docs.factor
View File

@ -9,12 +9,6 @@ HELP: <labeled-gadget>
{ $values { "gadget" gadget } { "title" string } { "newgadget" "a new " { $link <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." } ; { $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" ARTICLE: "ui.gadgets.labeled" "Labelled gadgets"
"The " { $vocab-link "ui.gadgets.labeled" } " vocabulary implements labeled borders around child gadgets." "The " { $vocab-link "ui.gadgets.labeled" } " vocabulary implements labeled borders around child gadgets."
{ $subsection labeled-gadget } { $subsection labeled-gadget }

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

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

6
basis/ui/gadgets/line-support/line-support.factor
View File

@ -1,6 +1,6 @@
! 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 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 math.ranges math.vectors namespaces opengl sequences ui.gadgets
ui.render ui.text ; ui.render ui.text ;
IN: ui.gadgets.line-support 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 ; : 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 ) : validate-line ( m gadget -- n )
control-value [ drop f ] [ length 1- min 0 max ] if-empty ; control-value [ drop f ] [ length 1- min 0 max ] if-empty ;
@ -48,6 +48,6 @@ GENERIC: draw-line ( line index gadget -- )
[ line-height ] [ line-height ]
[ ] [ ]
} cleave '[ } cleave '[
0 over _ * 2array 0 over _ * >integer 2array
[ _ draw-line ] with-translation [ _ draw-line ] with-translation
] each-slice-index ; ] each-slice-index ;

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

@ -3,7 +3,8 @@
USING: colors.constants kernel locals math.rectangles USING: colors.constants kernel locals math.rectangles
namespaces sequences ui.commands ui.gadgets ui.gadgets.borders namespaces sequences ui.commands ui.gadgets ui.gadgets.borders
ui.gadgets.buttons ui.gadgets.glass ui.gadgets.packs 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 IN: ui.gadgets.menus
: show-menu ( owner menu -- ) : show-menu ( owner menu -- )

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

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

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

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

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

@ -1,8 +1,8 @@
! 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: math.rectangles math.vectors namespaces kernel accessors USING: math.rectangles math.vectors namespaces kernel accessors
combinators sequences opengl opengl.gl opengl.glu colors.constants combinators sequences opengl opengl.gl opengl.glu colors
ui.gadgets ui.pens ; colors.constants ui.gadgets ui.pens ;
IN: ui.render IN: ui.render
SYMBOL: clip SYMBOL: clip

14
basis/ui/tools/browser/browser.factor
View File

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