Merge branch 'master' of git://factorcode.org/git/factor
commit
bb8aaf9ce0
|
@ -15,6 +15,7 @@ $nl
|
||||||
"Iterating over elements:"
|
"Iterating over elements:"
|
||||||
{ $subsection dlist-each }
|
{ $subsection dlist-each }
|
||||||
{ $subsection dlist-find }
|
{ $subsection dlist-find }
|
||||||
|
{ $subsection dlist-filter }
|
||||||
{ $subsection dlist-any? }
|
{ $subsection dlist-any? }
|
||||||
"Deleting a node matching a predicate:"
|
"Deleting a node matching a predicate:"
|
||||||
{ $subsection delete-node-if* }
|
{ $subsection delete-node-if* }
|
||||||
|
@ -40,6 +41,11 @@ HELP: dlist-find
|
||||||
"This operation is O(n)."
|
"This operation is O(n)."
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
|
HELP: dlist-filter
|
||||||
|
{ $values { "dlist" { $link dlist } } { "quot" quotation } { "dlist" { $link dlist } } }
|
||||||
|
{ $description "Applies the quotation to each element of the " { $link dlist } " in turn, removing the corresponding nodes if the quotation returns " { $link f } "." }
|
||||||
|
{ $side-effects { "dlist" } } ;
|
||||||
|
|
||||||
HELP: dlist-any?
|
HELP: dlist-any?
|
||||||
{ $values { "dlist" { $link dlist } } { "quot" quotation } { "?" "a boolean" } }
|
{ $values { "dlist" { $link dlist } } { "quot" quotation } { "?" "a boolean" } }
|
||||||
{ $description "Just like " { $link dlist-find } " except it doesn't return the object." }
|
{ $description "Just like " { $link dlist-find } " except it doesn't return the object." }
|
||||||
|
|
|
@ -79,3 +79,8 @@ IN: dlists.tests
|
||||||
[ V{ f 3 1 f } ] [ <dlist> 1 over push-front 3 over push-front f over push-front f over push-back dlist>seq ] unit-test
|
[ V{ f 3 1 f } ] [ <dlist> 1 over push-front 3 over push-front f over push-front f over push-back dlist>seq ] unit-test
|
||||||
|
|
||||||
[ V{ } ] [ <dlist> dlist>seq ] unit-test
|
[ V{ } ] [ <dlist> dlist>seq ] unit-test
|
||||||
|
|
||||||
|
[ V{ 0 2 4 } ] [ <dlist> { 0 1 2 3 4 } over push-all-back [ even? ] dlist-filter dlist>seq ] unit-test
|
||||||
|
[ V{ 2 4 } ] [ <dlist> { 1 2 3 4 } over push-all-back [ even? ] dlist-filter dlist>seq ] unit-test
|
||||||
|
[ V{ 2 4 } ] [ <dlist> { 1 2 3 4 5 } over push-all-back [ even? ] dlist-filter dlist>seq ] unit-test
|
||||||
|
[ V{ 0 2 4 } ] [ <dlist> { 0 1 2 3 4 5 } over push-all-back [ even? ] dlist-filter dlist>seq ] unit-test
|
||||||
|
|
|
@ -95,7 +95,7 @@ M: dlist pop-front* ( dlist -- )
|
||||||
[
|
[
|
||||||
[
|
[
|
||||||
[ empty-dlist ] unless*
|
[ empty-dlist ] unless*
|
||||||
[ f ] change-next drop
|
next>>
|
||||||
f over set-prev-when
|
f over set-prev-when
|
||||||
] change-front drop
|
] change-front drop
|
||||||
] keep
|
] keep
|
||||||
|
@ -108,7 +108,7 @@ M: dlist pop-back* ( dlist -- )
|
||||||
[
|
[
|
||||||
[
|
[
|
||||||
[ empty-dlist ] unless*
|
[ empty-dlist ] unless*
|
||||||
[ f ] change-prev drop
|
prev>>
|
||||||
f over set-next-when
|
f over set-next-when
|
||||||
] change-back drop
|
] change-back drop
|
||||||
] keep
|
] keep
|
||||||
|
@ -157,6 +157,9 @@ M: dlist clear-deque ( dlist -- )
|
||||||
|
|
||||||
: 1dlist ( obj -- dlist ) <dlist> [ push-front ] keep ;
|
: 1dlist ( obj -- dlist ) <dlist> [ push-front ] keep ;
|
||||||
|
|
||||||
|
: dlist-filter ( dlist quot -- dlist )
|
||||||
|
over [ '[ dup obj>> @ [ drop ] [ _ delete-node ] if ] dlist-each-node ] keep ; inline
|
||||||
|
|
||||||
M: dlist clone
|
M: dlist clone
|
||||||
<dlist> [ '[ _ push-back ] dlist-each ] keep ;
|
<dlist> [ '[ _ push-back ] dlist-each ] keep ;
|
||||||
|
|
||||||
|
|
|
@ -274,7 +274,7 @@ HELP: fp-nan-payload
|
||||||
{ $description "If " { $snippet "x" } " is an IEEE Not-a-Number value, returns the payload encoded in the value. Returns " { $link f } " if " { $snippet "x" } " is not a " { $link float } "." } ;
|
{ $description "If " { $snippet "x" } " is an IEEE Not-a-Number value, returns the payload encoded in the value. Returns " { $link f } " if " { $snippet "x" } " is not a " { $link float } "." } ;
|
||||||
|
|
||||||
HELP: <fp-nan>
|
HELP: <fp-nan>
|
||||||
{ $values { "payload" integer } { "float" float } }
|
{ $values { "payload" integer } { "nan" float } }
|
||||||
{ $description "Constructs an IEEE Not-a-Number value with a payload of " { $snippet "payload" } "." }
|
{ $description "Constructs an IEEE Not-a-Number value with a payload of " { $snippet "payload" } "." }
|
||||||
{ $notes "A " { $snippet "payload" } " of " { $snippet "0" } " will construct an Infinity value." } ;
|
{ $notes "A " { $snippet "payload" } " of " { $snippet "0" } " will construct an Infinity value." } ;
|
||||||
|
|
||||||
|
|
|
@ -1,14 +1,15 @@
|
||||||
USING: accessors game-input game-loop kernel ui.gadgets
|
USING: accessors game-input game-loop kernel math ui.gadgets
|
||||||
ui.gadgets.worlds ui.gestures ;
|
ui.gadgets.worlds ui.gestures ;
|
||||||
IN: game-worlds
|
IN: game-worlds
|
||||||
|
|
||||||
TUPLE: game-world < world
|
TUPLE: game-world < world
|
||||||
game-loop ;
|
game-loop
|
||||||
|
{ tick-slice float initial: 0.0 } ;
|
||||||
|
|
||||||
GENERIC: tick-length ( world -- millis )
|
GENERIC: tick-length ( world -- millis )
|
||||||
|
|
||||||
M: game-world draw*
|
M: game-world draw*
|
||||||
nip draw-world ;
|
swap >>tick-slice draw-world ;
|
||||||
|
|
||||||
M: game-world begin-world
|
M: game-world begin-world
|
||||||
dup [ tick-length ] [ ] bi <game-loop> [ >>game-loop ] keep start-loop
|
dup [ tick-length ] [ ] bi <game-loop> [ >>game-loop ] keep start-loop
|
||||||
|
|
|
@ -138,8 +138,11 @@ M: terrain-world tick-length
|
||||||
: apply-gravity ( velocity -- velocity' )
|
: apply-gravity ( velocity -- velocity' )
|
||||||
1 over [ GRAVITY - ] change-nth ;
|
1 over [ GRAVITY - ] change-nth ;
|
||||||
|
|
||||||
|
: clamp-coords ( coords dim -- coords' )
|
||||||
|
[ { 0 0 } vmax ] dip { 2 2 } v- vmin ;
|
||||||
|
|
||||||
:: pixel-indices ( coords dim -- indices )
|
:: pixel-indices ( coords dim -- indices )
|
||||||
coords vfloor [ >integer ] map :> floor-coords
|
coords vfloor [ >integer ] map dim clamp-coords :> floor-coords
|
||||||
floor-coords first2 dim first * + :> base-index
|
floor-coords first2 dim first * + :> base-index
|
||||||
base-index dim first + :> next-row-index
|
base-index dim first + :> next-row-index
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue