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

View File

@ -43,24 +43,12 @@ M: labeled-gadget focusable-child* content>> ;
PRIVATE> PRIVATE>
: <labeled> ( gadget title color -- labeled ) : <labeled-gadget> ( gadget title color -- labeled )
vertical labeled-gadget new-track with-lines vertical labeled-gadget new-track with-lines
swap >>color swap >>color
add-title-bar add-title-bar
swap >>content swap >>content
add-content-area ; add-content-area ;
: <framed-labeled> ( gadget title color -- labeled ) : <framed-labeled-gadget> ( gadget title color -- labeled )
<labeled> labeled-border-color <solid> >>boundary ; <labeled-gadget> 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> ;

View File

@ -33,7 +33,7 @@ TUPLE: links-popup < wrapper ;
: <links-popup> ( model quot title -- gadget ) : <links-popup> ( model quot title -- gadget )
[ <links-table> white-interior ] dip [ <links-table> white-interior ] dip
popup-color <labeled> links-popup new-wrapper ; popup-color <labeled-gadget> links-popup new-wrapper ;
links-popup H{ links-popup H{
{ T{ key-down f f "ESC" } [ hide-glass ] } { 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 vertical <track> with-lines
error-list <error-list-toolbar> f track-add error-list <error-list-toolbar> f track-add
error-list source-file-table>> margins <scroller> white-interior 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 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>> error-list error-display>>
"Details" details-color <labeled> 1/2 track-add "Details" details-color <labeled-gadget> 1/2 track-add
1 track-add ; 1 track-add ;
M: error-list-gadget focusable-child* M: error-list-gadget focusable-child*

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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