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

This commit is contained in:
Jeremy Penner 2023-09-17 22:24:14 -04:00
parent adaf3c8e6f
commit 218fd0a8ef
10 changed files with 151 additions and 42 deletions

Binary file not shown.

View file

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

View file

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

BIN
testgame.com Executable file

Binary file not shown.

105
text.jrt
View file

@ -45,10 +45,10 @@
0xb800 const TEXTMEM 0xb800 const TEXTMEM
} : PREP-TEXTCOPY { : PREP-TEXTCOPY
MOV ES t& TEXTMEM @+ MOV ES t& TEXTMEM @+
MOV AH textpen @+ MOV AH textpen @+
MOV DI textpage @+ ; { MOV DI textpage @+ ; }
:asm fill-page ( char -- ) :asm fill-page ( char -- )
INT 3 # INT 3 #
@ -59,15 +59,20 @@
NEXT NEXT
0 var, textpos 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 PREP-TEXTCOPY
ADD DI textpos @+ ; { ADD DI textpos @+ ;
: CORRECT-TEXTPOS
SUB DI textpage @+
MOV textpos @+ DI ; }
:asm draw-text ( s -- ) :asm draw-text ( s -- )
MOV BX SI MOV BX SI
@ -80,8 +85,86 @@
STOSW STOSW
JMP 0 <@ JMP 0 <@
0 <: 0 <:
SUB DI textpage @+ CORRECT-TEXTPOS
MOV textpos @+ DI
MOV SI BX MOV SI BX
NEXT 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 ;

Binary file not shown.

View file

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

Binary file not shown.

View file

@ -45,12 +45,15 @@ asm-com
: t, tlookup state if lit ' w>t , else w>t then ; immediate : t, tlookup state if lit ' w>t , else w>t then ; immediate
: '>t tlookup w>t ; : '>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 + , ; : :asm asm-here new-word here cell + , ;
s" coredefs.jrt" loadfile s" coredefs.jrt" loadfile
@ -65,25 +68,22 @@ s" coredefs.jrt" loadfile
tdict dict-lookup dup state or if return then tdict dict-lookup dup state or if return then
drop primary-dict dict-lookup ; 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 ' pri-targ-lookup ' lookup redefine
' , ' compileword redefine ' , ' compileword redefine
' lit ' compilenum 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 ( 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. ) 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 ; t, return ['] [ ;
:timm ( ['] ( ; :timm ( ['] ( ;
:timm if t, BZ_ patchpt ; :timm if t, BZ_ patchpt ;
@ -96,14 +96,14 @@ s" coredefs.jrt" loadfile
:timm again t, GOTO_ w>t ; :timm again t, GOTO_ w>t ;
:timm until t, BZ_ 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, INLINEDATA_ patchpt t& $DOCOLON w>t ;
:timm |; t, return patch!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 ' ['] t' ;
:timm :noname target t& $DOCOLON w>t ] ; :timm :noname target t& $DOCOLON w>t ] ;
:timm const CONST ; :timm const CONST ;
@ -114,21 +114,31 @@ s" coredefs.jrt" loadfile
:timm :asm :ASM ; :timm :asm :ASM ;
:timm , w>t ; :timm b, >t ; :timm , w>t ; :timm b, >t ;
:timm lit compilenum ; :timm lit compilenum ;
:timm deferred DEFERRED ;
dbg" CREATE"
: CREATE DEF t& $DOCREATE w>t 0 w>t ; : 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 var comfilename
: readcom ( filename ) open 0x100 target! : readcom ( filename ) open 0x100 target!
begin dup fgetc dup EOF != while >t repeat drop close ; begin dup fgetc dup EOF != while >t repeat drop close ;
:init comfilename @ readcom { ; :init comfilename @ readcom } ;
: writeenv ( comfile wrapper -- ) : writeenv ( comfile wrapper -- )
swap comfilename ! swap comfilename !
@ -139,8 +149,10 @@ DEFERRED main terminate
dbg" boot" dbg" boot"
} : start main terminate ; {
9 <: ( actual entry point ) 9 <: ( actual entry point )
MOV SI t& main # MOV SI t& start #
PUSH CS PUSH CS
POP AX POP AX
ADD AX 4096 # ADD AX 4096 #

Binary file not shown.