rename r> and r< to >r and <r to make more mnemonic sense

This commit is contained in:
Jeremy Penner 2019-05-16 21:05:40 -04:00
parent aa8cd6f770
commit 3da93a2eb0
11 changed files with 50 additions and 45 deletions

View file

@ -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 ;

View file

@ -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 ;

BIN
game.exe

Binary file not shown.

View file

@ -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

BIN
game.prj

Binary file not shown.

BIN
jopl.exe

Binary file not shown.

View file

@ -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

BIN
jopl.prj

Binary file not shown.

View file

@ -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
View file

@ -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

View file

@ -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 )