2019-07-20 02:29:32 +00:00
|
|
|
: blah ' seremit task-emit ! ;
|
|
|
|
|
blah
|
|
|
|
|
|
|
|
|
|
s" game.log" open seekend fdeactivate const LOGFILE
|
|
|
|
|
: emit-log ' fputc LOGFILE withfp ;
|
|
|
|
|
: atexit LOGFILE factivate close ;
|
|
|
|
|
|
|
|
|
|
: start-repl activate blah ' emit-log task-echo !
|
|
|
|
|
s" .:: J O R T H ( jean forth) ::." type cr
|
|
|
|
|
begin receive loadstring s" ok" type cr again ;
|
|
|
|
|
task const REPL
|
|
|
|
|
REPL start-repl
|
|
|
|
|
|
|
|
|
|
intern input.jor
|
|
|
|
|
input.jor loadfile
|
|
|
|
|
|
2019-07-24 02:39:56 +00:00
|
|
|
var color
|
|
|
|
|
var spriteindex
|
|
|
|
|
|
2019-07-27 01:37:47 +00:00
|
|
|
var refresh-needed
|
|
|
|
|
: refresh 1 refresh-needed ! ;
|
2019-07-24 02:39:56 +00:00
|
|
|
|
2019-07-27 01:37:47 +00:00
|
|
|
: color! dup color @ = if drop else color ! refresh then ;
|
|
|
|
|
: +sprite! spriteindex spritecount +!cycle refresh ;
|
2019-07-24 02:39:56 +00:00
|
|
|
|
2019-07-27 01:37:47 +00:00
|
|
|
: draw-palette 0 0x11 for i 79 i 3 << drawfatbox next ;
|
2019-07-24 02:39:56 +00:00
|
|
|
|
|
|
|
|
: mousepos>sprpos 3 >> swap 3 >> swap ;
|
2019-07-26 02:32:31 +00:00
|
|
|
: mousexys mousepos mousepos>sprpos spriteindex @ ;
|
2019-07-20 02:29:32 +00:00
|
|
|
: tick
|
2019-07-27 01:37:47 +00:00
|
|
|
mousepos 128 < swap 128 < and if
|
|
|
|
|
MOUSEL mousedown if
|
|
|
|
|
mousexys getpixel color @ != if
|
|
|
|
|
color @ mousexys putpixel
|
|
|
|
|
refresh
|
|
|
|
|
then
|
|
|
|
|
then
|
|
|
|
|
MOUSER clicked if
|
|
|
|
|
mousexys getpixel color!
|
2019-07-26 02:32:31 +00:00
|
|
|
then
|
|
|
|
|
then
|
2019-07-27 01:37:47 +00:00
|
|
|
mousepos 136 < swap 312 >= and if
|
|
|
|
|
mousepos swap drop 3 >>
|
|
|
|
|
MOUSEL mousedown if color! else drop then
|
2019-07-20 02:29:32 +00:00
|
|
|
then
|
2019-07-27 01:37:47 +00:00
|
|
|
^LEFT key-pressed if -1 +sprite! then
|
|
|
|
|
^RIGHT key-pressed if 1 +sprite! then
|
2019-07-20 02:29:32 +00:00
|
|
|
tick-debounce
|
2019-07-27 01:37:47 +00:00
|
|
|
;
|
|
|
|
|
|
|
|
|
|
: draw
|
|
|
|
|
refresh-needed @ if
|
|
|
|
|
mousehide
|
|
|
|
|
spriteindex @ drawfatsprite
|
|
|
|
|
color @ 78 0 drawfatbox
|
|
|
|
|
draw-palette
|
|
|
|
|
mouseshow
|
|
|
|
|
0 refresh-needed !
|
|
|
|
|
then ;
|
2019-07-24 02:39:56 +00:00
|
|
|
|
|
|
|
|
mouseshow
|
|
|
|
|
refresh
|
