commit 406d633cace6f870516030aca52c2db26b49378c
parent 919e09bf652c319197b536d09e84c6dc0999f1df
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Wed, 14 Dec 2022 20:18:48 -0500
emul/uxn: first steps with the screen device!
You can try it on PC by typing this on boot:
f<< /tests/manual/uxn/rect.fs
You see that small delay (under QEMU!) before you see the white rectangle?
That's:
1. Compile DuskCC
2. Compile uxn
3. Compile uxntal
4. Compile varvara
5. Compile rect.tal
6. Run the program
Not bad eh? of course, if you run it again, it will be instant.
Diffstat:
9 files changed, 86 insertions(+), 30 deletions(-)
diff --git a/fs/asm/uxntal.fs b/fs/asm/uxntal.fs
@@ -1,3 +1,10 @@
+?f<< /emul/uxn/vm.fs
?f<< /comp/c/lib.fs
?f<< /lib/arena.h
cc<< /asm/uxntal.c
+
+uxn_ram MemIO :new structbind MemIO _memio
+: tal>vm ( strpath -- res )
+ uxn_ram $100 + to _memio ptr
+ _memio :self to StdOut
+ curpath :find# Path :open dup uxntal stdio$ swap File :close ;
diff --git a/fs/comp/c/pgen.fs b/fs/comp/c/pgen.fs
@@ -25,7 +25,7 @@ $10 const MAXARGCNT
\ Maximum size in bytes that a single literal can have
$400 const MAXLITSZ
-1 value _ccdebug
+0 value _ccdebug
: _err ( -- ) tokdbg abort" pgen error" ;
: _assert ( f -- ) not if _err then ;
: spit ( a u -- ) swap >r >r begin
@@ -516,6 +516,7 @@ current to parseStatement
dup CType :funcsig? if ( ctype )
'{' readChar? if dup parseFunctionBody
_ccdebug if
- ." complete: " dup printtype nl> CType offset here over - spit nl> then
+ ." complete: " dup printtype nl> CType offset here over - spit nl>
+ else drop then
else parseFunctionProto then
else parseGlobalDecl then ( ) ;
diff --git a/fs/emul/uxn/screen.fs b/fs/emul/uxn/screen.fs
@@ -0,0 +1,30 @@
+\ Varvara screen implementation
+require /sys/draw.fs
+?f<< /emul/uxn/varvara.fs
+
+\ example: $5678 for "r" means ID0=5 ID1=6 ID2=7 ID3=8
+: _extract ( systemrgb id -- rgb8 )
+ 3 -^ << << rshift $f and 4 ( rgb4 ) 4 lshift ;
+\ get color from uxn's System.(r|g|b) for specified ID (0-3)
+\ TODO: this doesn't work, hardcode to white for now.
+: screencolor ( id -- color ) >r \ V1=id
+ 0 uxn_dev Device dat 8 + ( 'r )
+ 16b @+ r@ _extract ( 'g r8 )
+ swap 16b @+ r@ _extract ( r8 'b g8 )
+ swap 16b @ r> _extract ( r8 g8 b8 ) rgbcolor ;
+
+: screencolor drop 255 255 255 rgbcolor ;
+
+: screendei ( dev port -- c ) 2drop 0 ;
+: screendeo ( dev port -- ) case ( dev ) \ V1=case
+ $e of = >r \ V2=dev
+ $8 r@ devshort@ ( x ) $a r@ devshort@ ( x y ) pixel' ( a )
+ $e r> Device dat + c@ screencolor ( a color ) swap pixel!
+ endof
+ drop endcase ;
+
+: screen_init
+ $2 ['] screendei ['] screendeo uxn_set_dev
+ $112 vesamode! ;
+
+: screen_deinit vgatext! ;
diff --git a/fs/emul/uxn/varvara.fs b/fs/emul/uxn/varvara.fs
@@ -1,4 +1,6 @@
\ Varvara implementation
+\ Excludes screen device, which requires sys/draw. To have a full varvara, load
+\ /emul/uxn/screen.fs before you call varvara_init.
?f<< /lib/str.fs
?f<< /emul/uxn/vm.fs
diff --git a/fs/emul/uxn/vm.c b/fs/emul/uxn/vm.c
@@ -1,9 +1,6 @@
/* uxn VM
*
- * Because DuskCC is incomplete but I'm too impatient to try implementing a uxn
- * VM, I had to change the design of uxn's code quite a bit. DuskCC for now
- * lacks goto, switch and parametrizable macros, 3 things at the heart of the
- * official uxn VM. Let's do things differently.
+ * Implemented from scratch to be closer to Dusk
*/
struct Stack {
@@ -193,12 +190,7 @@ void uxn_exec() {
sp = &src->ptr;
}
op &= $1f;
- if (ops[op]) {
- ops[op]();
- } else {
- printf(op, "unimplemented %b\n");
- return;
- }
+ ops[op]();
}
}
@@ -218,10 +210,4 @@ void uxn_init() {
}
uint* uxn_ram() { return ram; }
-void uxn_set_dev(
- int port,
- uchar (*dei)(Device*, uchar),
- void (*deo)(Device*, uchar)) {
- dev[port].dei = dei;
- dev[port].deo = deo;
-}
+Device* uxn_dev(int port) { return &dev[port]; }
diff --git a/fs/emul/uxn/vm.fs b/fs/emul/uxn/vm.fs
@@ -4,3 +4,5 @@ cc<< /emul/uxn/vm.c
S" Device" findTypedef CType :export
+: uxn_set_dev ( port dei deo -- )
+ rot uxn_dev tuck to Device deo to Device dei ;
diff --git a/fs/tests/emul/uxn/vm.fs b/fs/tests/emul/uxn/vm.fs
@@ -5,17 +5,12 @@
?f<< /asm/uxntal.fs
testbegin
\ Testing uxn VM
-uxn_ram MemIO :new structbind MemIO _memio
-: _load ( path -- )
- uxn_ram $100 + to _memio ptr
- _memio :self to StdOut
- curpath :find# Path :open dup uxntal stdio$ 0 #eq File :close ;
-S" /tests/emul/uxn/hello.tal" _load
+S" /tests/emul/uxn/hello.tal" tal>vm 0 #eq
varvara_init
capture uxn_exec
S" Hello World!" #s=
-S" /tests/emul/uxn/fib.tal" _load
+S" /tests/emul/uxn/fib.tal" tal>vm 0 #eq
varvara_init
create expected 47 nc,
46 $00 $01 $00 $02 $00 $03 $00 $05 $00 $08 $00 $0d $00 $15 $00 $22 $00 $37
@@ -23,15 +18,15 @@ create expected 47 nc,
$1a $6d $2a $c2 $45 $2f $6f $f1 $b5 $20
capture uxn_exec expected 47 []= #
-S" /tests/emul/uxn/hexfmt.tal" _load
+S" /tests/emul/uxn/hexfmt.tal" tal>vm 0 #eq
varvara_init
capture uxn_exec S" 1234abcd" #s=
-S" /tests/emul/uxn/tests.tal" _load
+S" /tests/emul/uxn/tests.tal" tal>vm 0 #eq
varvara_init
capture uxn_exec S" X" #s=
-S" /tests/emul/uxn/deideo.tal" _load
+S" /tests/emul/uxn/deideo.tal" tal>vm 0 #eq
varvara_init
capture uxn_exec Z S" Z" #s=
@@ -41,7 +36,7 @@ capture uxn_exec Z S" Z" #s=
512 TOTSEC RAMDrive :new value mydrv
mydrv BlobFS :mount value myfs
myfs filesystems CELLSZ + ! \ register it as "B:"
-S" /tests/emul/uxn/file.tal" _load
+S" /tests/emul/uxn/file.tal" tal>vm 0 #eq
varvara_init
capture uxn_exec
S" 0011 HELLO.TXT\n" #s=
diff --git a/fs/tests/manual/uxn/rect.fs b/fs/tests/manual/uxn/rect.fs
@@ -0,0 +1,10 @@
+\ Test varvara's screen by drawing a rect on screen
+?f<< /asm/uxntal.fs
+?f<< /emul/uxn/screen.fs
+
+S" /tests/manual/uxn/rect.tal" tal>vm drop
+varvara_init
+screen_init
+uxn_exec
+key drop
+screen_deinit
diff --git a/fs/tests/manual/uxn/rect.tal b/fs/tests/manual/uxn/rect.tal
@@ -0,0 +1,23 @@
+|00 @System &vector $2 &wst $1 &rst $1 &eaddr $2 &ecode $1 &pad $1 &r $2 &g $2 &b $2 &debug $1 &halt $1
+|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
+
+%WIDTH { #42 }
+%HEIGHT { #54 }
+
+|0100 ( -> )
+ ( theme )
+ #0f0f .System/r DEO2
+ #0ff0 .System/g DEO2
+ #00ff .System/b DEO2
+
+ #00 ( y )
+ &loopy
+ #00 OVR .Screen/y DEO2 INC
+ #00 ( y x )
+ &loopx
+ #00 OVR .Screen/x DEO2 INC
+ #41 .Screen/pixel DEO
+ DUP WIDTH LTH ,&loopx JCN
+ POP DUP HEIGHT LTH ,&loopy JCN
+ POP
+ BRK
