ui.gadgets.labeled: cleanup labeled-gadget words.

factor-shell
John Benediktsson 2017-10-25 15:00:22 -07:00
parent b28bb90167
commit d1f5282c6d
11 changed files with 52 additions and 56 deletions

View File

@ -6,7 +6,7 @@ HELP: labeled-gadget
{ $class-description "A labeled gadget can be created by calling " { $link <labeled-gadget> } "." } ;
HELP: <labeled-gadget>
{ $values { "gadget" gadget } { "title" string } { "labeled" "a new " { $link <labeled-gadget> } } }
{ $values { "gadget" gadget } { "title" string } { "color" "a color" } { "labeled" "a new " { $link <labeled-gadget> } } }
{ $description "Creates a new " { $link labeled-gadget } " display " { $snippet "gadget" } " with " { $snippet "title" } " on top." } ;
ARTICLE: "ui.gadgets.labeled" "Labeled gadgets"
@ -14,6 +14,7 @@ ARTICLE: "ui.gadgets.labeled" "Labeled gadgets"
{ $subsections
labeled-gadget
<labeled-gadget>
<framed-labeled-gadget>
} ;
ABOUT: "ui.gadgets.labeled"

View File

@ -43,24 +43,12 @@ M: labeled-gadget focusable-child* content>> ;
PRIVATE>
: <labeled> ( gadget title color -- labeled )
: <labeled-gadget> ( gadget title color -- labeled )
vertical labeled-gadget new-track with-lines
swap >>color
add-title-bar
swap >>content
add-content-area ;
: <framed-labeled> ( gadget title color -- labeled )
<labeled> labeled-border-color <solid> >>boundary ;
: <labeled-gadget> ( gadget title -- labeled )
vertical labeled-gadget new-track with-lines
add-title-bar
swap [ >>content ] keep
vertical <track>
add-content
{ 5 5 } <border>
white-interior
1 track-add
labeled-border-color <solid> >>boundary
{ 3 3 } <border> ;
: <framed-labeled-gadget> ( gadget title color -- labeled )
<labeled-gadget> labeled-border-color <solid> >>boundary ;

View File

@ -33,7 +33,7 @@ TUPLE: links-popup < wrapper ;
: <links-popup> ( model quot title -- gadget )
[ <links-table> white-interior ] dip
popup-color <labeled> links-popup new-wrapper ;
popup-color <labeled-gadget> links-popup new-wrapper ;
links-popup H{
{ T{ key-down f f "ESC" } [ hide-glass ] }

View File

@ -168,11 +168,11 @@ error-display "toolbar" f {
error-list vertical <track> with-lines
error-list <error-list-toolbar> f track-add
error-list source-file-table>> margins <scroller> white-interior
"Source files" source-files-color <labeled> 1/4 track-add
"Source files" source-files-color <labeled-gadget> 1/4 track-add
error-list error-table>> margins <scroller> white-interior
"Errors" errors-color <labeled> 1/4 track-add
"Errors" errors-color <labeled-gadget> 1/4 track-add
error-list error-display>>
"Details" details-color <labeled> 1/2 track-add
"Details" details-color <labeled-gadget> 1/2 track-add
1 track-add ;
M: error-list-gadget focusable-child*

View File

@ -100,8 +100,10 @@ M: inspector-table compute-column-widths
add-toolbar
swap >>model
dup model>> <inspector-table> >>table
dup model>> <summary-gadget> margins white-interior "Object" object-color <labeled> f track-add
dup table>> <scroller> margins white-interior "Contents" contents-color <labeled> 1 track-add ;
dup model>> <summary-gadget> margins white-interior
"Object" object-color <labeled-gadget> f track-add
dup table>> <scroller> margins white-interior
"Contents" contents-color <labeled-gadget> 1 track-add ;
M: inspector-gadget focusable-child*
table>> ;

View File

@ -156,7 +156,7 @@ GENERIC#: accept-completion-hook 1 ( item popup -- )
[ vertical completion-popup new-track ] 2dip
[ [ >>interactor ] [ >>completion-mode ] bi* ] [ <completion-table> >>table ] 2bi
dup [ <completion-scroller> ] [ completion-mode>> completion-banner ] bi
completion-color <framed-labeled> 1 track-add ;
completion-color <framed-labeled-gadget> 1 track-add ;
completion-popup H{
{ T{ key-down f f "TAB" } [ table>> row-action ] }

View File

@ -348,7 +348,7 @@ M: object accept-completion-hook 2drop ;
] ;
: frame-debugger ( debugger -- labeled )
"Error" debugger-color <framed-labeled> ;
"Error" debugger-color <framed-labeled-gadget> ;
:: <debugger-popup> ( error continuation interactor -- popup )
error

View File

@ -33,12 +33,12 @@ M: stack-entry-renderer row-value drop object>> ;
: <stack-display> ( model quot title color -- gadget )
[ '[ dup _ when ] <arrow> <stack-table> margins <scroller> white-interior ] 2dip
<labeled> ;
<labeled-gadget> ;
: <callstack-display> ( model -- gadget )
[ [ call>> callstack. ] when* ]
<pane-control> t >>scrolls? margins <scroller> white-interior
"Call stack" call-stack-color <labeled> ;
"Call stack" call-stack-color <labeled-gadget> ;
: <datastack-display> ( model -- gadget )
[ data>> ] "Data stack" data-stack-color <stack-display> ;

View File

@ -1,12 +1,13 @@
! Copyright (C) 2008 Eduardo Cavazos.
! Copyright (C) 2011 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays boids.simulation calendar classes kernel
literals locals math math.functions math.trig models opengl
opengl.demo-support opengl.gl sequences threads ui ui.gadgets
ui.gadgets.borders ui.gadgets.buttons ui.gadgets.frames
ui.gadgets.grids ui.gadgets.labeled ui.gadgets.labels
ui.gadgets.packs ui.gadgets.sliders ui.render ;
USING: accessors arrays boids.simulation calendar classes
colors.constants kernel literals locals math math.functions
math.trig models opengl opengl.demo-support opengl.gl sequences
threads ui ui.gadgets ui.gadgets.borders ui.gadgets.buttons
ui.gadgets.frames ui.gadgets.grids ui.gadgets.labeled
ui.gadgets.labels ui.gadgets.packs ui.gadgets.sliders
ui.gadgets.tracks ui.render ui.tools.common ;
QUALIFIED-WITH: models.range mr
IN: boids
@ -75,7 +76,7 @@ M: range-observer model-changed
range-observer boa swap add-connection ;
:: behavior-panel ( behavior -- gadget )
2 3 <frame> { 2 4 } >>gap { 0 0 } >>filled-cell
2 3 <frame> white-interior { 2 4 } >>gap { 0 0 } >>filled-cell
"weight" <label> { 0 0 } grid-add
behavior weight>> 100 * >fixnum 0 0 200 1 mr:<range>
@ -92,7 +93,9 @@ M: range-observer model-changed
dup [ deg>rad cos behavior angle-cos<< ] connect
horizontal <slider> { 1 2 } grid-add
behavior class-of name>> <labeled-gadget> ;
{ 5 5 } <border> white-interior
behavior class-of name>> COLOR: gray <framed-labeled-gadget> ;
:: set-population ( n boids-gadget -- )
boids-gadget [
@ -109,9 +112,9 @@ M: range-observer model-changed
[ length random-boids ] change-boids drop ;
:: simulation-panel ( boids-gadget -- gadget )
<pile> { 2 2 } >>gap
<pile> white-interior
2 2 <frame> { 4 4 } >>gap { 0 0 } >>filled-cell
2 2 <frame> { 2 4 } >>gap { 0 0 } >>filled-cell
"population" <label> { 0 0 } grid-add
initial-population 0 0 200 10 mr:<range>
@ -123,7 +126,7 @@ M: range-observer model-changed
dup [ boids-gadget dt<< ] connect
horizontal <slider> { 1 1 } grid-add
add-gadget
{ 5 5 } <border> add-gadget
<shelf> { 2 2 } >>gap
"pause" [ drop boids-gadget pause-toggle ]
@ -131,9 +134,9 @@ M: range-observer model-changed
"randomize" [ drop boids-gadget randomize-boids ]
<border-button> add-gadget
add-gadget
{ 5 5 } <border> add-gadget
"simulation" <labeled-gadget> ;
"simulation" COLOR: gray <framed-labeled-gadget> ;
:: create-gadgets ( -- gadgets )
<shelf>
@ -141,7 +144,7 @@ M: range-observer model-changed
boids-gadget [ start-boids-thread ] keep
add-gadget
<pile> { 2 2 } >>gap 1.0 >>fill
<pile> { 5 5 } >>gap 1.0 >>fill
boids-gadget simulation-panel
add-gadget
@ -149,8 +152,7 @@ M: range-observer model-changed
boids-gadget behaviours>>
[ behavior-panel add-gadget ] each
add-gadget
{ 2 2 } <border> ;
{ 5 5 } <border> add-gadget ;
MAIN-WINDOW: boids { { title "Boids" } }
create-gadgets

View File

@ -1,11 +1,12 @@
! Copyright (C) 2010 Slava Pestov.
USING: arrays accessors euler.b-rep fry gml gml.runtime gml.viewer
gml.printer io.directories io.encodings.utf8 io.files
io.pathnames io.streams.string kernel locals models namespaces
sequences ui ui.gadgets ui.gadgets.buttons ui.gadgets.editors
ui.gadgets.frames ui.gadgets.grids ui.gadgets.labels
ui.gadgets.packs ui.gadgets.scrollers ui.gadgets.worlds
ui.gadgets.tables ui.gadgets.labeled unicode ;
USING: arrays accessors colors.constants euler.b-rep fry gml
gml.runtime gml.viewer gml.printer io.directories
io.encodings.utf8 io.files io.pathnames io.streams.string kernel
locals models namespaces sequences ui ui.gadgets
ui.gadgets.buttons ui.gadgets.editors ui.gadgets.frames
ui.gadgets.grids ui.gadgets.labels ui.gadgets.packs
ui.gadgets.scrollers ui.gadgets.worlds ui.gadgets.tables
ui.gadgets.labeled unicode ;
FROM: gml => gml ;
IN: gml.ui
@ -25,7 +26,8 @@ M: stack-entry-renderer row-value
40 >>max-cols ;
: <stack-display> ( model -- gadget )
<stack-table> <scroller> "Operand stack" <labeled-gadget> ;
<stack-table> <scroller> "Operand stack"
COLOR: dark-gray <labeled-gadget> ;
TUPLE: gml-editor < frame editor gml stack-model b-rep b-rep-model ;
@ -97,7 +99,7 @@ CONSTANT: example-dir "vocab:gml/examples/"
30 >>max-rows
40 >>min-cols
40 >>max-cols
<scroller> "Editor" <labeled-gadget> ;
<scroller> "Editor" COLOR: dark-gray <labeled-gadget> ;
: <gml-editor> ( -- gadget )
2 3 gml-editor new-frame

View File

@ -1,7 +1,7 @@
USING: accessors arrays file-picker fry io.directories kernel
math.rectangles models sequences sets ui ui.gadgets
ui.gadgets.buttons ui.gadgets.glass ui.gadgets.labeled
ui.gadgets.labels ui.gadgets.tracks ;
USING: accessors arrays colors.constants file-picker fry
io.directories kernel math.rectangles models sequences sets ui
ui.gadgets ui.gadgets.buttons ui.gadgets.glass
ui.gadgets.labeled ui.gadgets.labels ui.gadgets.tracks ;
IN: merger
MAIN-WINDOW: merger-window {
@ -18,7 +18,8 @@ MAIN-WINDOW: merger-window {
[ <label> 1array >>children drop ]
[ swap set-control-value ] 2bi
] [ drop ] if*
] <border-button> swap >>model swap <labeled-gadget>
] <border-button> swap >>model swap
COLOR: black <labeled-gadget>
1 track-add
] 2each
] keep