From 2464e70faddfde8a62258c8371f86e300d8ab779 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 10 Feb 2018 19:52:03 -0600 Subject: [PATCH 1/5] ui.pens.caching: Fix using. --- basis/ui/pens/caching/caching-tests.factor | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/basis/ui/pens/caching/caching-tests.factor b/basis/ui/pens/caching/caching-tests.factor index cce3f0cb7c..5b76772e29 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 From 2a45023e2f0af2b130074f48f8621b18f85104c9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 11 Feb 2018 00:12:47 -0600 Subject: [PATCH 2/5] windows.dragdrop-listener: Fix the other using! --- basis/windows/dragdrop-listener/dragdrop-listener.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) 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 From 9c22098deccda656eff3a4e105a0265fdf0817dd Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sun, 11 Feb 2018 09:52:00 -0800 Subject: [PATCH 3/5] ui.gadgets.labeled: make not take a color. This allows backwards compatibility with 0.97 API. Adding for a version with a colored divider and implementing it with a gap between title bar and content intead of a shelf border gadget. --- basis/ui/gadgets/labeled/labeled-docs.factor | 15 +++++-- basis/ui/gadgets/labeled/labeled-tests.factor | 3 +- basis/ui/gadgets/labeled/labeled.factor | 41 ++++++------------- basis/ui/tools/error-list/error-list.factor | 6 +-- basis/ui/tools/inspector/inspector.factor | 4 +- basis/ui/tools/traceback/traceback.factor | 4 +- extra/gml/ui/ui.factor | 4 +- extra/merger/merger.factor | 3 +- 8 files changed, 35 insertions(+), 45 deletions(-) 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 38747107a0..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/tools/error-list/error-list.factor b/basis/ui/tools/error-list/error-list.factor index 51d63f01a2..e4a9298c28 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 dc30f5a209..9b134d15fb 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/extra/gml/ui/ui.factor b/extra/gml/ui/ui.factor index 14e4c66171..6f896f5ff4 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 ad2d61d673..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 From 52a503fef3d94d482edc03a7ecb17a8318d1b71c Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sun, 11 Feb 2018 10:02:36 -0800 Subject: [PATCH 4/5] minesweeper: click cells around question but not flagged. --- extra/minesweeper/minesweeper.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/extra/minesweeper/minesweeper.factor b/extra/minesweeper/minesweeper.factor index c44df91f1b..6ea30c432b 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* From ffb42c913eb1c525bccea8da7ebf250e970c661a Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sun, 11 Feb 2018 10:09:36 -0800 Subject: [PATCH 5/5] minesweeper: always relayout-1 on click/mark. This fixes the smiley uhoh to repaint immediately rather than waiting for the next timer tick. --- extra/minesweeper/minesweeper.factor | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/extra/minesweeper/minesweeper.factor b/extra/minesweeper/minesweeper.factor index 6ea30c432b..aece0341b6 100644 --- a/extra/minesweeper/minesweeper.factor +++ b/extra/minesweeper/minesweeper.factor @@ -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