rename r> and r< to >r and <r to make more mnemonic sense
This commit is contained in:
parent
aa8cd6f770
commit
3da93a2eb0
8
boot.jor
8
boot.jor
|
@ -50,7 +50,7 @@ key " const '"'
|
|||
then ;
|
||||
: interpreter
|
||||
begin word dup b@ while compileword repeat drop ;
|
||||
: load-input swap-input r> r> interpreter r< r< swap-input ;
|
||||
: load-input swap-input >r >r interpreter <r <r swap-input ;
|
||||
: loadstring ' key-string load-input drop drop ;
|
||||
|
||||
( image loading )
|
||||
|
@ -87,7 +87,7 @@ defer onload
|
|||
: interpretjor ( filename -- )
|
||||
open fdeactivate ' key-file load-input drop factivate close ;
|
||||
|
||||
: preservefp ( xt -- ) fdeactivate r> execute r< factivate ;
|
||||
: preservefp ( xt -- ) fdeactivate >r execute <r factivate ;
|
||||
|
||||
: loadjor :| interpretjor postload |; preservefp ;
|
||||
|
||||
|
@ -95,6 +95,6 @@ defer onload
|
|||
( active file is preserved for the currently-loading file, but the
|
||||
new file is always loaded with no active files )
|
||||
:| dup loadimage-if-uptodate not if
|
||||
here over r> r> interpretjor
|
||||
r< r< imagefilename overwrite saveimage close postload
|
||||
here over >r >r interpretjor
|
||||
<r <r imagefilename overwrite saveimage close postload
|
||||
else drop then |; preservefp ;
|
||||
|
|
24
defs.jor
24
defs.jor
|
@ -2,23 +2,23 @@
|
|||
|
||||
: >rot <rot <rot ;
|
||||
: 2dup over over ;
|
||||
: 3dup r> 2dup r@ >rot r< ;
|
||||
: 4dup r> r> 2dup r@ >rot rswap r@ >rot r< r< swap ;
|
||||
: 3dup >r 2dup r@ >rot <r ;
|
||||
: 4dup >r >r 2dup r@ >rot rswap r@ >rot <r <r swap ;
|
||||
: nip swap drop ;
|
||||
|
||||
: 2= ( a b c d -- a=c&b=d )
|
||||
r> <rot = swap r< = and ;
|
||||
>r <rot = swap <r = and ;
|
||||
|
||||
: 2swap ( a b c d -- c d a b )
|
||||
r> >rot r< >rot ;
|
||||
>r >rot <r >rot ;
|
||||
|
||||
: negate 0 swap - ;
|
||||
: abs dup 0 < if negate then ;
|
||||
|
||||
: ~ -1 ^ ;
|
||||
: f! ( b v flag -- )
|
||||
>rot r> r@ @ >rot ( val flag b r: v )
|
||||
if | else ~ & then r< ! ;
|
||||
>rot >r r@ @ >rot ( val flag b r: v )
|
||||
if | else ~ & then <r ! ;
|
||||
: f@ ( v flag -- ) swap @ & ;
|
||||
: fnot! ( v flag -- ) over @ ^ swap ! ;
|
||||
|
||||
|
@ -41,16 +41,16 @@
|
|||
over > if 1 + else 1 - then ;
|
||||
|
||||
: for ( from to -- )
|
||||
' r> , [ ' begin , ] ( from r: to )
|
||||
' >r , [ ' begin , ] ( from r: to )
|
||||
' dup , ' r@ , ' != , [ ' while , ]
|
||||
' r> , ; immediate ( r: to from )
|
||||
' >r , ; immediate ( r: to from )
|
||||
: i ' r@ , ; immediate
|
||||
: next
|
||||
' r< , ' r@ , ' +towards , ( from+1 r: to )
|
||||
' <r , ' r@ , ' +towards , ( from+1 r: to )
|
||||
[ ' repeat , ] ' drop , ' rdrop , ; immediate
|
||||
|
||||
: yield rswap ;
|
||||
: done rdrop 0 r> rswap ;
|
||||
: done rdrop 0 >r rswap ;
|
||||
: ;done ' done , ] ; immediate
|
||||
: each [ ' begin , ] ' r@ , [ ' while , ] ; immediate
|
||||
: more ' yield , [ ' repeat , ] ' rdrop , ; immediate
|
||||
|
@ -76,9 +76,9 @@
|
|||
: intern create latest wordname , does> @ ;
|
||||
|
||||
: preserving ( cp 0 vars... -- )
|
||||
0 r> begin dup while dup @ r> r> repeat drop
|
||||
0 >r begin dup while dup @ >r >r repeat drop
|
||||
execute
|
||||
begin r@ while r< r< swap ! repeat rdrop ;
|
||||
begin r@ while <r <r swap ! repeat rdrop ;
|
||||
: preserve ( cp var -- ) 0 swap preserves ;
|
||||
|
||||
|
||||
|
|
16
game.jor
16
game.jor
|
@ -19,9 +19,9 @@ defer entities
|
|||
|
||||
: entity-at ( x y -- entity|0 )
|
||||
0 >rot
|
||||
entities each r> 2dup ( 0 x y x y r:e )
|
||||
entities each >r 2dup ( 0 x y x y r:e )
|
||||
r@ entity.x @ r@ entity.y @ world>tile 2= ( 0 x y eq r:e )
|
||||
if <rot drop r< >rot break ( e x y )
|
||||
if <rot drop <r >rot break ( e x y )
|
||||
else rdrop then ( 0 x y )
|
||||
more drop drop ;
|
||||
|
||||
|
@ -49,8 +49,8 @@ defer player
|
|||
12 9 N ' {player} defentity player
|
||||
|
||||
: entity-dst ( e -- x y )
|
||||
r> r@ entity.dir @ dir>pos
|
||||
r@ entity.x @ r< entity.y @ world>tile +pos ;
|
||||
>r r@ entity.dir @ dir>pos
|
||||
r@ entity.x @ <r entity.y @ world>tile +pos ;
|
||||
|
||||
: move-entity ( e -- )
|
||||
dup entity.dir @ dir>pos ( e dx dy )
|
||||
|
@ -63,9 +63,9 @@ defer player
|
|||
player move-entity
|
||||
player.prevdir @ party each
|
||||
dup player != if
|
||||
dup entity.dir @ r>
|
||||
dup entity.dir @ >r
|
||||
dup >rot entity.dir !
|
||||
move-entity r<
|
||||
move-entity <r
|
||||
else entity.dir @ player.prevdir ! then more drop
|
||||
0 player.state MOVING f! ;
|
||||
|
||||
|
@ -138,8 +138,8 @@ player :tick
|
|||
' tick-debounce MODE-WAIT !
|
||||
|
||||
: draw-entity
|
||||
r> r@ entity.x @ r@ entity.y @
|
||||
r@ entity.dir @ r< entity>sprite
|
||||
>r r@ entity.x @ r@ entity.y @
|
||||
r@ entity.dir @ <r entity>sprite
|
||||
draw-sprite ;
|
||||
|
||||
var showmouse
|
||||
|
|
21
jopl.jor
21
jopl.jor
|
@ -1,7 +1,7 @@
|
|||
' putc task-emit !
|
||||
s" jopl.log" open seekend fdeactivate const LOGFILE
|
||||
: emit-log fdeactivate LOGFILE factivate fputc fdeactivate drop factivate ;
|
||||
: quit LOGFILE factivate close s" C:\src\game" chdir _quit ;
|
||||
: quit LOGFILE factivate close _quit ;
|
||||
|
||||
: DBG :| ' seremit task-emit ! execute cr |; 0 task-emit preserving ;
|
||||
: DTYPE ' type DBG ;
|
||||
|
@ -45,7 +45,7 @@ var op
|
|||
ar-flags adlib! ;
|
||||
|
||||
: readop ( v -- )
|
||||
r> r@ 4 + b@ r@ 3 + b@ r@ 2 + b@ r@ 1 + b@ r< b@ loadop ;
|
||||
>r r@ 4 + b@ r@ 3 + b@ r@ 2 + b@ r@ 1 + b@ <r b@ loadop ;
|
||||
|
||||
: instrument ( alg f1 l1 ad1 sr1 w1 f2 l2 ad2 sr2 w2 -- )
|
||||
create b, b, b, b, b, b, b, b, b, b, b, does>
|
||||
|
@ -129,7 +129,7 @@ array tracks 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,
|
|||
|
||||
: track ( i -- p ) cells tracks + ;
|
||||
: dotrack ( ip -- ip )
|
||||
dup if dup 1 + swap ub@ r>
|
||||
dup if dup 1 + swap ub@ >r
|
||||
r@ 0xff = if dup @ swap cell + swap execute then
|
||||
r@ 0xfe = if @ dotrack then
|
||||
r@ 0xfd = if noteoff then
|
||||
|
@ -265,13 +265,13 @@ var stopkeys
|
|||
77 key-pressed if 1 +voice! then ;
|
||||
|
||||
: dokeys ( cp -- )
|
||||
r> 0 stopkeys ! key-start begin
|
||||
>r 0 stopkeys ! key-start begin
|
||||
key-debounce r@ execute suspend
|
||||
stopkeys @ until key-end rdrop ;
|
||||
|
||||
: nextnote ( ip -- ip )
|
||||
dup if
|
||||
dup ub@ r>
|
||||
dup ub@ >r
|
||||
r@ 0xff = if drop 0 else
|
||||
r@ 0xfe = if 1 + @ nextnote then then
|
||||
rdrop
|
||||
|
@ -328,13 +328,17 @@ defer onselect
|
|||
|
||||
: change-selection ( dy -- )
|
||||
deselect-menu menuy +!pos select-menu onselect ;
|
||||
|
||||
: page-selection ( redraw dy -- 1 )
|
||||
dup menuscroll +!pos menuy +!pos drop 1 ;
|
||||
|
||||
: key-menu ( -- redraw )
|
||||
:|
|
||||
0 ( redraw )
|
||||
72 key-pressed if -1 change-selection then
|
||||
80 key-pressed if 1 change-selection then
|
||||
73 key-pressed if drop 1 r> -10 menuscroll +!pos then
|
||||
81 key-pressed if drop 1 r> 10 menuscroll +!pos then
|
||||
73 key-pressed if -10 page-selection then
|
||||
81 key-pressed if 10 page-selection then
|
||||
|; draw-menu ;
|
||||
|
||||
: draw-filemenu ( glob -- )
|
||||
|
@ -352,9 +356,10 @@ defer onselect
|
|||
|; dokeys
|
||||
|; 66 1 13 menu-at ;
|
||||
|
||||
: dune ( -- ) s" dune" chdir inst s" .." chdir ;
|
||||
|
||||
:noname
|
||||
9 -1 for i voice ! default next
|
||||
startt2
|
||||
' emit-direct task-emit !
|
||||
s" dune" chdir
|
||||
; ' onload redefine
|
||||
|
|
4
jorth.c
4
jorth.c
|
@ -1143,8 +1143,8 @@ void f_init(char *exe) {
|
|||
CDEF("drop", f_drop);
|
||||
CDEF("swap", f_swap);
|
||||
CDEF("<rot", f_rot);
|
||||
CDEF("r>", f_rput);
|
||||
CDEF("r<", f_rtake);
|
||||
CDEF(">r", f_rput);
|
||||
CDEF("<r", f_rtake);
|
||||
CDEF("r@", f_rtop);
|
||||
CDEF("rdrop", f_rdrop);
|
||||
CDEF("rswap", f_rswap);
|
||||
|
|
12
map.jor
12
map.jor
|
@ -54,15 +54,15 @@ here tileflags - 1 - const MAXTILE
|
|||
swap . . cr then ;
|
||||
|
||||
: copy-mapseg ( neww oldw y -- )
|
||||
r> ( oldw neww r: y )
|
||||
>r ( oldw neww r: y )
|
||||
2dup min >rot ( copyw neww oldw )
|
||||
r@ * map + ( copyw neww src )
|
||||
swap r< * map + ( copyw src dst )
|
||||
swap <r * map + ( copyw src dst )
|
||||
swap <rot memmove ;
|
||||
|
||||
: resize-map ( neww newh -- )
|
||||
swap mapsize r> ( newh neww oldw r: oldh )
|
||||
2dup < if 1 r< else r< 1 - 0 then ( newh neww copyw ystart ylim )
|
||||
swap mapsize >r ( newh neww oldw r: oldh )
|
||||
2dup < if 1 <r else <r 1 - 0 then ( newh neww copyw ystart ylim )
|
||||
for 2dup i copy-mapseg next
|
||||
drop swap mapsize! ;
|
||||
|
||||
|
@ -72,14 +72,14 @@ here tileflags - 1 - const MAXTILE
|
|||
: offset-map ( p d -- p ) dup 0 < if drop else + then ;
|
||||
|
||||
: shift-map ( dx dy -- )
|
||||
maph over abs - r> ( dx dy r: h )
|
||||
maph over abs - >r ( dx dy r: h )
|
||||
swap mapw over abs - >rot ( w dy dx r: h )
|
||||
2dup map swap offset-map
|
||||
swap mapw * offset-map >rot ( w end dy dx r: h )
|
||||
map swap negate offset-map
|
||||
swap mapw * negate offset-map ( w end start r: h )
|
||||
2dup > if r@ mapw * + swap r@ mapw * + swap then
|
||||
r< 0 for
|
||||
<r 0 for
|
||||
3dup <rot memmove
|
||||
2dup < if mapw + swap mapw + swap
|
||||
else mapw - swap mapw - swap then
|
||||
|
|
10
timer.jor
10
timer.jor
|
@ -8,16 +8,16 @@
|
|||
: <ratio ( range ratio -- v ) *<ratio ;
|
||||
: >range ( start end -- start range ) over - ;
|
||||
: <range ( start range -- start end ) over + ;
|
||||
: lerpr ( start end ratio ) r> >range r< <ratio + ;
|
||||
: lerpr ( start end ratio ) >r >range <r <ratio + ;
|
||||
: lerpn ( start1 end1 start2 end2 val )
|
||||
r> >range r< <rot - >ratio lerpr ;
|
||||
>r >range <r <rot - >ratio lerpr ;
|
||||
: lerp ( start end duration start -- i )
|
||||
ticks udelta ( start end duration delta )
|
||||
>ratio lerpr ;
|
||||
|
||||
: triggered ( duration timer -- b )
|
||||
dup r> @ ticks udelta ( duration delta )
|
||||
2dup <= if drop r< +! 1 else drop drop rdrop 0 then ;
|
||||
dup >r @ ticks udelta ( duration delta )
|
||||
2dup <= if drop <r +! 1 else drop drop rdrop 0 then ;
|
||||
|
||||
: now! ( timer -- ) ticks swap ! ;
|
||||
: advance! ( timer -- delta )
|
||||
|
@ -25,7 +25,7 @@
|
|||
dup <rot +! ;
|
||||
|
||||
: move-to ( target speed p -- )
|
||||
dup r> @ >rot ticks ( from to duration start )
|
||||
dup >r @ >rot ticks ( from to duration start )
|
||||
begin
|
||||
4dup lerp r@ !
|
||||
<rot dup r@ @ != ( from duration start to !done )
|
||||
|
|
Loading…
Reference in a new issue