diff --git a/basis/ui/gadgets/labeled/labeled-docs.factor b/basis/ui/gadgets/labeled/labeled-docs.factor index 5508764610..a75232f6b6 100644 --- a/basis/ui/gadgets/labeled/labeled-docs.factor +++ b/basis/ui/gadgets/labeled/labeled-docs.factor @@ -1,19 +1,28 @@ USING: ui.gadgets help.markup help.syntax strings models -ui.gadgets.panes ; +ui.gadgets.panes ui.theme ; IN: ui.gadgets.labeled HELP: labeled-gadget { $class-description "A labeled gadget can be created by calling " { $link } "." } ; HELP: -{ $values { "gadget" gadget } { "title" string } { "color" "a color" } { "labeled" "a new " { $link } } } -{ $description "Creates a new " { $link labeled-gadget } " display " { $snippet "gadget" } " with " { $snippet "title" } " on top." } ; +{ $values { "content" gadget } { "title" string } { "labeled" labeled-gadget } } +{ $description "Creates a new " { $link labeled-gadget } " displaying " { $snippet "content" } " with " { $snippet "title" } " on top." } ; + +HELP: +{ $values { "content" gadget } { "title" string } { "color" "a color" } { "labeled" labeled-gadget } } +{ $description "Creates a new " { $link labeled-gadget } " displaying " { $snippet "content" } " with " { $snippet "title" } " on top, adding a " { $snippet "color" } " colored divider between title bar and content." } ; + +HELP: +{ $values { "content" gadget } { "title" string } { "color" "a color" } { "labeled" labeled-gadget } } +{ $description "Creates a new " { $link labeled-gadget } " displaying " { $snippet "content" } " with " { $snippet "title" } " on top, adding a " { $snippet "color" } " colored divider between title bar and content and a " { $link labeled-border-color } " frame." } ; ARTICLE: "ui.gadgets.labeled" "Labeled gadgets" "The " { $vocab-link "ui.gadgets.labeled" } " vocabulary implements labeled borders around child gadgets." { $subsections labeled-gadget + } ; diff --git a/basis/ui/gadgets/labeled/labeled-tests.factor b/basis/ui/gadgets/labeled/labeled-tests.factor index 400ed36298..08dd6d85d0 100644 --- a/basis/ui/gadgets/labeled/labeled-tests.factor +++ b/basis/ui/gadgets/labeled/labeled-tests.factor @@ -3,6 +3,5 @@ ui.gadgets ui.gadgets.labeled ; IN: ui.gadgets.labeled.tests { t } [ - "Hey" color: blue - content>> gadget? + "Hey" content>> gadget? ] unit-test diff --git a/basis/ui/gadgets/labeled/labeled.factor b/basis/ui/gadgets/labeled/labeled.factor index 22c4e95205..ce9daeaae6 100644 --- a/basis/ui/gadgets/labeled/labeled.factor +++ b/basis/ui/gadgets/labeled/labeled.factor @@ -5,7 +5,7 @@ ui.gadgets.labels ui.gadgets.packs ui.gadgets.tracks ui.pens.gradient ui.pens.solid ui.theme ; IN: ui.gadgets.labeled -TUPLE: labeled-gadget < track content color ; +TUPLE: labeled-gadget < track content ; > ; [ title-bar-gradient ] if ; -: add-title-bar ( title track -- track ) - swap >label - [ t >>bold? ] change-font - { 0 4 } - title-bar-interior >>interior - f track-add ; - -: add-content ( content track -- track ) - swap 1 track-add ; - -: add-color-line ( color track -- track ) - { 0 1.5 } - rot >>interior - f track-add ; - -: add-content-area ( labeled -- labeled ) - [ ] [ content>> ] [ color>> ] tri - vertical - add-color-line - add-content - 1 track-add ; +: ( title -- title-bar ) + >label [ t >>bold? ] change-font + { 0 4 } title-bar-interior >>interior ; PRIVATE> -: ( gadget title color -- labeled ) +: ( content title -- labeled ) vertical labeled-gadget new-track - swap >>color - add-title-bar - swap >>content - add-content-area ; + swap f track-add + swap [ >>content ] [ 1 track-add ] bi ; -: ( gadget title color -- labeled ) - labeled-border-color >>boundary ; +: ( content title color -- labeled ) + [ ] dip >>interior { 0 3 } >>gap ; + +: ( content title color -- labeled ) + labeled-border-color >>boundary ; diff --git a/basis/ui/pens/caching/caching-tests.factor b/basis/ui/pens/caching/caching-tests.factor index a85c8ce016..9effa7f2f2 100644 --- a/basis/ui/pens/caching/caching-tests.factor +++ b/basis/ui/pens/caching/caching-tests.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors colors.constants kernel tools.test -ui.gadgets.labels ui.pens.caching ui.pens.gradient ; +USING: accessors alien.c-types colors.constants kernel +specialized-arrays tools.test ui.gadgets.labels +ui.pens.caching ui.pens.gradient ; IN: ui.pens.caching.tests SPECIALIZED-ARRAY: float diff --git a/basis/ui/tools/error-list/error-list.factor b/basis/ui/tools/error-list/error-list.factor index d99baa011a..8ba210da31 100644 --- a/basis/ui/tools/error-list/error-list.factor +++ b/basis/ui/tools/error-list/error-list.factor @@ -168,11 +168,11 @@ error-display "toolbar" f { error-list vertical with-lines error-list f track-add error-list source-file-table>> margins white-interior - "Source files" source-files-color 1/4 track-add + "Source files" source-files-color 1/4 track-add error-list error-table>> margins white-interior - "Errors" errors-color 1/4 track-add + "Errors" errors-color 1/4 track-add error-list error-display>> - "Details" details-color 1/2 track-add + "Details" details-color 1/2 track-add 1 track-add ; M: error-list-gadget focusable-child* diff --git a/basis/ui/tools/inspector/inspector.factor b/basis/ui/tools/inspector/inspector.factor index cff8f4b305..059b68680c 100644 --- a/basis/ui/tools/inspector/inspector.factor +++ b/basis/ui/tools/inspector/inspector.factor @@ -101,9 +101,9 @@ M: inspector-table compute-column-widths swap >>model dup model>> >>table dup model>> margins white-interior - "Object" object-color f track-add + "Object" object-color f track-add dup table>> margins white-interior - "Contents" contents-color 1 track-add ; + "Contents" contents-color 1 track-add ; M: inspector-gadget focusable-child* table>> ; diff --git a/basis/ui/tools/traceback/traceback.factor b/basis/ui/tools/traceback/traceback.factor index 6420688066..6392121dee 100644 --- a/basis/ui/tools/traceback/traceback.factor +++ b/basis/ui/tools/traceback/traceback.factor @@ -33,12 +33,12 @@ M: stack-entry-renderer row-value drop object>> ; : ( model quot title color -- gadget ) [ '[ dup _ when ] margins white-interior ] 2dip - ; + ; : ( model -- gadget ) [ [ call>> callstack. ] when* ] t >>scrolls? margins white-interior - "Call stack" call-stack-color ; + "Call stack" call-stack-color ; : ( model -- gadget ) [ data>> ] "Data stack" data-stack-color ; diff --git a/basis/windows/dragdrop-listener/dragdrop-listener.factor b/basis/windows/dragdrop-listener/dragdrop-listener.factor index 505832d0c2..67437415b5 100644 --- a/basis/windows/dragdrop-listener/dragdrop-listener.factor +++ b/basis/windows/dragdrop-listener/dragdrop-listener.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2008, 2009 Joe Groff, Slava Pestov. ! Copyright (C) 2017-2018 Alexander Ilin. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.accessors alien.data alien.strings -classes.struct io.encodings.utf16n kernel make math namespaces -prettyprint sequences specialized-arrays +USING: accessors alien.accessors alien.c-types alien.data +alien.strings classes.struct io.encodings.utf16n kernel make +math namespaces prettyprint sequences specialized-arrays ui.backend.windows ui.gadgets.worlds ui.gestures ui.tools.listener windows.com windows.com.wrapper windows.dropfiles windows.kernel32 windows.ole32 windows.shell32 diff --git a/extra/gml/ui/ui.factor b/extra/gml/ui/ui.factor index d1f5a92e02..8a89c314fa 100644 --- a/extra/gml/ui/ui.factor +++ b/extra/gml/ui/ui.factor @@ -27,7 +27,7 @@ M: stack-entry-renderer row-value : ( model -- gadget ) "Operand stack" - color: dark-gray ; + color: dark-gray ; TUPLE: gml-editor < frame editor gml stack-model b-rep b-rep-model ; @@ -99,7 +99,7 @@ CONSTANT: example-dir "vocab:gml/examples/" 30 >>max-rows 40 >>min-cols 40 >>max-cols - "Editor" color: dark-gray ; + "Editor" color: dark-gray ; : ( -- gadget ) 2 3 gml-editor new-frame diff --git a/extra/merger/merger.factor b/extra/merger/merger.factor index bc883584c1..f9592093d9 100644 --- a/extra/merger/merger.factor +++ b/extra/merger/merger.factor @@ -19,8 +19,7 @@ MAIN-WINDOW: merger-window { [ swap set-control-value ] 2bi ] [ drop ] if* ] swap >>model swap - color: black - 1 track-add + 1 track-add ] 2each ] keep dup first2 diff --git a/extra/minesweeper/minesweeper.factor b/extra/minesweeper/minesweeper.factor index e92c7e1ecb..b946918f46 100644 --- a/extra/minesweeper/minesweeper.factor +++ b/extra/minesweeper/minesweeper.factor @@ -29,9 +29,6 @@ TUPLE: cell #adjacent mined? state ; : cells-dim ( cells -- rows cols ) [ length ] [ first length ] bi ; -: unmined-cell ( cells -- cell ) - f [ dup mined?>> ] [ drop dup random random ] do while nip ; - : #mines ( cells -- n ) [ [ mined?>> ] count ] map-sum ; @@ -41,6 +38,9 @@ TUPLE: cell #adjacent mined? state ; : #mines-remaining ( cells -- n ) [ #mines ] [ #flagged ] bi - ; +: unmined-cell ( cells -- cell ) + f [ dup mined?>> ] [ drop dup random random ] do while nip ; + : place-mines ( cells n -- cells ) [ dup unmined-cell t >>mined? drop ] times ; @@ -81,7 +81,7 @@ DEFER: click-cell-at neighbors [ first2 [ row + ] [ col + ] bi* :> ( row' col' ) cells row' col' cell-at [ - { [ mined?>> ] [ state>> +question+ = ] } 1|| [ + { [ mined?>> ] [ state>> +flagged+ = ] } 1|| [ cells row' col' click-cell-at drop ] unless ] when* @@ -229,7 +229,7 @@ M: grid-gadget draw-gadget* h 3 55 between? gadget pref-dim first 2/ w - abs 26 < and [ gadget [ reset-cells ] change-cells - f >>start f >>end relayout-1 + f >>start f >>end drop ] when ] [ h 58 - w [ 32 /i ] bi@ :> ( row col ) @@ -238,10 +238,9 @@ M: grid-gadget draw-gadget* cells row col click-cell-at [ gadget start>> [ now gadget start<< ] unless cells game-over? [ now gadget end<< ] when - gadget relayout-1 ] when ] unless - ] if ; + ] if gadget relayout-1 ; :: on-mark ( gadget -- ) gadget hand-rel first2 :> ( w h ) @@ -252,10 +251,9 @@ M: grid-gadget draw-gadget* cells row col mark-cell-at [ gadget start>> [ now gadget start<< ] unless cells game-over? [ now gadget end<< ] when - gadget relayout-1 ] when ] unless - ] when ; + ] when gadget relayout-1 ; : new-game ( gadget rows cols mines -- ) [ make-cells ] dip place-mines update-counts >>cells