From 02e231633e6a2a0a69d52ec03d6329d7f3d1d45a Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Tue, 6 Mar 2018 15:50:47 -0800 Subject: [PATCH 01/14] minesweeper: reduce duplicated code for click/mark/open cells. --- extra/minesweeper/minesweeper.factor | 50 +++++++++------------------- 1 file changed, 16 insertions(+), 34 deletions(-) diff --git a/extra/minesweeper/minesweeper.factor b/extra/minesweeper/minesweeper.factor index bae4f2b4ce..1a9c7062e2 100644 --- a/extra/minesweeper/minesweeper.factor +++ b/extra/minesweeper/minesweeper.factor @@ -253,6 +253,19 @@ M: grid-gadget draw-gadget* [ draw-cells ] } cleave ; +:: on-grid ( gadget quot: ( cells row col -- ? ) -- ) + gadget hand-rel first2 :> ( w h ) + h 58 >= [ + h 58 - w [ 32 /i ] bi@ :> ( row col ) + gadget cells>> :> cells + cells game-over? [ + cells row col quot call [ + gadget start>> [ now gadget start<< ] unless + cells game-over? [ now gadget end<< ] when + ] when + ] unless + ] when gadget relayout-1 ; inline + :: on-click ( gadget -- ) gadget hand-rel first2 :> ( w h ) h 58 < [ @@ -261,42 +274,11 @@ M: grid-gadget draw-gadget* gadget [ reset-cells ] change-cells f >>start f >>end drop ] when - ] [ - h 58 - w [ 32 /i ] bi@ :> ( row col ) - gadget cells>> :> cells - cells game-over? [ - cells row col click-cell-at [ - gadget start>> [ now gadget start<< ] unless - cells game-over? [ now gadget end<< ] when - ] when - ] unless - ] if gadget relayout-1 ; + ] when gadget [ click-cell-at ] on-grid ; -:: on-mark ( gadget -- ) - gadget hand-rel first2 :> ( w h ) - h 58 >= [ - h 58 - w [ 32 /i ] bi@ :> ( row col ) - gadget cells>> :> cells - cells game-over? [ - cells row col mark-cell-at [ - gadget start>> [ now gadget start<< ] unless - cells game-over? [ now gadget end<< ] when - ] when - ] unless - ] when gadget relayout-1 ; +: on-mark ( gadget -- ) [ mark-cell-at ] on-grid ; -:: on-open ( gadget -- ) - gadget hand-rel first2 :> ( w h ) - h 58 >= [ - h 58 - w [ 32 /i ] bi@ :> ( row col ) - gadget cells>> :> cells - cells game-over? [ - cells row col open-cell-at [ - gadget start>> [ now gadget start<< ] unless - cells game-over? [ now gadget end<< ] when - ] when - ] unless - ] when gadget relayout-1 ; +: on-open ( gadget -- ) [ open-cell-at ] on-grid ; : new-game ( gadget rows cols mines -- ) [ make-cells ] dip place-mines update-counts >>cells From 2dc44cd360439c62ffd2bea9303ca55f2a31e828 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Tue, 6 Mar 2018 16:01:33 -0800 Subject: [PATCH 02/14] minesweeper: reduce duplicated code in count-neighbors. --- extra/minesweeper/minesweeper.factor | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/extra/minesweeper/minesweeper.factor b/extra/minesweeper/minesweeper.factor index 1a9c7062e2..960a6baf35 100644 --- a/extra/minesweeper/minesweeper.factor +++ b/extra/minesweeper/minesweeper.factor @@ -45,17 +45,16 @@ TUPLE: cell #adjacent mined? state ; : place-mines ( cells n -- cells ) [ dup unmined-cell t >>mined? drop ] times ; +:: count-neighbors ( cells row col quot: ( cell -- ? ) -- n ) + cells neighbors [ + first2 [ row + ] [ col + ] bi* cell-at quot [ f ] if* + ] with count ; inline + : adjacent-mines ( cells row col -- #mines ) - neighbors [ - first2 [ + ] bi-curry@ bi* cell-at - [ mined?>> ] [ f ] if* - ] with with with count ; + [ mined?>> ] count-neighbors ; : adjacent-flags ( cells row col -- #mines ) - neighbors [ - first2 [ + ] bi-curry@ bi* cell-at - [ state>> +flagged+ = ] [ f ] if* - ] with with with count ; + [ state>> +flagged+ = ] count-neighbors ; :: each-cell ( ... cells quot: ( ... row col cell -- ... ) -- ... ) cells [| row | From 074d4e9d0aa14324e79211c21d87b9ee95208da9 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Tue, 6 Mar 2018 16:02:20 -0800 Subject: [PATCH 03/14] minesweeper: fix stack effect in adjacent-flags. --- extra/minesweeper/minesweeper.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/minesweeper/minesweeper.factor b/extra/minesweeper/minesweeper.factor index 960a6baf35..eb96279e4a 100644 --- a/extra/minesweeper/minesweeper.factor +++ b/extra/minesweeper/minesweeper.factor @@ -53,7 +53,7 @@ TUPLE: cell #adjacent mined? state ; : adjacent-mines ( cells row col -- #mines ) [ mined?>> ] count-neighbors ; -: adjacent-flags ( cells row col -- #mines ) +: adjacent-flags ( cells row col -- #flags ) [ state>> +flagged+ = ] count-neighbors ; :: each-cell ( ... cells quot: ( ... row col cell -- ... ) -- ... ) From e37b530338e05f7a4a5e02923ba68021f34e61c5 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 9 Mar 2018 12:08:49 -0800 Subject: [PATCH 04/14] crontab: adding first version of crontab parser. --- extra/crontab/authors.txt | 1 + extra/crontab/crontab-tests.factor | 22 ++++++ extra/crontab/crontab.factor | 104 +++++++++++++++++++++++++++++ extra/crontab/summary.txt | 1 + 4 files changed, 128 insertions(+) create mode 100644 extra/crontab/authors.txt create mode 100644 extra/crontab/crontab-tests.factor create mode 100644 extra/crontab/crontab.factor create mode 100644 extra/crontab/summary.txt diff --git a/extra/crontab/authors.txt b/extra/crontab/authors.txt new file mode 100644 index 0000000000..e091bb8164 --- /dev/null +++ b/extra/crontab/authors.txt @@ -0,0 +1 @@ +John Benediktsson diff --git a/extra/crontab/crontab-tests.factor b/extra/crontab/crontab-tests.factor new file mode 100644 index 0000000000..e0ba8d6dea --- /dev/null +++ b/extra/crontab/crontab-tests.factor @@ -0,0 +1,22 @@ +USING: calendar crontab kernel tools.test ; + +{ + T{ timestamp + { year 2018 } + { month 3 } + { day 9 } + { hour 12 } + { minute 23 } + { gmt-offset T{ duration { hour -8 } } } + } +} [ + "23 0-20/2 * * *" parse-cronentry + T{ timestamp + { year 2018 } + { month 3 } + { day 9 } + { hour 12 } + { minute 6 } + { gmt-offset T{ duration { hour -8 } } } + } [ next-time-after ] keep +] unit-test diff --git a/extra/crontab/crontab.factor b/extra/crontab/crontab.factor new file mode 100644 index 0000000000..c214cec8fb --- /dev/null +++ b/extra/crontab/crontab.factor @@ -0,0 +1,104 @@ +! Copyright (C) 2018 John Benediktsson +! See http://factorcode.org/license.txt for BSD license + +USING: accessors arrays ascii assocs calendar calendar.english +calendar.private combinators io kernel literals locals math +math.order math.parser math.ranges sequences splitting ; + +IN: crontab + +:: parse-value ( value quot: ( value -- value' ) seq -- value ) + value { + { [ CHAR: , over member? ] [ + "," split [ quot seq parse-value ] map concat ] } + { [ dup "*" = ] [ drop seq ] } + { [ CHAR: / over member? ] [ + "/" split1 [ quot seq parse-value 0 over length 1 - ] dip + string>number swap nths ] } + { [ CHAR: - over member? ] [ + "-" split1 quot bi@ [a,b] ] } + [ quot call 1array ] + } cond ; inline recursive + +: parse-day ( str -- n ) + dup string>number [ ] [ + >lower $[ day-abbreviations3 [ >lower ] map ] index + ] ?if ; + +: parse-month ( str -- n ) + dup string>number [ ] [ + >lower $[ month-abbreviations [ >lower ] map ] index + ] ?if ; + +TUPLE: cronentry minutes hours days months days-of-week command ; + +CONSTANT: aliases H{ + { "@yearly" "0 0 1 1 *" } + { "@annually" "0 0 1 1 *" } + { "@monthly" "0 0 1 * *" } + { "@weekly" "0 0 * * 0" } + { "@daily" "0 0 * * *" } + { "@midnight" "0 0 * * *" } + { "@hourly" "0 * * * *" } +} + +: parse-cronentry ( entry -- cronentry ) + " " split1 [ aliases ?at drop ] dip " " glue + " " split1 " " split1 " " split1 " " split1 " " split1 { + [ [ string>number ] T{ range f 0 60 1 } parse-value ] + [ [ string>number ] T{ range f 0 24 1 } parse-value ] + [ [ string>number ] T{ range f 0 31 1 } parse-value ] + [ [ parse-month ] T{ range f 0 12 1 } parse-value ] + [ [ parse-day ] T{ range f 0 7 1 } parse-value ] + [ ] + } spread cronentry boa ; + +:: next-time-after ( cronentry timestamp -- ) + + timestamp month>> :> month + cronentry months>> [ month >= ] find nip [ + dup month = [ drop f ] [ timestamp month<< t ] if + ] [ + timestamp cronentry months>> first >>month 1 +year + ] if* [ cronentry timestamp next-time-after ] when + + timestamp hour>> :> hour + cronentry hours>> [ hour >= ] find nip [ + dup hour = [ drop f ] [ + timestamp hour<< 0 timestamp minute<< t + ] if + ] [ + timestamp cronentry hours>> first >>hour 1 +day + ] if* [ cronentry timestamp next-time-after ] when + + timestamp minute>> :> minute + cronentry minutes>> [ minute >= ] find nip [ + dup minute = [ drop f ] [ timestamp minute<< t ] if + ] [ + timestamp cronentry minutes>> first >>minute 1 +hour + ] if* [ cronentry timestamp next-time-after ] when + + timestamp day-of-week :> weekday + cronentry days-of-week>> [ weekday >= ] find nip [ + cronentry days-of-week>> first 7 + + ] unless* weekday - + + timestamp day>> :> day + cronentry days>> [ day >= ] find nip [ + day - + ] [ + timestamp 1 months time+ + cronentry days>> first >>day + day-of-year timestamp day-of-year - + ] if* + + min [ + timestamp swap +day drop + cronentry timestamp next-time-after + ] unless-zero ; + +: next-time ( cronentry -- timestamp ) + now 0 >>second [ next-time-after ] keep ; + +: parse-crontab ( -- entries ) + lines [ [ f ] [ parse-cronentry ] if-empty ] map harvest ; diff --git a/extra/crontab/summary.txt b/extra/crontab/summary.txt new file mode 100644 index 0000000000..c754345ba1 --- /dev/null +++ b/extra/crontab/summary.txt @@ -0,0 +1 @@ +Parser for crontab files From 17eabacd2b939f82211b29942daa701ac6c8ceae Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 9 Mar 2018 12:13:07 -0800 Subject: [PATCH 05/14] game-of-life: experimental Conway's Game of Life. --- extra/game-of-life/authors.txt | 1 + extra/game-of-life/game-of-life.factor | 162 +++++++++++++++++++++++++ extra/game-of-life/summary.txt | 1 + extra/game-of-life/tags.txt | 1 + 4 files changed, 165 insertions(+) create mode 100644 extra/game-of-life/authors.txt create mode 100644 extra/game-of-life/game-of-life.factor create mode 100644 extra/game-of-life/summary.txt create mode 100644 extra/game-of-life/tags.txt diff --git a/extra/game-of-life/authors.txt b/extra/game-of-life/authors.txt new file mode 100644 index 0000000000..e091bb8164 --- /dev/null +++ b/extra/game-of-life/authors.txt @@ -0,0 +1 @@ +John Benediktsson diff --git a/extra/game-of-life/game-of-life.factor b/extra/game-of-life/game-of-life.factor new file mode 100644 index 0000000000..0e6cf18e42 --- /dev/null +++ b/extra/game-of-life/game-of-life.factor @@ -0,0 +1,162 @@ +! Copyright (C) 2018 John Benediktsson +! See http://factorcode.org/license.txt for BSD license + +USING: accessors arrays assocs bit-arrays calendar circular +colors.constants fry kernel locals math math.order namespaces +opengl random sequences timers ui ui.commands ui.gadgets +ui.gadgets.toolbar ui.gadgets.tracks ui.gestures ui.render words +; + +IN: game-of-life + +: make-grid ( rows cols -- grid ) + '[ _ ] replicate ; + +: glider ( grid -- grid ) + { { 2 1 } { 3 2 } { 1 3 } { 2 3 } { 3 3 } } + [ first2 pick nth t -rot set-nth ] each ; + +: grid-dim ( grid -- rows cols ) + [ length ] [ first length ] bi ; + +CONSTANT: neighbors { + { -1 -1 } { -1 0 } { -1 1 } + { 0 -1 } { 0 1 } + { 1 -1 } { 1 0 } { 1 1 } +} + +:: count-neighbors ( grid -- counts ) + grid grid-dim :> ( rows cols ) + rows [| j | + cols [| i | + neighbors [ + first2 [ i + ] [ j + ] bi* grid nth nth + ] count + ] map + ] map ; + +:: next-step ( grid -- ) + grid count-neighbors :> neighbors + grid [| row j | + row [| cell i | + i j neighbors nth nth :> n + cell [ + n 2 3 between? i j grid nth set-nth + ] [ + n 3 = [ + t i j grid nth set-nth + ] when + ] if + ] each-index + ] each-index ; + +TUPLE: grid-gadget < gadget grid timer ; + +: ( grid -- gadget ) + grid-gadget new + swap >>grid + dup '[ _ [ grid>> next-step ] [ relayout-1 ] bi ] + f 1/5 seconds >>timer ; + +M: grid-gadget graft* + [ timer>> start-timer ] [ call-next-method ] bi ; + +M: grid-gadget ungraft* + [ timer>> stop-timer ] [ call-next-method ] bi ; + +M: grid-gadget pref-dim* + grid>> grid-dim [ 20 * ] bi@ 2array ; + +:: draw-cells ( gadget -- ) + COLOR: black gl-color + gadget grid>> [| row j | + row [| cell i | + cell [ + i j [ 20 * ] bi@ 2array { 20 20 } gl-fill-rect + ] when + ] each-index + ] each-index ; + +:: draw-lines ( gadget -- ) + gadget pref-dim first2 :> ( w h ) + gadget grid>> grid-dim :> ( rows cols ) + COLOR: gray gl-color + rows [| j | + j 20 * :> y + { 0 y } { w y } gl-line + cols [| i | + i 20 * :> x + { x 0 } { x h } gl-line + ] each + ] each ; + +M: grid-gadget draw-gadget* + [ draw-cells ] [ draw-lines ] bi ; + +:: on-click ( gadget -- ) + gadget hand-rel first2 [ 20 /i ] bi@ :> ( i j ) + i j [ 0 19 between? ] bi@ and [ + i j gadget grid>> nth [ not ] change-nth + ] when gadget relayout-1 ; + +:: on-drag ( gadget -- ) + gadget hand-rel first2 [ 20 /i ] bi@ :> ( i j ) + i j [ 0 19 between? ] bi@ and [ + t i j gadget grid>> nth set-nth + ] when gadget relayout-1 ; + +:: com-play ( gadget -- ) + gadget timer>> thread>> [ + gadget timer>> start-timer + ] unless ; + +:: com-step ( gadget -- ) + gadget grid>> next-step + gadget relayout-1 ; + +:: com-stop ( gadget -- ) + gadget timer>> thread>> [ + gadget timer>> stop-timer + ] when ; + +:: com-clear ( gadget -- ) + gadget grid>> [ seq>> clear-bits ] each + gadget relayout-1 ; + +:: com-random ( gadget -- ) + gadget grid>> [ [ drop { t f } random ] map! drop ] each + gadget relayout-1 ; + +:: com-glider ( gadget -- ) + gadget grid>> glider drop + gadget relayout-1 ; + +grid-gadget "toolbar" f { + { T{ key-down { sym "1" } } com-play } + { T{ key-down { sym "2" } } com-stop } + { T{ key-down { sym "3" } } com-clear } + { T{ key-down { sym "4" } } com-random } + { T{ key-down { sym "5" } } com-glider } + { T{ key-down { sym "6" } } com-step } +} define-command-map + +grid-gadget "gestures" [ + { + { T{ button-down { # 1 } } [ on-click ] } + { T{ drag { # 1 } } [ on-drag ] } + } assoc-union +] change-word-prop + +TUPLE: life-gadget < track ; + +: ( -- gadget ) + vertical life-gadget new-track + 20 20 make-grid + [ format-toolbar f track-add ] + [ 1 track-add ] bi ; + +M: life-gadget focusable-child* children>> second ; + +MAIN-WINDOW: life-window { + { title "Game of Life" } + } >>gadgets ; diff --git a/extra/game-of-life/summary.txt b/extra/game-of-life/summary.txt new file mode 100644 index 0000000000..78cc607252 --- /dev/null +++ b/extra/game-of-life/summary.txt @@ -0,0 +1 @@ +Conway's Game of Life diff --git a/extra/game-of-life/tags.txt b/extra/game-of-life/tags.txt new file mode 100644 index 0000000000..cb5fc203e1 --- /dev/null +++ b/extra/game-of-life/tags.txt @@ -0,0 +1 @@ +demos From efb2f0ed550a02d30782df700fa25b9e87d5a605 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 9 Mar 2018 14:24:50 -0800 Subject: [PATCH 06/14] game-of-life: implement scrolling and resizable windows. --- extra/game-of-life/game-of-life.factor | 80 +++++++++++++++++++------- 1 file changed, 58 insertions(+), 22 deletions(-) diff --git a/extra/game-of-life/game-of-life.factor b/extra/game-of-life/game-of-life.factor index 0e6cf18e42..969f1aca59 100644 --- a/extra/game-of-life/game-of-life.factor +++ b/extra/game-of-life/game-of-life.factor @@ -2,20 +2,16 @@ ! See http://factorcode.org/license.txt for BSD license USING: accessors arrays assocs bit-arrays calendar circular -colors.constants fry kernel locals math math.order namespaces -opengl random sequences timers ui ui.commands ui.gadgets -ui.gadgets.toolbar ui.gadgets.tracks ui.gestures ui.render words -; +colors.constants combinators fry kernel locals math math.order +math.ranges namespaces opengl random sequences timers ui +ui.commands ui.gadgets ui.gadgets.toolbar ui.gadgets.tracks +ui.gestures ui.render words ; IN: game-of-life : make-grid ( rows cols -- grid ) '[ _ ] replicate ; -: glider ( grid -- grid ) - { { 2 1 } { 3 2 } { 1 3 } { 2 3 } { 3 3 } } - [ first2 pick nth t -rot set-nth ] each ; - : grid-dim ( grid -- rows cols ) [ length ] [ first length ] bi ; @@ -50,11 +46,12 @@ CONSTANT: neighbors { ] each-index ] each-index ; -TUPLE: grid-gadget < gadget grid timer ; +TUPLE: grid-gadget < gadget grid size timer ; : ( grid -- gadget ) grid-gadget new swap >>grid + 20 >>size dup '[ _ [ grid>> next-step ] [ relayout-1 ] bi ] f 1/5 seconds >>timer ; @@ -65,46 +62,81 @@ M: grid-gadget ungraft* [ timer>> stop-timer ] [ call-next-method ] bi ; M: grid-gadget pref-dim* - grid>> grid-dim [ 20 * ] bi@ 2array ; + [ grid>> grid-dim ] [ size>> '[ _ * ] bi@ 2array ] bi ; + +:: update-grid ( gadget -- ) + gadget dim>> first2 :> ( w h ) + gadget size>> :> size + h w [ size /i ] bi@ :> ( new-rows new-cols ) + gadget grid>> :> grid + grid grid-dim :> ( rows cols ) + rows new-rows = not + cols new-cols = not or [ + new-rows new-cols make-grid :> new-grid + rows new-rows min [| j | + cols new-cols min [| i | + i j grid nth nth + i j new-grid nth set-nth + ] each + ] each + new-grid gadget grid<< + ] when ; :: draw-cells ( gadget -- ) COLOR: black gl-color + gadget size>> :> size gadget grid>> [| row j | row [| cell i | cell [ - i j [ 20 * ] bi@ 2array { 20 20 } gl-fill-rect + i j [ size * ] bi@ 2array { size size } gl-fill-rect ] when ] each-index ] each-index ; :: draw-lines ( gadget -- ) - gadget pref-dim first2 :> ( w h ) + gadget size>> :> size gadget grid>> grid-dim :> ( rows cols ) COLOR: gray gl-color - rows [| j | - j 20 * :> y + cols rows [ size * ] bi@ :> ( w h ) + rows [0,b] [| j | + j size * :> y { 0 y } { w y } gl-line - cols [| i | - i 20 * :> x + cols [0,b] [| i | + i size * :> x { x 0 } { x h } gl-line ] each ] each ; M: grid-gadget draw-gadget* - [ draw-cells ] [ draw-lines ] bi ; + [ update-grid ] [ draw-cells ] [ draw-lines ] tri ; :: on-click ( gadget -- ) - gadget hand-rel first2 [ 20 /i ] bi@ :> ( i j ) - i j [ 0 19 between? ] bi@ and [ + gadget size>> :> size + gadget grid>> grid-dim :> ( rows cols ) + gadget hand-rel first2 [ size /i ] bi@ :> ( i j ) + i 0 cols 1 - between? + j 0 rows 1 - between? and [ i j gadget grid>> nth [ not ] change-nth ] when gadget relayout-1 ; :: on-drag ( gadget -- ) - gadget hand-rel first2 [ 20 /i ] bi@ :> ( i j ) - i j [ 0 19 between? ] bi@ and [ + gadget size>> :> size + gadget grid>> grid-dim :> ( rows cols ) + gadget hand-rel first2 [ size /i ] bi@ :> ( i j ) + i 0 cols 1 - between? + j 0 rows 1 - between? and [ t i j gadget grid>> nth set-nth ] when gadget relayout-1 ; +: on-scroll ( gadget -- ) + [ + scroll-direction get second { + { [ dup 0 > ] [ 2 ] } + { [ dup 0 < ] [ -2 ] } + [ 0 ] + } cond nip + 4 30 clamp + ] change-size relayout-1 ; + :: com-play ( gadget -- ) gadget timer>> thread>> [ gadget timer>> start-timer @@ -128,7 +160,9 @@ M: grid-gadget draw-gadget* gadget relayout-1 ; :: com-glider ( gadget -- ) - gadget grid>> glider drop + gadget grid>> :> grid + { { 2 1 } { 3 2 } { 1 3 } { 2 3 } { 3 3 } } + [ first2 grid nth t -rot set-nth ] each gadget relayout-1 ; grid-gadget "toolbar" f { @@ -142,8 +176,10 @@ grid-gadget "toolbar" f { grid-gadget "gestures" [ { + { T{ key-down f { A+ } "F" } [ toggle-fullscreen ] } { T{ button-down { # 1 } } [ on-click ] } { T{ drag { # 1 } } [ on-drag ] } + { mouse-scroll [ on-scroll ] } } assoc-union ] change-word-prop From c24779d27e34513fa8360b97bbabf4a7b2aa91ea Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 9 Mar 2018 14:32:30 -0800 Subject: [PATCH 07/14] game-of-life: small updates. --- extra/game-of-life/game-of-life.factor | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/extra/game-of-life/game-of-life.factor b/extra/game-of-life/game-of-life.factor index 969f1aca59..3fefe7a928 100644 --- a/extra/game-of-life/game-of-life.factor +++ b/extra/game-of-life/game-of-life.factor @@ -35,13 +35,11 @@ CONSTANT: neighbors { grid count-neighbors :> neighbors grid [| row j | row [| cell i | - i j neighbors nth nth :> n + i j neighbors nth nth cell [ - n 2 3 between? i j grid nth set-nth + 2 3 between? i j grid nth set-nth ] [ - n 3 = [ - t i j grid nth set-nth - ] when + 3 = [ t i j grid nth set-nth ] when ] if ] each-index ] each-index ; @@ -55,9 +53,6 @@ TUPLE: grid-gadget < gadget grid size timer ; dup '[ _ [ grid>> next-step ] [ relayout-1 ] bi ] f 1/5 seconds >>timer ; -M: grid-gadget graft* - [ timer>> start-timer ] [ call-next-method ] bi ; - M: grid-gadget ungraft* [ timer>> stop-timer ] [ call-next-method ] bi ; @@ -88,7 +83,8 @@ M: grid-gadget pref-dim* gadget grid>> [| row j | row [| cell i | cell [ - i j [ size * ] bi@ 2array { size size } gl-fill-rect + i j [ size * ] bi@ 2array + { size size } gl-fill-rect ] when ] each-index ] each-index ; @@ -110,13 +106,16 @@ M: grid-gadget pref-dim* M: grid-gadget draw-gadget* [ update-grid ] [ draw-cells ] [ draw-lines ] tri ; +SYMBOL: last-click + :: on-click ( gadget -- ) gadget size>> :> size gadget grid>> grid-dim :> ( rows cols ) gadget hand-rel first2 [ size /i ] bi@ :> ( i j ) i 0 cols 1 - between? j 0 rows 1 - between? and [ - i j gadget grid>> nth [ not ] change-nth + i j gadget grid>> nth + [ not dup last-click set ] change-nth ] when gadget relayout-1 ; :: on-drag ( gadget -- ) @@ -125,7 +124,7 @@ M: grid-gadget draw-gadget* gadget hand-rel first2 [ size /i ] bi@ :> ( i j ) i 0 cols 1 - between? j 0 rows 1 - between? and [ - t i j gadget grid>> nth set-nth + last-click get i j gadget grid>> nth set-nth ] when gadget relayout-1 ; : on-scroll ( gadget -- ) From 9e563c41035fd354c6b1b7ba049bc61c3d3619d0 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 9 Mar 2018 15:04:23 -0800 Subject: [PATCH 08/14] game-of-life: ugly code that makes next-step faster. --- extra/game-of-life/game-of-life.factor | 53 +++++++++++++++++--------- 1 file changed, 34 insertions(+), 19 deletions(-) diff --git a/extra/game-of-life/game-of-life.factor b/extra/game-of-life/game-of-life.factor index 3fefe7a928..76467c2daa 100644 --- a/extra/game-of-life/game-of-life.factor +++ b/extra/game-of-life/game-of-life.factor @@ -1,33 +1,40 @@ ! Copyright (C) 2018 John Benediktsson ! See http://factorcode.org/license.txt for BSD license -USING: accessors arrays assocs bit-arrays calendar circular -colors.constants combinators fry kernel locals math math.order -math.ranges namespaces opengl random sequences timers ui -ui.commands ui.gadgets ui.gadgets.toolbar ui.gadgets.tracks -ui.gestures ui.render words ; +USING: accessors arrays assocs bit-arrays calendar +colors.constants combinators combinators.short-circuit fry +kernel kernel.private locals math math.order math.private +math.ranges namespaces opengl random sequences sequences.private +timers ui ui.commands ui.gadgets ui.gadgets.toolbar +ui.gadgets.tracks ui.gestures ui.render words ; IN: game-of-life : make-grid ( rows cols -- grid ) - '[ _ ] replicate ; + '[ _ ] replicate ; : grid-dim ( grid -- rows cols ) [ length ] [ first length ] bi ; -CONSTANT: neighbors { - { -1 -1 } { -1 0 } { -1 1 } - { 0 -1 } { 0 1 } - { 1 -1 } { 1 0 } { 1 1 } -} - :: count-neighbors ( grid -- counts ) - grid grid-dim :> ( rows cols ) + grid grid-dim { fixnum fixnum } declare :> ( rows cols ) rows [| j | cols [| i | - neighbors [ - first2 [ i + ] [ j + ] bi* grid nth nth - ] count + { -1 0 1 } [ + { -1 0 1 } [ + [ i fixnum+fast ] [ j fixnum+fast ] bi* + { fixnum fixnum } declare :> ( col row ) + { + [ col i = not ] [ row i = not ] + [ col 0 >= ] [ col cols < ] + [ row 0 >= ] [ row rows < ] + } 0&& [ + col row grid + { array } declare nth-unsafe + { bit-array } declare nth-unsafe + ] [ f ] if + ] with count + ] map-sum ] map ] map ; @@ -35,11 +42,19 @@ CONSTANT: neighbors { grid count-neighbors :> neighbors grid [| row j | row [| cell i | - i j neighbors nth nth + i j neighbors + { array } declare nth-unsafe + { array } declare nth-unsafe cell [ - 2 3 between? i j grid nth set-nth + 2 3 between? i j grid + { array } declare nth-unsafe + { bit-array } declare set-nth-unsafe ] [ - 3 = [ t i j grid nth set-nth ] when + 3 = [ + t i j grid + { array } declare nth-unsafe + { bit-array } declare set-nth-unsafe + ] when ] if ] each-index ] each-index ; From 0c9086b385f7c97e5724de219b2e9c61258c9bb4 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 9 Mar 2018 15:29:22 -0800 Subject: [PATCH 09/14] game-of-life: fix inevitable bug in faster code. --- extra/game-of-life/game-of-life.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/game-of-life/game-of-life.factor b/extra/game-of-life/game-of-life.factor index 76467c2daa..d03fa2fe0a 100644 --- a/extra/game-of-life/game-of-life.factor +++ b/extra/game-of-life/game-of-life.factor @@ -25,7 +25,7 @@ IN: game-of-life [ i fixnum+fast ] [ j fixnum+fast ] bi* { fixnum fixnum } declare :> ( col row ) { - [ col i = not ] [ row i = not ] + [ col i = row j = and not ] [ col 0 >= ] [ col cols < ] [ row 0 >= ] [ row rows < ] } 0&& [ @@ -166,7 +166,7 @@ SYMBOL: last-click ] when ; :: com-clear ( gadget -- ) - gadget grid>> [ seq>> clear-bits ] each + gadget grid>> [ clear-bits ] each gadget relayout-1 ; :: com-random ( gadget -- ) From 25fc79a40caa0795254e95109884b5ef93265c8f Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 9 Mar 2018 15:53:29 -0800 Subject: [PATCH 10/14] game-of-life: faster com-random. --- extra/game-of-life/game-of-life.factor | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/extra/game-of-life/game-of-life.factor b/extra/game-of-life/game-of-life.factor index d03fa2fe0a..f96b4268fb 100644 --- a/extra/game-of-life/game-of-life.factor +++ b/extra/game-of-life/game-of-life.factor @@ -170,8 +170,10 @@ SYMBOL: last-click gadget relayout-1 ; :: com-random ( gadget -- ) - gadget grid>> [ [ drop { t f } random ] map! drop ] each - gadget relayout-1 ; + gadget grid>> [ + [ length>> ] [ underlying>> length random-bytes ] bi + bit-array boa + ] map! drop gadget relayout-1 ; :: com-glider ( gadget -- ) gadget grid>> :> grid From 5e7bfd7cc48a9622a0c7ba4c57a593edb50374bc Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 9 Mar 2018 16:32:08 -0800 Subject: [PATCH 11/14] game-of-life: flip scroll direction. --- extra/game-of-life/game-of-life.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/game-of-life/game-of-life.factor b/extra/game-of-life/game-of-life.factor index f96b4268fb..90a41bedbf 100644 --- a/extra/game-of-life/game-of-life.factor +++ b/extra/game-of-life/game-of-life.factor @@ -72,7 +72,7 @@ M: grid-gadget ungraft* [ timer>> stop-timer ] [ call-next-method ] bi ; M: grid-gadget pref-dim* - [ grid>> grid-dim ] [ size>> '[ _ * ] bi@ 2array ] bi ; + [ grid>> grid-dim swap ] [ size>> '[ _ * ] bi@ 1 + 2array ] bi ; :: update-grid ( gadget -- ) gadget dim>> first2 :> ( w h ) @@ -145,8 +145,8 @@ SYMBOL: last-click : on-scroll ( gadget -- ) [ scroll-direction get second { - { [ dup 0 > ] [ 2 ] } - { [ dup 0 < ] [ -2 ] } + { [ dup 0 > ] [ -2 ] } + { [ dup 0 < ] [ 2 ] } [ 0 ] } cond nip + 4 30 clamp ] change-size relayout-1 ; From 7179394ea02bb69d37dfa4d44cb4b0bbac506842 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 9 Mar 2018 16:53:05 -0800 Subject: [PATCH 12/14] game-of-life: count-neighbors needs circular wraparound logic back. --- extra/game-of-life/game-of-life.factor | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/extra/game-of-life/game-of-life.factor b/extra/game-of-life/game-of-life.factor index 90a41bedbf..ddff0ae437 100644 --- a/extra/game-of-life/game-of-life.factor +++ b/extra/game-of-life/game-of-life.factor @@ -16,23 +16,22 @@ IN: game-of-life : grid-dim ( grid -- rows cols ) [ length ] [ first length ] bi ; +:: wraparound ( x min max -- y ) + x min < [ max ] [ x max > min x ? ] if ; inline + :: count-neighbors ( grid -- counts ) grid grid-dim { fixnum fixnum } declare :> ( rows cols ) rows [| j | cols [| i | { -1 0 1 } [ { -1 0 1 } [ - [ i fixnum+fast ] [ j fixnum+fast ] bi* - { fixnum fixnum } declare :> ( col row ) - { - [ col i = row j = and not ] - [ col 0 >= ] [ col cols < ] - [ row 0 >= ] [ row rows < ] - } 0&& [ - col row grid + 2dup [ zero? ] both? [ 2drop f ] [ + [ i fixnum+fast 0 cols 1 - wraparound ] + [ j fixnum+fast 0 rows 1 - wraparound ] bi* + { fixnum fixnum } declare grid { array } declare nth-unsafe { bit-array } declare nth-unsafe - ] [ f ] if + ] if ] with count ] map-sum ] map From 0a9752fcc963d2fd3db1aa0c01f3d01add7cbfc9 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 9 Mar 2018 16:58:11 -0800 Subject: [PATCH 13/14] game-of-life: more speed in count-neighbors. --- extra/game-of-life/game-of-life.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/game-of-life/game-of-life.factor b/extra/game-of-life/game-of-life.factor index ddff0ae437..5bf48e1151 100644 --- a/extra/game-of-life/game-of-life.factor +++ b/extra/game-of-life/game-of-life.factor @@ -17,7 +17,7 @@ IN: game-of-life [ length ] [ first length ] bi ; :: wraparound ( x min max -- y ) - x min < [ max ] [ x max > min x ? ] if ; inline + x min fixnum< [ max ] [ x max fixnum> min x ? ] if ; inline :: count-neighbors ( grid -- counts ) grid grid-dim { fixnum fixnum } declare :> ( rows cols ) @@ -25,7 +25,7 @@ IN: game-of-life cols [| i | { -1 0 1 } [ { -1 0 1 } [ - 2dup [ zero? ] both? [ 2drop f ] [ + 2dup [ 0 eq? ] both? [ 2drop f ] [ [ i fixnum+fast 0 cols 1 - wraparound ] [ j fixnum+fast 0 rows 1 - wraparound ] bi* { fixnum fixnum } declare grid From 8c6925294f4e63e2011462c5ba0a814211082c65 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 11 Mar 2018 00:13:22 -0600 Subject: [PATCH 14/14] Nmakefile, build.cmd: Set the build information in Nmakefile. If there is no .git directory, assume we are on master branch. Fixes #1970. --- Nmakefile | 30 ++++++++++++++++++++++++++---- build.cmd | 10 ++++------ 2 files changed, 30 insertions(+), 10 deletions(-) diff --git a/Nmakefile b/Nmakefile index 3dd0b60cda..81751fff1a 100644 --- a/Nmakefile +++ b/Nmakefile @@ -1,10 +1,32 @@ -!IF !DEFINED(VERSION) -VERSION = version-missing +VERSION = 0.98 + +# Crazy hack to do shell commands +# We do it in Nmakefile because that way we don't have to invoke build through build.cmd +# and we can just do ``nmake /f Nmakefile x86-64-vista`` or similar +# and we still get the git branch, id, etc + +!IF [git describe --all > git-describe.tmp] == 0 +GIT_DESCRIBE = \ +!INCLUDE +!IF [rm git-describe.tmp] == 0 +!ENDIF !ENDIF -!IF !DEFINED(GIT_LABEL) -GIT_LABEL = git-label-missing +!IF [git rev-parse HEAD > git-id.tmp] == 0 +GIT_ID = \ +!INCLUDE +!IF [rm git-id.tmp] == 0 !ENDIF +!ENDIF + +!IF [git rev-parse --abbrev-ref HEAD > git-branch.tmp] == 0 +GIT_BRANCH = \ +!INCLUDE +!IF [rm git-branch.tmp] == 0 +!ENDIF +!ENDIF + +GIT_LABEL = $(GIT_DESCRIBE)-$(GIT_ID) !IF DEFINED(PLATFORM) diff --git a/build.cmd b/build.cmd index 0ba6ede3cb..757bf45f37 100644 --- a/build.cmd +++ b/build.cmd @@ -1,10 +1,11 @@ @echo off setlocal -: Fun syntax -for /f %%x in ('git describe --all') do set GIT_DESCRIBE=%%x -for /f %%y in ('git rev-parse HEAD') do set GIT_ID=%%y +: Check which branch we are on, or just assume master if we are not in a git repository for /f %%z in ('git rev-parse --abbrev-ref HEAD') do set GIT_BRANCH=%%z +if %GIT_BRANCH% =="" ( + GIT_BRANCH = "master" +) if "%1"=="/?" ( goto usage @@ -34,9 +35,6 @@ if not errorlevel 1 ( ) else goto nocl ) -set git_label=%GIT_DESCRIBE%-%GIT_ID% -set version=0.98 - echo Deleting staging images from temp/... del temp\staging.*.image