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

New look for labeled gadgets

db4
Slava Pestov 2009-02-14 00:45:10 -06:00
parent 6988baf0a1
commit 9c51eaa451
5 changed files with 82 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
basis/ui/gadgets/labelled/labelled.factor
View File

@ -1,25 +1,57 @@
! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays ui.gadgets.buttons ui.gadgets.borders
ui.gadgets.labels ui.gadgets.panes ui.gadgets.scrollers
ui.gadgets.tracks ui.gadgets.theme io kernel math models namespaces
sequences sequences words classes.tuple ui.gadgets ui.render
colors colors.constants accessors ;
USING: accessors kernel sequences colors fonts ui.gadgets
ui.gadgets.frames ui.gadgets.grids ui.gadgets.icons ui.gadgets.labels
ui.gadgets.theme ui.gadgets.borders ui.pens.image ;
IN: ui.gadgets.labelled
TUPLE: labelled-gadget < track content ;
TUPLE: labelled-gadget < frame content ;
: <labelled-gadget> ( gadget title -- newgadget )
vertical labelled-gadget new-track
swap <label> reverse-video-theme f track-add
swap >>content
dup content>> 1 track-add ;
<PRIVATE
: labelled-image ( name -- image )
"labeled-block-" prepend theme-image ;
: labelled-icon ( name -- icon )
labelled-image <icon> dup interior>> t >>fill? drop ;
CONSTANT: labelled-title-background
T{ rgba f
0.7843137254901961
0.7686274509803922
0.7176470588235294
1.0
}
: <labelled-title> ( gadget -- label )
>label
[ labelled-title-background font-with-background ] change-font
{ 0 2 } <border>
"title-middle" labelled-image
<image-pen> t >>fill? >>interior ;
: /-FOO-\ ( title labelled -- labelled )
"title-left" labelled-icon @top-left grid-add
swap <labelled-title> @top grid-add
"title-right" labelled-icon @top-right grid-add ;
: |-----| ( gadget labelled -- labelled )
"left-edge" labelled-icon @left grid-add
swap [ >>content ] [ @center grid-add ] bi
"right-edge" labelled-icon @right grid-add ;
: \-----/ ( labelled -- labelled )
"bottom-left" labelled-icon @bottom-left grid-add
"bottom-middle" labelled-icon @bottom grid-add
"bottom-right" labelled-icon @bottom-right grid-add ;
M: labelled-gadget focusable-child* content>> ;
: <labelled-scroller> ( gadget title -- gadget )
[ <scroller> ] dip <labelled-gadget> ;
PRIVATE>
: <labelled-pane> ( model quot scrolls? title -- gadget )
[ [ <pane-control> ] dip >>scrolls? ] dip
<labelled-scroller> ;
: <labelled-gadget> ( gadget title -- newgadget )
labelled-gadget new-frame
/-FOO-\
|-----|
\-----/ ;

18
basis/ui/tools/debugger/debugger.factor
View File

@ -1,13 +1,14 @@
! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays hashtables io kernel math models
namespaces sequences sequences words continuations debugger
prettyprint help editors fonts ui ui.commands ui.gestures ui.gadgets
ui.gadgets.worlds ui.gadgets.packs ui.gadgets.buttons
ui.gadgets.labels ui.gadgets.panes ui.gadgets.presentations
ui.gadgets.viewports ui.gadgets.tables ui.gadgets.tracks
ui.gadgets.scrollers ui.gadgets.panes ui.gadgets.borders
ui.gadgets.status-bar ui.tools.traceback ui.tools.inspector ;
colors.constants namespaces sequences sequences words continuations
debugger prettyprint help editors fonts ui ui.commands ui.gestures
ui.gadgets ui.pens.solid ui.gadgets.worlds ui.gadgets.packs
ui.gadgets.buttons ui.gadgets.labels ui.gadgets.panes
ui.gadgets.presentations ui.gadgets.viewports ui.gadgets.tables
ui.gadgets.tracks ui.gadgets.scrollers ui.gadgets.panes
ui.gadgets.borders ui.gadgets.status-bar ui.tools.traceback
ui.tools.inspector ;
IN: ui.tools.debugger
TUPLE: debugger < track error restarts restart-hook restart-list continuation ;
@ -51,7 +52,8 @@ PRIVATE>
swap >>error
add-toolbar
dup <restart-list> >>restart-list
dup <error-display> f track-add ;
dup <error-display> f track-add
COLOR: white <solid> >>interior ;
M: debugger focusable-child*
dup restart-hook>> [ restart-list>> ] [ drop t ] if ;

14
basis/ui/tools/listener/completion/completion.factor
View File

@ -45,10 +45,10 @@ M: history-completion completion-element drop one-line-elt ;
GENERIC: completion-banner ( completion-mode -- string )
M: word-completion completion-banner drop "Words:" ;
M: vocab-completion completion-banner drop "Vocabularies:" ;
M: char-completion completion-banner drop "Unicode code point names:" ;
M: history-completion completion-banner drop "Input history:" ;
M: word-completion completion-banner drop "Words" ;
M: vocab-completion completion-banner drop "Vocabularies" ;
M: char-completion completion-banner drop "Unicode code point names" ;
M: history-completion completion-banner drop "Input history" ;
GENERIC: completion-popup-width ( interactor completion-mode -- x )
@ -152,14 +152,14 @@ GENERIC# accept-completion-hook 1 ( item popup -- )
: <completion-scroller> ( completion-popup -- scroller )
[ table>> ] [ interactor>> ] [ completion-mode>> ] tri completion-popup-width
[ <limited-scroller> ] [ 120 2array ] bi*
[ >>min-dim ] [ >>max-dim ] bi ;
[ >>min-dim ] [ >>max-dim ] bi
COLOR: white <solid> >>interior ;
: <completion-popup> ( interactor completion-mode -- popup )
[ vertical completion-popup new-track ] 2dip
[ [ >>interactor ] [ >>completion-mode ] bi* ] [ <completion-table> >>table ] 2bi
dup [ <completion-scroller> ] [ completion-mode>> completion-banner ] bi
<labelled-gadget> 1 track-add
COLOR: white <solid> >>interior ;
<labelled-gadget> 1 track-add ;
completion-popup H{
{ T{ key-down f f "TAB" } [ table>> row-action ] }

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

@ -294,8 +294,6 @@ M: object accept-completion-hook 2drop ;
:: <debugger-popup> ( interactor error continuation -- popup )
error continuation error compute-restarts
[ interactor hide-popup ] <debugger>
COLOR: white <solid> >>interior
COLOR: black <solid> >>boundary
"Error" <labelled-gadget> ;
: debugger-popup ( interactor error continuation -- )

26
basis/ui/tools/traceback/traceback.factor
View File

@ -3,7 +3,7 @@
USING: accessors continuations kernel models namespaces arrays
fry prettyprint ui ui.commands ui.gadgets ui.gadgets.labelled assocs
ui.gadgets.tracks ui.gadgets.buttons ui.gadgets.panes
ui.gadgets.status-bar ui.gadgets.scrollers
ui.gadgets.status-bar ui.gadgets.scrollers ui.gadgets.borders
ui.gadgets.tables ui.gestures sequences inspector
models.filter fonts ;
QUALIFIED-WITH: ui.tools.inspector i
@ -33,7 +33,8 @@ M: stack-entry-renderer row-value drop object>> ;
: <callstack-display> ( model -- gadget )
[ [ call>> callstack. ] when* ]
t "Call stack" <labelled-pane> ;
<pane-control> t >>scrolls? <scroller>
"Call stack" <labelled-gadget> ;
: <datastack-display> ( model -- gadget )
[ data>> ] "Data stack" <stack-display> ;
@ -46,15 +47,22 @@ TUPLE: traceback-gadget < track ;
M: traceback-gadget pref-dim* drop { 550 600 } ;
: <traceback-gadget> ( model -- gadget )
[ vertical traceback-gadget new-track ] dip
[
vertical traceback-gadget new-track
{ 3 3 } >>gap
] dip
[ >>model ]
[
[ horizontal <track> ] dip
[ <datastack-display> 1/2 track-add ]
[ <retainstack-display> 1/2 track-add ] bi
1/3 track-add
]
[ <callstack-display> 2/3 track-add ] tri
[ vertical <track> { 3 3 } >>gap ] dip
[
[ horizontal <track> { 3 3 } >>gap ] dip
[ <datastack-display> 1/2 track-add ]
[ <retainstack-display> 1/2 track-add ] bi
1/3 track-add
]
[ <callstack-display> 2/3 track-add ] bi
{ 3 3 } <filled-border> 1 track-add
] bi
add-toolbar ;
: variables ( traceback -- )