107 lines
3.0 KiB
Tal
107 lines
3.0 KiB
Tal
( ESOP stdlib, subroutine part )
|
|
( by Luxferre, 2022, public domain )
|
|
|
|
( sprite and text drawing routines )
|
|
|
|
( subtract #20 from the ASCII code and get the absolute offset from the nanofont label )
|
|
%CHAR-TO-NF { #20 SUB BTS #10 SFT2 ;nanofont ADD2 }
|
|
|
|
( 4x1 scanline output from the nibble )
|
|
@line4 ( x y nibble -- x y )
|
|
#04 ( x y nibble counter -- )
|
|
&lp
|
|
DEC ( first effective counter value is 3 )
|
|
DUP2 ( x y nibble counter nibble counter -- )
|
|
GETBIT ( x y nibble counter bit -- )
|
|
,&dpxl JCN
|
|
,&skip JMP
|
|
&dpxl ( x y nibble counter -- )
|
|
SWP2 PXLk SWP2
|
|
&skip ( x y nibble counter -- )
|
|
SWP2 SWP ( nibble counter y x -- )
|
|
INC ( increment x coord )
|
|
SWP SWP2 ( x y nibble counter -- )
|
|
DUP ,&lp JCN
|
|
POP2 ( x y nibble counter -- x y )
|
|
SWP #04 SUB SWP ( restore x coord )
|
|
JMP2r
|
|
|
|
( 4x4 sprite output from the short )
|
|
@sprite4 ( x y sprval* -- x y )
|
|
SWP2 OVR2 ( sprval* x y sprval* -- )
|
|
( line 1 )
|
|
#0c SFT2 NIP ( sprval* x y nibble -- )
|
|
;line4 JSR2 ( sprval* x y -- )
|
|
( line 2 )
|
|
INC ( increment y coord )
|
|
OVR2 ( sprval* x y sprval* -- )
|
|
#08 SFT2 NIP #0f AND ( sprval* x y nibble -- )
|
|
;line4 JSR2 ( sprval* x y -- )
|
|
( line 3 )
|
|
INC ( increment y coord )
|
|
OVR2 ( sprval* x y sprval* -- )
|
|
#04 SFT2 NIP #0f AND ( sprval* x y nibble -- )
|
|
;line4 JSR2 ( sprval* x y -- )
|
|
( line 4 )
|
|
INC ( increment y coord )
|
|
OVR2 ( sprval* x y sprval* -- )
|
|
NIP #0f AND ( sprval* x y nibble -- )
|
|
;line4 JSR2 ( sprval* x y -- )
|
|
#03 SUB ( restore y coord )
|
|
SWP2 POP2 ( x y -- )
|
|
JMP2r
|
|
|
|
( nanofont character sprite output )
|
|
@drawc ( x y char -- x y )
|
|
CHAR-TO-NF LDA2 ;sprite4 JSR2
|
|
JMP2r
|
|
|
|
@putc ( same as drawc but auto increment x coord )
|
|
;drawc JSR2
|
|
SWP #04 ADD SWP
|
|
JMP2r
|
|
|
|
( output a complete null-terminated string at x y )
|
|
@draw-str ( x y s* -- x y )
|
|
&loop
|
|
LDAk ( x y s* c -- )
|
|
#00 EQU ,&eof JCN ( eof on #00 )
|
|
( x y s* -- )
|
|
LDAk ( x y s* c -- )
|
|
ROT ROT ( x y c s* -- )
|
|
STH2 ( x y c -- )
|
|
;putc JSR2 ( x y -- )
|
|
STH2r ( x y s* )
|
|
INC2 ,&loop JMP
|
|
&eof POP2 JMP2r
|
|
|
|
( convert true hex short value to BCD - up to 9999 represented by #270f coded into #9999 )
|
|
|
|
( convert BCD to hex value )
|
|
|
|
( output decimal short )
|
|
@print-dec ( x y value* -- x y )
|
|
STH2 ( value* -- )
|
|
#00 ,&zero STR
|
|
#2710 ,&parse JSR
|
|
#03e8 ,&parse JSR
|
|
#0064 ,&parse JSR
|
|
#000a ,&parse JSR
|
|
,&emit JSR POP
|
|
STH2r
|
|
JMP2r
|
|
&parse DIV2k DUP ,&emit JSR MUL2 SUB2 JMP2r
|
|
&emit
|
|
DUP [ LIT &zero $1 ] #0000 EQU2 ,&skip JCN
|
|
#01 ,&zero STR DUP #30 ADD STH2r ROT ;putc STH2 JSR2 &skip POP JMP2r
|
|
|
|
( nanofont glyphs for ESOP, courtesy of Michaelangel007 )
|
|
|
|
@nanofont
|
|
0000 4400 aa00 aee0 64c4 ce60 4c60 4000 4840 4240 6600 4e40 0088 0e00 0080 2480
|
|
4a40 8440 c460 e6e0 ae20 64c0 8ee0 e220 6ec0 ee20 4040 0448 4840 e0e0 4240 6240
|
|
cc20 4ea0 cee0 6860 cac0 ece0 ec80 cae0 aea0 4440 22c0 aca0 88e0 eea0 eaa0 eae0
|
|
ee80 eac0 cea0 64c0 e440 aae0 aa40 aee0 a4a0 a440 e4e0 c8c0 8420 6260 4a00 00e0
|
|
8400 04c0 8cc0 0cc0 4cc0 08c0 4880 0ccc 8cc0 0880 0448 8ca0 8840 0ce0 0ca0 0cc0
|
|
0cc8 0cc4 0c80 0480 4c60 0ae0 0a40 0e60 0cc0 0ae2 0840 6c60 4444 c6c0 6c00 a4a4
|