implement keypad, speed up portrait draw, move tick/draw to task so they can be debugged

debug.jor

@@ -12,7 +12,7 @@ defer dbg-cmd
   dup $DOCOLON = if drop else
   dup $DOCREATE = if drop @ else
   $DODEFERRED = if @ dbg-first-ip else
-  drop 0 then then then ;
+  drop 0 then then then ; userword
 
 : tail :| rdrop dbg-first-ip >r |; , [ ' [ , ] ; immediate
 
@@ -84,11 +84,14 @@ array breakpoints bp, bp, bp, bp, bp,
 
 : set-next-breakpoint ( ip -- )
   free-breakpoint >r r@ breakpoint# reset-breakpoint
-  <r s" bp " type . s" set" type cr ;
+  <r s" bp " type . s" set" type cr ; userword
 
 : b word lookup drop dbg-first-ip dup if set-next-breakpoint
   else s" word not found" type cr drop then ; userword
 : unb breakpoint# clear-breakpoint ; userword
+: break-after cells dbg-ip @ + set-next-breakpoint ; userword
+: bh 0 break-after ; userword
+ 
 : .bp 0 MAX-BREAKPOINTS for
     i .
     i breakpoint# bp.ip @ dup .

footer.jor

@@ -67,8 +67,12 @@ var texttimer
 : show-footer 48 10 footer-y move-to ;
 : hide-footer 0 10 footer-y move-to ;
 
-: footer-wait show-footer ^ENTER wait-key ;
+: do-footer-wait show-footer ^ENTER wait-key ;
+defer footer-wait
+: dont-footer-wait ' do-footer-wait ' footer-wait redefine ;
+dont-footer-wait
 
+: runon ' dont-footer-wait ' footer-wait redefine ; userword
 : say ( s -- ) textleftsay clear show-footer slowtext footer-wait ; userword
 : say" [ ' s" , ] ' say expile ; immediate
 
@@ -111,6 +115,7 @@ var cchoose
 1 YELLOW character rexx userword
 3 LBLUE character jaye userword
 5 CYAN character gord userword
+6 LMAGENTA character pady userword
 
 : noone WHITE text-color ! s"     " dup dup dup
   8 portraity 16 portraity 24 portraity 32 portraity ; userword

game.jor

@@ -292,6 +292,8 @@ does>
 
 : create-object blankentity dup link-object ;
 : create-linked-object blankentity swap , dup link-object ;
+: create-extra-linked-object blankentity swap , swap ,
+  dup link-object ;
 : create-timed-object blankentity swap , swap , 0 ,
   dup link-object obj-ticking! ;
 

gameboot.jor

@@ -19,6 +19,8 @@ defer tick
 defer draw
 defer loadlevel
 
+task :noname activate blah begin tick suspend again ; execute
+
 :noname
 s" input.jor" loadfile
 s" timer.jor" loadfile
@@ -33,6 +35,8 @@ s" game.jor" loadfile
 s" debug.jor" loadfile
 ; execute
 
+task :noname activate blah begin draw suspend again ; execute
+
 ' load-new-level checkpoint _loadlevel
 ' _loadlevel ' loadlevel redefine
 

jiles.jor

@@ -3,7 +3,9 @@ var rcolor 0x10 rcolor !
 var spriteindex
 
 var refresh-needed
+var spritedirty
 : refresh 1 refresh-needed ! ;
+: refresh-xy spritedirty 1 + b! spritedirty b! 2 refresh-needed ! ;
 
 array preview 128 allot
 
@@ -30,7 +32,8 @@ array preview 128 allot
 
 : mousepixel! ( color -- )
   >r mousexys getpixel r@ != if
-    r@ mousexys putpixel refresh
+    r@ mousexys putpixel
+    mousepos mousepos>sprpos refresh-xy
   then rdrop ;
 
 : gfxfilename
@@ -96,7 +99,11 @@ var copysrc
   refresh-needed @ if
     mousehide
     draw-preview
-    spriteindex @ drawfatsprite
+    refresh-needed @ 2 = if
+      spritedirty b@ spritedirty 1 + b@ spriteindex @ drawfatspritepixel
+    else
+      spriteindex @ drawfatsprite
+    then
     lcolor @ 77 0 drawfatbox
     rcolor @ 78 0 drawfatbox
     draw-palette

jorth.h

@@ -1,6 +1,7 @@
+
 #include <stdio.h>
 
-#define MEM_SIZE 24576
+#define MEM_SIZE 28762
 #define STACK_SIZE 64
 #define RSTACK_SIZE 64
 

lev00005.jor

@@ -11,7 +11,7 @@ lazy 60 over 19 9 timedswitch ts
 10 9 door d2
 5 6 door d3 >lazy!
 10 2 door d4
-LEV_END 5 12 exitdoor dx
+6 5 12 exitdoor dx
 
 lazy dup 11 3 computer c1
 ' c1 7 11 computer c2 >lazy!

lev00006.jor

@@ -1,8 +1,66 @@
 ( L E V E L 0 0 0 0 6 )
 
-:noname
+objects: O
+
+2 const ^1
+30 const code-y
+20 const code-x
+
+: wait-for-digit ( -- n )
+  0 begin suspend ^1 dup 11 + for i key-pressed if drop i then next dup until
+  ^1 - 1 + dup 10 = if drop 0 then ;
+: draw-digit ( x n -- ) code-y swap 48 + text-color @ textc ;
+: code-digit ( code x -- code )
+  wait-for-digit swap code-x + over draw-digit swap 10 * + ;
+
+: read-code ( -- n )
+  WHITE text-color !
+  s" ####" code-x code-y textxy
+  0 0 code-digit
+    1 code-digit
+    2 code-digit
+    3 code-digit ;
+
+var pady-introduced
+: keypad-code responder entity.user cell + @ ;
+: keypad create-extra-linked-object
+  :| dup EVTOUCH = if
+       pady-introduced @ not if
+	 pady say" Hello, stranger! I'm Pady,\the friendly keypad lock!"
+	 jaye say" I need to get through this\door, Pady."
+	 pady say" You didn't say the magic\word, stranger!"
+	 1 pady-introduced !
+       then
+       isneut? if move-player then
+       PAD-OFF responder>tile? if
+	 runon pady say" Enter your 4-digit door code!\And have a super day!"
+	 read-code keypad-code = if
+	   pady say" That's right! Hooray!\You get a gold star!"
+	   drop EVACT
+	 else
+	   pady say" Ohhh, sorry! That's not it.\Better luck next time!"
+	 then
+       else
+	 pady say" Oh hi again! I missed you too!"
+       then
+     then
+     dup PAD-ON PAD-OFF handle-onoff
+     PAD-ON handle-link |; listener! ;
+
+3 1 door d1
+17 1 door d2
+4 11 door d3
+10 9 door d4
+
+1234 ' d1 3 2 keypad k1
+-1 ' d2 17 2 keypad k2 ( must be hacked )
+3456 ' d3 4 10 keypad k3
+
+LEV_END 13 12 exitdoor dx
+' dx 14 12 scanner sx
+
+:noname O
   5 1 tile>world Jaye entity.pos!
   4 0 tile>world Neut entity.pos!
   with-gord
-
 ; ' onload redefine

map.jor

@@ -34,7 +34,8 @@ array tileflags
 ( 21:scanner-on )      NEUTABLE b,
 ( 22:cracked-wall )    0 b,
 ( 23:rexx-pod )        NEUTABLE b,
-( 24:keypad )          NEUTABLE b,
+( 24:keypad-off )      NEUTABLE b,
+( 25:keypad-on )       NEUTABLE b,
 
 here tileflags - 1 - const MAXTILE
 
@@ -49,6 +50,8 @@ here tileflags - 1 - const MAXTILE
 20 const SCAN-OFF
 21 const SCAN-ON
 23 const REXX-POD
+24 const PAD-OFF
+25 const PAD-ON
 
 : mapflag? ( x y flag -- b ) >rot tile b@ tileflags + b@ & ;
 

testbed.c

@@ -449,6 +449,29 @@ void f_drawfatsprite() {
   }
 }
 
+void f_drawfatspritepixel() {
+  int x = ST2().i;
+  int y = ST1().i;
+  unsigned int far *spr = getTarget(TOP().i);
+  DROP(3);
+
+  if (editTarget != ET_PORTRAIT) {
+    int color = getsprpixel(x, y, spr);
+
+    setAllPlanes();
+    drawFatBox(x, y << 3, color);
+  } else {
+    int colorl, colorr;
+
+    x = x & 0xfffe;
+    colorl = getsprpixel(    x, y, spr);
+    colorr = getsprpixel(x + 1, y, spr);
+
+    drawDoubleFatBox(x >> 1, y << 2, colorl, colorr);
+    setAllPlanes();
+  }
+}
+
 void f_drawfatbox() {
   drawFatBox(ST1().i, TOP().i, ST2().i);
   DROP(3);
@@ -690,6 +713,7 @@ void game_f_init(char *exe, char *bootjor) {
   CDEF("mouseshow", f_mouseshow);
   CDEF("mousehide", f_mousehide);
   CDEF("drawfatsprite", f_drawfatsprite);
+  CDEF("drawfatspritepixel", f_drawfatspritepixel);
   CDEF("drawfatbox", f_drawfatbox);
   CDEF("putpixel", f_putpixel);
   CDEF("getpixel", f_getpixel);
@@ -748,7 +772,6 @@ void do_repl(char *exe) {
 }
 
 int main(int argc, char *argv[]) {
-  cell tick, draw;
   char *bootjor = "gameboot.jor";
 
   if (argc > 1) {
@@ -758,15 +781,11 @@ int main(int argc, char *argv[]) {
   ser_init(SER_COM2, BAUD_19200, SER_8N1);
   game_init();
   game_f_init(argv[0], bootjor);
-  tick = f_lookupcp("tick");
-  draw = f_lookupcp("draw");
 
   while (!keyIsDown(K_ESC)) {
     kbd_debounce();
     f_poll();
-    f_execcp(tick);
     f_taskloop();
-    f_execcp(draw);
   }
 
   return 0;