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

Definition browser looks better

darcs
slava 2006-11-22 00:35:26 +00:00
parent d32a28e7a5
commit 2b70b79874
8 changed files with 50 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
library/ui/gadgets/sliders.factor
View File

@ -129,7 +129,7 @@ M: elevator layout*
: slide-by-line ( -1/1 slider -- ) >r 32 * r> slide-by ;
: <slide-button> ( vector polygon amount -- )
>r { 0.5 0.5 0.5 1.0 } swap <polygon-gadget> r>
>r gray swap <polygon-gadget> r>
[ swap slide-by-line ] curry <repeat-button>
[ set-gadget-orientation ] keep ;

36
library/ui/gadgets/theme.factor
View File

@ -16,17 +16,15 @@ DEFER: set-editor-font
IN: gadgets-theme
USING: arrays gadgets kernel sequences styles ;
: solid-black T{ solid f { 0.0 0.0 0.0 1.0 } } ;
: black { 0.0 0.0 0.0 1.0 } ;
: white { 1.0 1.0 1.0 1.0 } ;
: gray { 0.6 0.6 0.6 1.0 } ;
: solid-white T{ solid f { 1.0 1.0 1.0 1.0 } } ;
: solid-interior white <solid> swap set-gadget-interior ;
: solid-interior solid-white swap set-gadget-interior ;
: solid-boundary black <solid> swap set-gadget-boundary ;
: solid-boundary solid-black swap set-gadget-boundary ;
: faint T{ solid f { 0.62 0.62 0.62 0.8 } } ;
: faint-boundary faint swap set-gadget-boundary ;
: faint-boundary gray <solid> swap set-gadget-boundary ;
: plain-gradient
T{ gradient f {
@ -72,7 +70,7 @@ USING: arrays gadgets kernel sequences styles ;
plain-gradient over set-gadget-interior faint-boundary ;
: roll-button-theme ( button -- )
f solid-black solid-black f <button-paint>
f black <solid> dup f <button-paint>
swap set-gadget-boundary ;
: caret-theme ( caret -- )
@ -86,19 +84,19 @@ USING: arrays gadgets kernel sequences styles ;
} } swap set-gadget-interior ;
: reverse-video-theme ( label -- )
{ 1.0 1.0 1.0 1.0 } over set-label-color
solid-black swap set-gadget-interior ;
white over set-label-color
black <solid> swap set-gadget-interior ;
: label-theme ( gadget -- )
{ 0.0 0.0 0.0 1.0 } over set-label-color
black over set-label-color
{ "sans-serif" plain 12 } swap set-label-font ;
: text-theme ( gadget -- )
{ 0.0 0.0 0.0 1.0 } over set-label-color
black over set-label-color
{ "monospace" plain 12 } swap set-label-font ;
: editor-theme ( editor -- )
{ 0.0 0.0 0.0 1.0 } over set-editor-color
black over set-editor-color
{ 1.0 0.0 0.0 1.0 } over set-editor-caret-color
{ 0.8 0.8 1.0 1.0 } over set-editor-selection-color
{ "monospace" plain 12 } swap set-editor-font ;
@ -110,5 +108,11 @@ USING: arrays gadgets kernel sequences styles ;
: menu-theme ( gadget -- )
T{ solid f { 0.95 0.95 0.95 0.95 } }
over set-gadget-interior
T{ solid f { 0.7 0.7 0.7 1.0 } }
swap set-gadget-boundary ;
gray <solid> swap set-gadget-boundary ;
: title-theme ( gadget -- )
{ 1 0 } over set-gadget-orientation
T{ gradient f {
{ 0.65 0.65 1.0 1.0 }
{ 0.65 0.45 1.0 1.0 }
} } swap set-gadget-interior ;

1
library/ui/paint.factor
View File

@ -117,6 +117,7 @@ M: polygon draw-interior
: arrow-right { { 0 0 } { 6 3 } { 0 6 } } ;
: arrow-down { { 0 0 } { 6 0 } { 3 6 } } ;
: arrow-left { { 0 3 } { 6 0 } { 6 6 } } ;
: close-box { { 0 0 } { 6 0 } { 6 6 } { 0 6 } } ;
: <polygon-gadget> ( color points -- gadget )
dup max-dim

13
library/ui/tools/browser.factor
View File

@ -38,18 +38,15 @@ TUPLE: tile definition gadget ;
definitions-showing delete
unparent ;
: <tile-content> ( definition toolbar -- gadget )
>r [ see ] make-pane r> 2array
make-pile { 5 5 } over set-pack-gap
<default-border> dup faint-boundary ;
: <tile-content> ( definition -- gadget )
[ [ see ] make-pane <default-border> ] keep
unparse [ find-tile close-tile ] <labelled-gadget>
dup faint-boundary ;
C: tile ( definition -- gadget )
2dup { tile } <toolbar>
<tile-content> over set-gadget-delegate
over <tile-content> over set-gadget-delegate
[ set-tile-definition ] keep ;
tile "toolbar" { { "Close" f [ close-tile ] } } define-commands
: show-definition ( definition definitions -- )
2dup definition-index dup 0 >= [
over nth-gadget swap scroll>rect drop

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

@ -59,7 +59,7 @@ C: listener-gadget ( -- gadget )
{
[ <listener-input> ]
set-listener-gadget-input
[ <scroller> "Input" <labelled-gadget> ]
[ <scroller> "Input" f <labelled-gadget> ]
1/6
}
} { 0 1 } make-track* ;

4
library/ui/tools/messages.factor
View File

@ -44,10 +44,10 @@ M: messages batch-ends
<messages-button> gadget. ;
: <errors> ( gadget -- newgadget )
<scroller> "Compiler errors" <labelled-gadget> ;
<scroller> "Compiler errors" f <labelled-gadget> ;
: <warnings> ( gadget -- newgadget )
<scroller> "Compiler warnings" <labelled-gadget> ;
<scroller> "Compiler warnings" f <labelled-gadget> ;
C: messages ( -- gadget )
{

3
library/ui/tools/search.factor
View File

@ -130,7 +130,8 @@ C: history-search ( string seq -- gadget )
live-search-list list-value ;
: show-titled-popup ( workspace gadget title -- )
<labelled-gadget> swap show-popup ;
[ find-workspace hide-popup ] <labelled-gadget>
swap show-popup ;
: workspace-listener ( workspace -- listener )
listener-gadget swap find-tool tool-gadget nip ;

21
library/ui/ui.factor
View File

@ -139,9 +139,24 @@ C: titled-gadget ( gadget title -- )
TUPLE: labelled-gadget content ;
C: labelled-gadget ( gadget title -- gadget )
: <close-box> ( quot -- button/f )
gray close-box <polygon-gadget> swap <bevel-button> ;
: <title-label> <label> dup title-theme ;
: <title-bar> ( title quot -- gadget )
[
{
{ [ <close-box> ] f f @left }
{ [ <title-label> ] f f @center }
} make-frame
] [
<title-label>
] if* ;
C: labelled-gadget ( gadget title quot -- gadget )
{
{ [ <label> dup reverse-video-theme ] f f @top }
{ [ <title-bar> ] f f @top }
{ f set-labelled-gadget-content f @center }
} make-frame* ;
@ -149,7 +164,7 @@ M: labelled-gadget focusable-child* labelled-gadget-content ;
: <labelled-pane> ( model quot title -- gadget )
>r <pane-control> t over set-pane-scrolls? <scroller> r>
<labelled-gadget> ;
f <labelled-gadget> ;
: pane-window ( quot title -- )
>r make-pane <scroller> r> open-titled-window ;