unify begin/search and each/more by changing iteration protocol
This commit is contained in:
parent
e96942da52
commit
465f8c60b8
25
defs.jor
25
defs.jor
|
@ -47,28 +47,17 @@
|
||||||
[ ' repeat , ] ' drop , ' rdrop , ; immediate
|
[ ' repeat , ] ' drop , ' rdrop , ; immediate
|
||||||
|
|
||||||
: yield rswap ;
|
: yield rswap ;
|
||||||
: each [ ' begin , ] ' dup , [ ' while , ] ; immediate
|
: done rdrop 0 r> rswap ;
|
||||||
: more ' yield , [ ' repeat , ] ' drop , ] ; immediate
|
: ;done ' done , ] ; immediate
|
||||||
: dobreak yield 0 ;
|
: each [ ' begin , ] ' r@ , [ ' while , ] ; immediate
|
||||||
: break ' rdrop , ' dobreak , ; immediate
|
: more ' yield , [ ' repeat , ] ' rdrop , ; immediate
|
||||||
|
: break rswap rdrop :| yield done |; execute rswap ;
|
||||||
|
|
||||||
: links begin yield @ dup not until ;
|
: links begin yield @ dup not until drop ;done
|
||||||
|
|
||||||
: files findfile begin dup while yield nextfile repeat ;
|
: files findfile begin dup while yield nextfile repeat drop ;done
|
||||||
: .files files each type s" " type more ;
|
: .files files each type s" " type more ;
|
||||||
|
|
||||||
( usage:
|
|
||||||
: search-xy { x y -- b r: coroutine } begin 2dup search >rot drop drop ;
|
|
||||||
: test-xy { x y -- b }
|
|
||||||
search-xy 1 2 2= yield 3 4 2= yield drop drop 999 yield ;
|
|
||||||
test-xy will return 1 if x y is 1 2 or 3 4, otherwise it returns 999.
|
|
||||||
Note that it must always end with a yield, as search has no way to tell
|
|
||||||
the difference between an early termination and a final non-zero result.
|
|
||||||
)
|
|
||||||
: search
|
|
||||||
' yield , ' dup , ' not , [ ' while , ] ' drop , [ ' repeat , ]
|
|
||||||
' rdrop , ; immediate
|
|
||||||
|
|
||||||
: min ( x y -- x|y ) 2dup > if swap then drop ;
|
: min ( x y -- x|y ) 2dup > if swap then drop ;
|
||||||
: max ( x y -- x|y ) 2dup < if swap then drop ;
|
: max ( x y -- x|y ) 2dup < if swap then drop ;
|
||||||
|
|
||||||
|
|
10
game.jor
10
game.jor
|
@ -74,11 +74,9 @@ defer player
|
||||||
|
|
||||||
defer player-touch ( x y -- b )
|
defer player-touch ( x y -- b )
|
||||||
|
|
||||||
: touch-begin begin 2dup search >rot drop drop 1 - ;
|
: touch-begin each 2dup more >rot drop drop ;
|
||||||
: touched? if 2 else 1 then ;
|
: touch-next dup if rdrop done then drop rswap ;
|
||||||
: touched-more? if 2 else 0 then ;
|
: touch-last ' done , ; immediate
|
||||||
: touch-next ' touched-more? , ' yield , ; immediate
|
|
||||||
: touch-last ' touched? , ' yield , ; immediate
|
|
||||||
: ;touch [ ' touch-last , ' [ , ] ; immediate
|
: ;touch [ ' touch-last , ' [ , ] ; immediate
|
||||||
|
|
||||||
: check-player-touch ( x y -- b )
|
: check-player-touch ( x y -- b )
|
||||||
|
@ -113,7 +111,7 @@ player :tick
|
||||||
|
|
||||||
( S T U F F )
|
( S T U F F )
|
||||||
: reset-level
|
: reset-level
|
||||||
:| player yield 0 |; ' entities redefine
|
:| player yield done |; ' entities redefine
|
||||||
:| drop drop 0 |; ' player-touch redefine ;
|
:| drop drop 0 |; ' player-touch redefine ;
|
||||||
|
|
||||||
: mode-move
|
: mode-move
|
||||||
|
|
|
@ -17,7 +17,7 @@ car :touch
|
||||||
:| player yield
|
:| player yield
|
||||||
chuck.state @ CHUCK-HOME = if e_chuck yield then
|
chuck.state @ CHUCK-HOME = if e_chuck yield then
|
||||||
player.driving? not if car yield then
|
player.driving? not if car yield then
|
||||||
0 |; ' entities redefine
|
done |; ' entities redefine
|
||||||
|
|
||||||
:|
|
:|
|
||||||
touch-begin S leaving? dup
|
touch-begin S leaving? dup
|
||||||
|
|
2
pete.jor
2
pete.jor
|
@ -10,7 +10,7 @@ car :touch
|
||||||
:noname
|
:noname
|
||||||
:| player yield
|
:| player yield
|
||||||
player.driving? not if car yield then
|
player.driving? not if car yield then
|
||||||
0 |; ' entities redefine
|
done |; ' entities redefine
|
||||||
|
|
||||||
:|
|
:|
|
||||||
touch-begin S leaving? dup
|
touch-begin S leaving? dup
|
||||||
|
|
|
@ -11,7 +11,7 @@ bed :touch pete say" I'm not tired yet." ;entity
|
||||||
|
|
||||||
:noname
|
:noname
|
||||||
reset-level
|
reset-level
|
||||||
:| player yield table yield chair yield bed yield 0 |; ' entities redefine
|
:| player yield table yield chair yield bed yield done |; ' entities redefine
|
||||||
:|
|
:|
|
||||||
touch-begin 16 10 2= dup if
|
touch-begin 16 10 2= dup if
|
||||||
player move-entity 12 8 pete.jor queue-level
|
player move-entity 12 8 pete.jor queue-level
|
||||||
|
|
2
road.jor
2
road.jor
|
@ -6,7 +6,7 @@
|
||||||
1 player.state DRIVING f!
|
1 player.state DRIVING f!
|
||||||
:| player yield
|
:| player yield
|
||||||
chuck.state @ CHUCK-HOME = if chuck yield then
|
chuck.state @ CHUCK-HOME = if chuck yield then
|
||||||
0 |; ' entities redefine
|
done |; ' entities redefine
|
||||||
:|
|
:|
|
||||||
touch-begin E leaving? dup
|
touch-begin E leaving? dup
|
||||||
if pete say" It's 100 miles to the next town." then
|
if pete say" It's 100 miles to the next town." then
|
||||||
|
|
|
@ -68,16 +68,16 @@ defer write
|
||||||
' noop
|
' noop
|
||||||
:noname 12 11 tile>world player entity.pos!
|
:noname 12 11 tile>world player entity.pos!
|
||||||
s" pete.jor" loadfile ;
|
s" pete.jor" loadfile ;
|
||||||
:noname :| player yield 0 |; ' entities redefine
|
:noname :| player yield done |; ' entities redefine
|
||||||
0 player.state DRIVING f!
|
0 player.state DRIVING f!
|
||||||
1 showmouse ! MODE-MOVE @ ' tick redefine
|
1 showmouse ! MODE-MOVE @ ' tick redefine
|
||||||
12 11 tile>world player entity.pos!
|
12 11 tile>world player entity.pos!
|
||||||
loadportraits ;
|
loadportraits ;
|
||||||
:noname s" hide-footer" REPL send ;
|
:noname s" hide-footer" REPL send ;
|
||||||
:noname s" show-footer" REPL send ;
|
:noname s" show-footer" REPL send ;
|
||||||
:noname :| player yield 0 |; ' entities redefine
|
:noname :| player yield done |; ' entities redefine
|
||||||
1 player.state DRIVING f! E player entity.dir ! ;
|
1 player.state DRIVING f! E player entity.dir ! ;
|
||||||
:noname :| 0 |; ' entities redefine 0 showmouse ! ;
|
:noname :| done |; ' entities redefine 0 showmouse ! ;
|
||||||
array demostates , , , , , , ,
|
array demostates , , , , , , ,
|
||||||
var demostate
|
var demostate
|
||||||
|
|
||||||
|
|
|
@ -13,7 +13,7 @@ car :touch
|
||||||
:| player yield
|
:| player yield
|
||||||
chuck.state @ CHUCK-SEARCH = if e_chuck yield then
|
chuck.state @ CHUCK-SEARCH = if e_chuck yield then
|
||||||
player.driving? not if car yield then
|
player.driving? not if car yield then
|
||||||
0 |; ' entities redefine
|
done |; ' entities redefine
|
||||||
|
|
||||||
:|
|
:|
|
||||||
touch-begin S leaving? dup
|
touch-begin S leaving? dup
|
||||||
|
|
Loading…
Reference in a new issue