ui.gadgets.labeled: cleanup labeled-gadget words.
parent
b28bb90167
commit
d1f5282c6d
|
@ -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"
|
||||||
|
|
|
@ -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> ;
|
|
||||||
|
|
|
@ -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 ] }
|
||||||
|
|
|
@ -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*
|
||||||
|
|
|
@ -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>> ;
|
||||||
|
|
|
@ -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 ] }
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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> ;
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue