invert { and }, more immediate word helpers, box-drawing

game.jrt

@@ -1,13 +1,15 @@
 import text.jrt
 
-:noname
+:noname textmode
 30 textx! 12 texty! blue bg! lgray fg!
 [ key  lit ] fill-page
 s" Hello, inline assembler!" draw-text nextline
 s" What a lovely day" draw-text
 lblue bg! white fg!
-s"  it is!" draw-text 
+s"  it is!" draw-text ;
-; execute
+
-terminate
+' main redefine
+
+{ s" testgame.com" writecom }
 
 

logic.jrt

@@ -129,6 +129,18 @@ dbg" bitwise"
   PUSH AX
   NEXT
 
+:ASM 2*
+  POP AX
+  SHL AX 1 #
+  PUSH AX
+  NEXT
+
+:ASM 2/
+  POP AX
+  SHR AX 1 #
+  PUSH AX
+  NEXT
+
 dbg" mem"
 :ASM @
   POP BX

text.jrt

@@ -45,10 +45,10 @@
 
 0xb800 const TEXTMEM
 
-} : PREP-TEXTCOPY
+{ : PREP-TEXTCOPY
   MOV ES t& TEXTMEM @+
   MOV AH textpen @+
-  MOV DI textpage @+ ; {
+  MOV DI textpage @+ ; }
 
 :asm fill-page ( char -- )
   INT 3 #
@@ -59,15 +59,20 @@
   NEXT
 
 0 var, textpos
-: textx textpos @ 1 >> pagew % ;
+: textx textpos @ 2/ pagew % ;
-: texty textpos @ 1 >> pagew / ;
+: texty textpos @ 2/ pagew / ;
-: textx! 1 << texty pagew 1 << * + textpos ! ;
+: textx! texty pagew * + 2* textpos ! ;
-: texty! pagew 1 << * textx 1 << + textpos ! ;
+: texty! pagew * textx + 2* textpos ! ;
-: nextline texty 1+ pagew 1 << * textpos ! ;
+: textxy! pagew * + 2* textpos ! ;
+: nextline texty 1+ pagew * 2* textpos ! ;
 
-} : PREP-TEXTCOPY-XY
+{ : PREP-TEXTCOPY-XY
     PREP-TEXTCOPY
-    ADD DI textpos @+ ; {
+    ADD DI textpos @+ ; 
+
+  : CORRECT-TEXTPOS
+    SUB DI textpage @+
+    MOV textpos @+ DI ; }
 
 :asm draw-text ( s -- )
   MOV BX SI
@@ -80,8 +85,86 @@
   STOSW
   JMP 0 <@
 0 <:
-  SUB DI textpage @+
+  CORRECT-TEXTPOS
-  MOV textpos @+ DI
   MOV SI BX
   NEXT
 
+:asm draw-char ( char -- )
+  POP AX
+  PREP-TEXTCOPY-XY
+  STOSW
+  ADD textpos @+ 2 #
+  NEXT
+
+:asm draw-hrepeat ( count char -- )
+  POP AX
+  POP CX
+  JCXZ 1 @>
+  PREP-TEXTCOPY-XY
+  SHL CX 1 #
+  ADD textpos @+ CX
+  SHR CX 1 #
+  REPZ STOSW
+1 <:
+  NEXT
+
+:asm draw-vrepeat ( count char -- )
+  POP AX
+  POP CX
+  JCXZ 1 @>
+  PREP-TEXTCOPY-XY
+0 :>  
+  STOSW
+  ADD DI pagew 1- 1 << #
+  DEC CX
+  JNZ 0 <@
+  CORRECT-TEXTPOS
+1 <:
+  NEXT
+
+( box drawing words )
+var boxstyle
+: hstyle boxstyle @ 0x01 & ;
+: hstyle! 1 & boxstyle @ 0xfe & | boxstyle ! ;
+: vstyle boxstyle @ 0x02 & 1 >> ;
+: vstyle! 1 & 1 << boxstyle @ 0xfd & | boxstyle ! ;
+: boxstyle! dup hstyle! vstyle! ;
+: filled? boxstyle @ 0x04 & ;
+: filled boxstyle @ 0x04 | boxstyle ! ;
+: hollow boxstyle @ 0xfb & boxstyle ! ;
+
+: hchar hstyle if 0xcd else 0xc4 then ;
+: vchar vstyle if 0xba else 0xb3 then ;
+: hline ( count -- ) hchar draw-char ;
+: vline ( count -- ) vchar draw-char ;
+
+dictionary .hex
+{ : :corner CREATE >t >t >t >t DOES} boxstyle @ 0x03 & + b@ draw-char ;
+dictionary .hex
+0xda 0xd6 0xd5 0xc9 :corner tl
+dictionary .hex
+0xbf 0xb7 0xb8 0xbb :corner tr
+0xc0 0xd4 0xd3 0xc8 :corner bl
+0xd9 0xbe 0xbd 0xbc :corner br
+
+: boxtop ( w -- ) textx swap tl 2 - hline tr nextline textx! ;
+: boxbottom ( w -- ) bl 2 - hline br ;
+
+: hollow-boxmiddle ( h w -- )
+  textpos @ >r
+  textx + textx! dup vline
+  <r textpos ! vline ;
+: filled-boxmiddle ( h w -- ) 
+  textx >r
+  2 - swap 
+  begin dup while 1-
+    vchar draw-char over 2 - 32 swap draw-hrepeat vchar draw-char
+    nextline r@ textx!
+  repeat 2drop rdrop ;
+: boxmiddle filled? if filled-boxmiddle else hollow-boxmiddle then ;
+
+: draw-box ( w h -- )
+  swap dup boxtop ( h w )
+  swap over boxmiddle
+  boxbottom ;
+

tinyjort.jrt

@@ -98,7 +98,7 @@ DEFERRED dictionary primary-dict
 :t segalloc lastseg @ 4096 + dup lastseg ! ;
 
 2 CONST cell
-:t cells cell * ;
+:t cells 2* ;
 :t allot [ target ] dup BZ_ [ patchpt ] 1-
    0 here b! here 1+ here!
    GOTO_ [ swap w>t patch!t ] drop ;

zipoff.jrt

@@ -45,12 +45,15 @@ asm-com
 : t, tlookup state if lit ' w>t , else w>t then ; immediate
 : '>t tlookup w>t ;
 
-: tdict| ' tdict ' dictionary redefine ;
+: with-dict ( cp dictcp ) 
-: |tdict ' primary-dict ' dictionary redefine ;
+  ' dictionary definition >r
+  ' dictionary redefine
+  execute
+  <r ' dictionary redefine ;
 
-: DEF asm-com ' dictionary definition ( preserve the current dictionary )
+: DEF asm-com 
-  tdict| new-word latest wordname lastlabel ! |tdict $DOFAR , target , 
+  :| new-word latest wordname lastlabel ! |; ' tdict with-dict
-  ' dictionary redefine ;
+  $DOFAR , target , ;
 : :asm asm-here new-word here cell + , ;
 
 s" coredefs.jrt" loadfile
@@ -65,25 +68,22 @@ s" coredefs.jrt" loadfile
   tdict dict-lookup dup state or if return then
   drop primary-dict dict-lookup ;
 
-: { tdict| asm-com
+: { ' primary-dict ' dictionary redefine
-  ' targ-pri-lookup ' lookup redefine
-  :| cell + @ w>t |; ' compileword redefine
-  :| t, LIT_ w>t |; ' compilenum redefine ;
-
-: } |tdict asm-here
   ' pri-targ-lookup ' lookup redefine
   ' , ' compileword redefine
   ' lit ' compilenum redefine ;
 
-: >{ dictionary tdict = { ;
+: } asm-com
-: }< if { else } then ;
+  ' tdict ' dictionary redefine
+  ' targ-pri-lookup ' lookup redefine
+  :| cell + @ w>t |; ' compileword redefine
+  :| t, LIT_ w>t |; ' compilenum redefine ;
 
 ( we mark all target words with no associated code in the target segment
   as immediate, as it is impossible to compile a reference to them. )
-: :timm >{ new-word immediate } $DOCOLON , ] }< ;
+: :timm } new-word immediate { $DOCOLON , ] ;
-:timm [ ['] [ ; :timm ] ] ; :timm } } ;
+:timm [ ['] [ ; :timm ] ] ;
 :timm ; t, return ['] [ ;
-
 :timm ( ['] ( ;
 
 :timm if t, BZ_ patchpt ;
@@ -96,14 +96,14 @@ s" coredefs.jrt" loadfile
 :timm again t, GOTO_ w>t ;
 :timm until t, BZ_ w>t ;
 
-:timm s" t, INLINEDATA_ patchpt 
+: t", begin key dup [ key " lit ] != while >t repeat drop 0 >t ;
-  begin key dup [ key " lit ] != while >t repeat drop 0 >t patch!t ;
+:timm s" state if t, INLINEDATA_ patchpt t", patch!t else target t", then ;
 
 :timm :| t, INLINEDATA_ patchpt t& $DOCOLON w>t ;
 :timm |; t, return patch!t ;
 
-: :t DEF t& $DOCOLON w>t ] { ;
+:noname DEF t& $DOCOLON w>t ] ;
-:timm : :t ;
+:timm : [ dup , ] ; :timm :t [ , ] ;
 :timm ' ['] t' ;
 :timm :noname target t& $DOCOLON w>t ] ;
 :timm const CONST ;
@@ -114,21 +114,31 @@ s" coredefs.jrt" loadfile
 :timm :asm :ASM ;
 :timm , w>t ; :timm b, >t ;
 :timm lit compilenum ;
+:timm deferred DEFERRED ;
 
+dbg" CREATE"
 : CREATE DEF t& $DOCREATE w>t 0 w>t ;
-: FINISHCREATE { latest } codepointer cell + @ cell + !t ;
+: FINISHCREATE ' latest ' tdict with-dict codepointer cell + @ cell + !t ;
-: DOES> target lit ' FINISHCREATE , ' return , { ; immediate
+: DOES} target lit ' FINISHCREATE , ' return , } ; immediate
 
-: import >{ >r word loadfile <r }< ;
+( s" blah.jrt" loadfile doesn't work in target mode because s" writes
+  to the target segment. You'd have to write { s" blah.jrt" } loadfile
+  which kind of stinks. We provide a simple, clean alternative. )
 
-import logic.jrt
+: import word loadfile ;
+
+} import logic.jrt
+
+  2 const cell
+  : cells 2* ;
+  : redefine ( cp cpdeferred -- ) cell + ! ; {
 
 var comfilename
 
 : readcom ( filename ) open 0x100 target! 
   begin dup fgetc dup EOF != while >t repeat drop close ;
 
-:init comfilename @ readcom { ;
+:init comfilename @ readcom } ;
 
 : writeenv ( comfile wrapper -- ) 
   swap comfilename !
@@ -139,8 +149,10 @@ DEFERRED main terminate
 
 dbg" boot"
 
+} : start main terminate ; {
+
 9 <: ( actual entry point )
-  MOV SI t& main #
+  MOV SI t& start #
   PUSH CS
   POP AX
   ADD AX 4096 #