2019-02-20 13:48:29 +01:00
|
|
|
# VGA Text Display
|
|
|
|
|
|
|
|
|
|
~~~
|
|
|
|
|
0xB8000 'VGA-BASE const
|
|
|
|
|
#80 'COLUMNS const
|
|
|
|
|
#25 'ROWS const
|
|
|
|
|
|
|
|
|
|
'vga:Row var
|
|
|
|
|
'vga:Column var
|
|
|
|
|
|
|
|
|
|
:vga:position (-a)
|
|
|
|
|
@vga:Row COLUMNS * #2 *
|
|
|
|
|
@vga:Column #2 * +
|
|
|
|
|
VGA-BASE + ;
|
|
|
|
|
|
2019-02-20 14:34:18 +01:00
|
|
|
:scroll
|
|
|
|
|
@vga:Row ROWS gt? [ #0 !vga:Row ] if ;
|
|
|
|
|
|
2019-02-20 13:48:29 +01:00
|
|
|
:vga:next
|
|
|
|
|
&vga:Column v:inc
|
|
|
|
|
@vga:Column COLUMNS gt? [ &vga:Row v:inc #0 !vga:Column ] if
|
|
|
|
|
@vga:Row ROWS gt? [ #0 !vga:Row ] if ;
|
|
|
|
|
|
2019-02-20 14:34:18 +01:00
|
|
|
:putc (c-)
|
|
|
|
|
#10 [ #0 !vga:Column &vga:Row v:inc scroll ] case
|
|
|
|
|
#13 [ #0 !vga:Column &vga:Row v:inc scroll ] case
|
|
|
|
|
vga:position ram:store-byte vga:next ;
|
2019-02-20 13:48:29 +01:00
|
|
|
:puts (s-) [ putc ] s:for-each ;
|
2019-02-20 14:34:18 +01:00
|
|
|
:clear (-) COLUMNS ROWS * #2 * [ ASCII:SPACE putc ] times #0 !vga:Row #0 !vga:Column ;
|
|
|
|
|
|
|
|
|
|
:test &putc &c:put set-hook ;
|
|
|
|
|
:-test &c:put unhook ;
|
2019-02-20 13:48:29 +01:00
|
|
|
~~~
|
