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
|
||||
|
||||
: yield rswap ;
|
||||
: each [ ' begin , ] ' dup , [ ' while , ] ; immediate
|
||||
: more ' yield , [ ' repeat , ] ' drop , ] ; immediate
|
||||
: dobreak yield 0 ;
|
||||
: break ' rdrop , ' dobreak , ; immediate
|
||||
: done rdrop 0 r> rswap ;
|
||||
: ;done ' done , ] ; immediate
|
||||
: each [ ' begin , ] ' r@ , [ ' while , ] ; 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 ;
|
||||
|
||||
( 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 ;
|
||||
: 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 )
|
||||
|
||||
: touch-begin begin 2dup search >rot drop drop 1 - ;
|
||||
: touched? if 2 else 1 then ;
|
||||
: touched-more? if 2 else 0 then ;
|
||||
: touch-next ' touched-more? , ' yield , ; immediate
|
||||
: touch-last ' touched? , ' yield , ; immediate
|
||||
: touch-begin each 2dup more >rot drop drop ;
|
||||
: touch-next dup if rdrop done then drop rswap ;
|
||||
: touch-last ' done , ; immediate
|
||||
: ;touch [ ' touch-last , ' [ , ] ; immediate
|
||||
|
||||
: check-player-touch ( x y -- b )
|
||||
|
@ -113,7 +111,7 @@ player :tick
|
|||
|
||||
( S T U F F )
|
||||
: reset-level
|
||||
:| player yield 0 |; ' entities redefine
|
||||
:| player yield done |; ' entities redefine
|
||||
:| drop drop 0 |; ' player-touch redefine ;
|
||||
|
||||
: mode-move
|
||||
|
|
|
@ -17,7 +17,7 @@ car :touch
|
|||
:| player yield
|
||||
chuck.state @ CHUCK-HOME = if e_chuck yield then
|
||||
player.driving? not if car yield then
|
||||
0 |; ' entities redefine
|
||||
done |; ' entities redefine
|
||||
|
||||
:|
|
||||
touch-begin S leaving? dup
|
||||
|
|
2
pete.jor
2
pete.jor
|
@ -10,7 +10,7 @@ car :touch
|
|||
:noname
|
||||
:| player yield
|
||||
player.driving? not if car yield then
|
||||
0 |; ' entities redefine
|
||||
done |; ' entities redefine
|
||||
|
||||
:|
|
||||
touch-begin S leaving? dup
|
||||
|
|
|
@ -11,7 +11,7 @@ bed :touch pete say" I'm not tired yet." ;entity
|
|||
|
||||
:noname
|
||||
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
|
||||
player move-entity 12 8 pete.jor queue-level
|
||||
|
|
2
road.jor
2
road.jor
|
@ -6,7 +6,7 @@
|
|||
1 player.state DRIVING f!
|
||||
:| player yield
|
||||
chuck.state @ CHUCK-HOME = if chuck yield then
|
||||
0 |; ' entities redefine
|
||||
done |; ' entities redefine
|
||||
:|
|
||||
touch-begin E leaving? dup
|
||||
if pete say" It's 100 miles to the next town." then
|
||||
|
|
|
@ -68,16 +68,16 @@ defer write
|
|||
' noop
|
||||
:noname 12 11 tile>world player entity.pos!
|
||||
s" pete.jor" loadfile ;
|
||||
:noname :| player yield 0 |; ' entities redefine
|
||||
:noname :| player yield done |; ' entities redefine
|
||||
0 player.state DRIVING f!
|
||||
1 showmouse ! MODE-MOVE @ ' tick redefine
|
||||
12 11 tile>world player entity.pos!
|
||||
loadportraits ;
|
||||
:noname s" hide-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 ! ;
|
||||
:noname :| 0 |; ' entities redefine 0 showmouse ! ;
|
||||
:noname :| done |; ' entities redefine 0 showmouse ! ;
|
||||
array demostates , , , , , , ,
|
||||
var demostate
|
||||
|
||||
|
|
|
@ -13,7 +13,7 @@ car :touch
|
|||
:| player yield
|
||||
chuck.state @ CHUCK-SEARCH = if e_chuck yield then
|
||||
player.driving? not if car yield then
|
||||
0 |; ' entities redefine
|
||||
done |; ' entities redefine
|
||||
|
||||
:|
|
||||
touch-begin S leaving? dup
|
||||
|
|
Loading…
Reference in a new issue