Toolbox-1/source/bellatrix/12-matr.spin

329 lines
9.5 KiB
Plaintext

CON 'Hive-Computer-Projekt
{{
Tutorial : "Build your OS"
Name : VGA-Texttreiber
Chip : Bellatrix-Code
Version : 0
Dateien :
}}
CON 'Konstanten
_clkmode = xtal1 + pll16x
_xinfreq = 5_000_000
cols = 64
rows = 48
tiles = cols * rows
spacetile = $8000 + $20 << 6
vga_basport = 8 'vga startport
keyb_dport = 17 'tastatur datenport
keyb_cport = 16 'tastatur taktport
CURSORCHAR = $0E 'cursorzeichen
TAB1 = 16
TAB2 = 32
TAB3 = 48
OBJ 'Verwendete Objekte
vga : "bel-vga"
key : "bel-keyb"
gfx1 : "bel-gfx1"
VAR 'Variablen
long cur,col, row, color
long array[tiles/2]
byte cursor 'cursorzeichen
byte curstat 'cursorstatus 1 = ein
byte sline 'startzeile des scrollfensters
byte eline 'endzeile des scrollfensters
long stack1[48]
long stack2[48]
long stack3[48]
long stack4[48]
CON
srow = 3
erow = 45
rndfac = $efffffff/256
PUB main | i 'Hauptroutine
init_subsysteme
gfx1.start 'tv-scroller starten
print_char($115)
cognew(mstring(0), @stack1)
cognew(mstring(0), @stack2)
cognew(mstring(0), @stack3)
cognew(mstring(0), @stack4)
mstring(0)
PUB mstring(cid) | i,len,x,ecnt,acc
i := cnt
repeat
acc := ?i & $6f
len := ?i & $2f
x := ?i & $3f
ecnt:= ?i & $3ef + 10
if acc == $2f
flow(len,x,ecnt,cid+3)
else
flow(len,x,ecnt,cid)
if key.key == key#Esc
reboot
PUB flow(len,x,ecnt,cid) | y,char,rnd,ccnt,mrow,mcol,mcolor
mcol := x
mrow := srow
repeat len
repeat ccnt from 0 to ecnt
mcolor := 1 + cid
mchar(?char & $FF,mrow,mcol,mcolor)
mcolor := 0 + cid
mchar(?char & $FF,mrow,mcol,mcolor)
if mrow++ => erow
mrow := srow
PUB unflow(len,x,ecnt,cid) | y,char,rnd,ccnt,mrow,mcol,mcolor
mcol := x
mrow := srow
repeat len
repeat ccnt from 0 to ecnt
mcolor := 1 + cid
mchar(?char & $FF,mrow,mcol,4)'mcolor)
mchar(" ",mrow,mcol,mcolor)
if mrow++ => erow
mrow := srow
PRI mchar(c,mrow,mcol,mcolor) | i,k
'schreibt zeichen an aktuelle position ohne cursorposition zu verändern
k := mcolor << 1 + c & 1
i := $8000 + (c & $FE) << 6 + k
array.word[mrow * cols + mcol] := i 'oberes tile setzen
array.word[(mrow + 1) * cols + mcol] := i | $40 'unteres tile setzen
PUB init_subsysteme
{{initialisierung des belatrix-chips}}
color := 1
key.start(keyb_dport, keyb_cport) 'tastaturport starten
vga.start(vga_basport, @array, @vgacolors, 0, 0, 0) 'vga-treiber starten
print_char($100)
print_string(@ver1)
print_char($0D)
cursor := CURSORCHAR 'cursorzeichen setzen
curstat := 1 'cursor anschalten
sline := 2
eline := rows
PRI print_string(ptr) 'Stringausgabe
repeat while byte[ptr] 'wiederhole bis $0
print_char(byte[ptr++]) 'ausgabe des zeichens
PUB printdec(value) | i
if value < 0 'negativer zahlenwert
-value
print_char("-")
i := 1_000_000_000
repeat 10 'zahl zerlegen
if value => i
print_char(value / i + "0")
value //= i
result~~
elseif result or i == 1
print_char("0")
i /= 10 'nächste stelle
PUB printhex(value, digits)
value <<= (8 - digits) << 2
repeat digits
print_char(lookupz((value <-= 4) & $F : "0".."9", "A".."F"))
PUB print_char(c) | code,n
{{zeichen auf bildschirm ausgeben}}
'' Print a character
''
'' $0D = new line
'' $20..$FF = character
'' $100 = clear screen
'' $101 = home
'' $108 = backspace
''$110..$11F = select color
case c
$0A: 'LF ausblenden
return
$00..$0C:
pchar(c)
if curstat == 1
schar(cursor)
$0D: 'return?
if curstat == 1
schar($20)
newline
if curstat == 1
schar(cursor)
$0E..$FF: 'character?
pchar(c)
if curstat == 1
schar(cursor)
$100: 'clear screen?
if curstat == 1
schar($20)
n := sline * cols * 2
wordfill(@array + n, spacetile, tiles - n)
row := sline
col := 0
if curstat == 1
schar(cursor)
$101: 'home?
row := sline
col := 0
$102: 'backspace?
if col
if curstat == 1
schar($20)
col--
if curstat == 1
schar(cursor)
$103: 'tab
if col < TAB1
if curstat == 1
schar($20)
col := TAB1
if curstat == 1
schar(cursor)
return
if col < TAB2
if curstat == 1
schar($20)
col := TAB2
if curstat == 1
schar(cursor)
return
if col < TAB3
if curstat == 1
schar($20)
col := TAB3
if curstat == 1
schar(cursor)
return
$105: 'pos1
if curstat == 1
schar($20)
col := 0
if curstat == 1
schar(cursor)
$113: 'screeninit
wordfill(@array, spacetile, tiles)
row := 0
col := 0
sline := 0
$114: 'curon
curstat := 1
schar(cursor)
$115: 'curoff
if curstat == 1
schar($20)
curstat := 0
$130..$13F: 'select color?
color := c & $F
PRI schar(c)| i,k
'schreibt zeichen an aktuelle position ohne cursorposition zu verändern
k := color << 1 + c & 1
i := $8000 + (c & $FE) << 6 + k
array.word[row * cols + col] := i 'oberes tile setzen
array.word[(row + 1) * cols + col] := i | $40 'unteres tile setzen
PRI pchar(c)
'schreibt zeichen an aktuelle position zählt position weiter
schar(c)
if ++col == cols
newline
PUB newline | i
col := 0
if (row += 2) == rows
row -= 2
'scroll lines
repeat i from sline to rows-3
wordmove(@array.word[i*cols], @array.word[(i+2)*cols], cols) 'wordmove(dest,src,cnt)
'clear new line
wordfill(@array.word[(rows-2)*cols], spacetile, cols<<1)
DAT 'Daten
'============================================================
' v h v h ' v=Vordergrund, h=Hintergrund
' long $ 3C 04 3C 04 'Muster
' v v h h
' long $ 3C 3C 04 04 'Muster
'
'0 %%RGBx_RGBx_RGBx_RGBx
' long %%0220_0010_0220_0010
' long %%0220_0220_0010_0010
'============================================================
vgacolors long 'farbtabelle
'0 %%RGBx_RGBx_RGBx_RGBx 'dunkles grün auf schwarz
long %%0100_0000_0100_0000
long %%0100_0100_0000_0000
'1 %%RGBx_RGBx_RGBx_RGBx 'helles grün auf schwarz
long %%0200_0000_0200_0000
long %%0200_0200_0000_0000
'2 %%RGBx_RGBx_RGBx_RGBx 'dunkles rot auf schwarz
long %%1000_0000_1000_0000
long %%1000_1000_0000_0000
'3 %%RGBx_RGBx_RGBx_RGBx 'helles rot auf schwarz
long %%2000_0000_2000_0000
long %%2000_2000_0000_0000
'4 %%RGBx_RGBx_RGBx_RGBx 'dunkles rot auf schwarz
long %%0010_0000_0010_0000
long %%0010_0010_0000_0000
'5 %%RGBx_RGBx_RGBx_RGBx 'helles rot auf schwarz
long %%0020_0000_0020_0000
long %%0020_0020_0000_0000
long $0C000C00 'blue
long $0C0C0000
long $FC00FC00 'white
long $FCFC0000
long $FF80FF80 'red/white
long $FFFF8080
long $FF20FF20 'green/white
long $FFFF2020
long $FF28FF28 'cyan/white
long $FFFF2828
long $C0408080 'redbox
long $3010F020 'greenbox
long $3C142828 'cyanbox
long $FC54A8A8 'greybox
long $3C14FF28 'cyanbox+underscore
long $F030C050 'graphics colors
ver1 byte "▶Hive - UniMatrix",0
prompt1 byte "ok",$0D, 0