TriOS-alt/zubehör/startracker/source/bellatrix-code/stint.spin

670 lines
21 KiB
Plaintext
Raw Normal View History

2010-11-26 23:58:06 +01:00
''LCARS tryout in XGA *
'Trying to emulate look of this page: http://www.lcarscom.net/databank.htm
'Copyright 2008 Raymond Allen
{{ ---------------------------------------------------------------------------------------------------------
Hive-Computer-Projekt
Name : StarTracker
Chip : Bellatrix-Code (soundplayer)
Version : 0.1
Dateien : stint.spin
Beschreibung : Grafiktreiber f<>r StarTracker
Eigenschaften :
Logbuch :
Kommandoliste:
0 1 Tastaturstatus abfragen
0 2 Tastaturzeichen holen
0 3 n Screensteuerzeichen
0 3 0 CLS
0 3 1 Home
0 3 2 Backspace
0 3 3 TAB
0 3 4 n SETCUR Cursorzeichen auf n setzen
0 3 5 POS1
0 3 6 x SETX
0 3 7 y SETY
0 3 8 (x) GETX
0 3 9 (y) GETY
0 3 10 c SETCOL
0 3 11 n SLINE
0 3 13 SCREENINIT
0 3 14 CURON
0 3 15 CUROFF
0 99 Reboot und neuen Treiber laden
0 100 testfunktion
1..255 Zeichenausgabe
--------------------------------------------------------------------------------------------------------- }}
CON
_clkmode = xtal1 + pll16x
_xinfreq = 5_000_000
'number of custom 16x16 characters
nuchars = (6*3+1*7+47+23*2+20*5) '!!!!! you must have the correct # here for alignment later
'signaldefinitionen regnatix
#0, D0,D1,D2,D3,D4,D5,D6,D7 'datenbus
#8, BEL_VGABASE 'vga-signale (8pin)
#16, BEL_KEYBC,BEL_KEYBD 'keyboard-signale
#18, BEL_MOUSEC,BEL_MOUSED 'maus-signale
#20, BEL_VIDBASE 'video-signale(3pin)
#23, BEL_SELECT 'belatrix-auswahlsignal
#24, HBEAT 'front-led
BUSCLK 'bustakt
BUS_WR '/wr - schreibsignal
BUS_HS ' '/hs - quittungssignal
COLS = 64
ROWS = 48
TILES = cols * rows
TAB1 = 16
TAB2 = 32
TAB3 = 48
SPACETILE = $8000 + $20 << 6
VGA_BASPORT = 8 'vga startport
VGA_RESX = COLS * 16 'vga anzahl pixel x
VGA_RESY = ROWS * 16 'vga anzahl pixel y
KEYB_DPORT = BEL_KEYBD 'tastatur datenport
KEYB_CPORT = BEL_KEYBC 'tastatur taktport
MOUSE_DPORT = BEL_MOUSED
MOUSE_CPORT = BEL_MOUSEC
CURSORCHAR = $0E 'cursorzeichen
DB_WAIT = %00000001_00000000_00000000_00000000 'dira-wert f?r wait-status am bus
DB_IN = %00001001_00000000_00000000_00000000 'dira-wert f?r datenbuseingabe
DB_OUT = %00001001_00000000_00000000_11111111 'dira-wert f?r datenbusausgabe
CNT_HBEAT = 5_000_0000 'blinkgeschw. front-led
VAR
'variables for display
long col, row, color, flag
long array[tiles/2]
long stackhb[9] 'stack f?r hbeat-cog
byte cursor 'cursorzeichen
byte curstat 'cursorstatus 1 = ein
byte sline 'startzeile des scrollfensters
byte eline 'endzeile des scrollfensters
'for custom characters
word user_charbase
'for drawing buttons
word ptr
byte boxcolor
byte sBuffer[32] 'stingpuffer
OBJ
vga : "stvga"
keyb : "stkeyb"
PUB main | zeichen
{{interpreter f?r hostdialog}}
init_subsysteme 'bus/vga/keyboard/maus initialisieren
repeat
zeichen := bus_getchar '1. zeichen empfangen
if zeichen > 0
print_char(zeichen)
else
zeichen := bus_getchar '2. zeichen kommando empfange
case zeichen
1: bus_putchar(keyb.gotkey) '1: Tastaturstatus senden
2: bus_putchar(keyb.key) '2: Tastaturzeichen senden
3: zeichen := bus_getchar '3: Sonderzeichen von $100 bis $1FF ausgeben
print_char(zeichen + $100)
10: cmd_bitmap1
11: cmd_fillbox
12: cmd_drawtxt
99: reboot '99: bellatrix neu starten
100: gfx1
PUB gfx1
PUB cmd_bitmap1 | nBitmap,pBitmap,xPos,yPos,xSize,ySize,clr
'Bitmap1Bit(@endcap_med_left,1,1,1,2,1)
'Bitmap1Bit(pBitmap, xPos, yPos, xSize, ySize, clr)
nBitmap := bus_getchar
xPos := bus_getchar
yPos := bus_getchar
xSize := bus_getchar
ySize := bus_getchar
clr := bus_getchar
case nBitmap
0: pBitmap := @title
1: pBitmap := @footer
2: pBitmap := @button1
3: pBitmap := @button2
4: pBitmap := @button3
5: pBitmap := @button4
6: pBitmap := @button5
7: pBitmap := @button6
8: pBitmap := @button7
9: pBitmap := @button8
10: pBitmap := @button9
11: pBitmap := @corner_topleft
12: pBitmap := @corner_topright
13: pBitmap := @corner_bottomLeft
14: pBitmap := @endcap_med_left
15: pBitmap := @endcap_med_right
16: pBitmap := @endcap_small_left
17: pBitmap := @endcap_small_right
Bitmap1Bit(pBitmap, xPos, yPos, xSize, ySize, clr)
PUB cmd_fillbox | left,top,width,height,clr,bBottomBreak,bRightBreak,bTrimRight
'FillBlock(3,1,35,2,3,false,false,false)
'FillBlock(left,top,width,height,clr,bBottomBreak,bRightBreak,bTrimRight)
left := bus_getchar
top := bus_getchar
width := bus_getchar
height := bus_getchar
clr := bus_getchar
bBottomBreak := bus_getchar
bRightBreak := bus_getchar
bTrimRight := bus_getchar
FillBlock(left,top,width,height,clr,bBottomBreak,bRightBreak,bTrimRight)
PUB cmd_drawtxt | nButton,pButton,nLen,c,i
'DrawText(@button,@string,bInvert)
nButton := bus_getchar
nLen := bus_getchar
repeat i from 0 to nLen - 1
c := bus_getchar
sBuffer[i] := c
sBuffer[i+1] := 0
case nButton
0: pButton := @title
1: pButton := @footer
2: pButton := @button1
3: pButton := @button2
4: pButton := @button3
5: pButton := @button4
6: pButton := @button5
7: pButton := @button6
8: pButton := @button7
9: pButton := @button8
10: pButton := @button9
DrawText(pButton, @sBuffer,false)
PUB init_subsysteme
{{initialisierung des belatrix-chips}}
cognew(led_hbeat, @stackhb) 'heartbeat aktivieren
bus_init 'bussignale initialisieren
'64 byte align the user characters
user_charbase := @uchar & $FFC0 'destination
'user_charbase_offset := user_charbase-@uchar
longmove(user_charbase,@uchar,16*nuchars)
keyb.start(keyb_dport, keyb_cport) 'tastaturport starten
vga.start(vga_basport, @array, @vgacolors, 0,0,0) 'vga-treiber starten
print_char($100) 'bildschirm l?schen
cursor := CURSORCHAR 'cursorzeichen setzen
curstat := 1 'cursor anschalten
sline := 2
eline := rows
PUB bus_init
{{initialisierung des bussystems}}
dira := db_in 'datenbus auf eingabe schalten
outa[bus_hs] := 1 'handshake inaktiv
PUB bus_putchar(zeichen)
{{ein byte ?ber bus ausgeben}}
waitpeq(%00000010_00000000_00000000_00000000,%00000010_10000000_00000000_00000000,0) 'busclk=1? & prop2=0?
dira := db_out 'datenbus auf ausgabe stellen
outa[7..0] := zeichen 'daten ausgeben
outa[bus_hs] := 0 'daten g?ltig
waitpeq(%00000000_00000000_00000000_00000000,%00000010_00000000_00000000_00000000,0) 'busclk=0?
'waitcnt(1_000 + cnt) 'zeit f?r master
outa[bus_hs] := 1 'daten ung?ltig
dira := db_in 'bus freigeben
PUB bus_getchar : zeichen
{{ein byte ?ber bus empfangen}}
waitpeq(%00000010_00000000_00000000_00000000,%00000010_10000000_00000000_00000000,0) 'busclk=1? & prop2=0?
zeichen := ina[7..0] 'daten einlesen
outa[bus_hs] := 0 'daten quittieren
outa[bus_hs] := 1
waitpeq(%00000000_00000000_00000000_00000000,%00000010_00000000_00000000_00000000,0) 'busclk=0?
PUB led_hbeat
{{led_hbeat - herzschlag f?r front-led}}
dira := db_in
repeat
!outa[hbeat]
waitcnt(cnt_hbeat + cnt)
PUB print_str(strptr)
{{zeichenkette auf bildschirm ausgeben}}
repeat while byte[strptr]
print_char(byte[strptr++])
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
$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
$104: 'setcur
code := bus_getchar
cursor := code
if curstat == 1
schar(code)
$105: 'pos1
if curstat == 1
schar($20)
col := 0
if curstat == 1
schar(cursor)
$106: 'setx
if curstat == 1
schar($20)
col := bus_getchar
if curstat == 1
schar(cursor)
$107: 'sety
if curstat == 1
schar($20)
row := bus_getchar * 2 + sline '2 tiles pro zeichen!
if curstat == 1
schar(cursor)
$108: 'getx
bus_putchar(col)
$109: 'gety
bus_putchar(row / 2)
$110: 'setcolor
color := bus_getchar
$111: 'sline
sline := bus_getchar * 2
$112: 'eline
eline := bus_getchar * 2
$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
$116: 'scrollup
scrollup
$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)
PUB scrollup | i 'scrollt den screen nach oben
'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)
PRI DrawText(pBmp,str,bInvert)|x1,x2,i,j,b,k,c,s
'draw prop font into bitmap
k:=0 'current column
repeat s from 0 to strsize(str)-1
c:=byte[str][s]
if (c=>32) and (c=<(95+2)) 'note: char 96=dot, 97=degree
x1:=word[@FontTable][c-32]
x2:=word[@FontTable][c-32+1]
repeat i from x1 to x2-1
DrawFontColumn(i,j,pBmp,k,b)
'repeat j from 0 to 31
' b:=getFontPixel(i,j)
' setFontPixel(pBmp,k,j,b)
k++
PRI DrawFontColumn(x,y,pdest,k,b)|dtile,stile,doffset,soffset,psrc,d,pixel,j
stile:=x/16
soffset:=(x//16)*2
psrc:=@font+4*16*stile+user_charbase-@uchar
dtile:=k/16
doffset:=(k//16)*2
pdest+=4*16*dtile+user_charbase-@uchar
repeat j from 0 to 31
y:=j
if y=>16
y-=16
if j==16
soffset++
doffset++
pixel:=long[psrc][y//16]
pixel>>=soffset
pixel&=$1
'draw
if pixel
long[pdest][y//16]|=|<doffset
else
long[pdest][y//16]&=!(|<doffset)
PRI getFontPixel(x,y)|tile,offset,p,d
'return boolean indicating state of font pixel at (x,y)
tile:=x/16
offset:=(x//16)*2
if y=>16
offset++
y-=16
p:=@font+4*16*tile
d:=long[p+user_charbase-@uchar][y//16]
d>>=offset
return (d&$1)>0
PRI setFontPixel(p,x,y,b)|tile,offset,d
'set (b=true) or clear (b=false) pixel in bmp @p at coordinates (x,y)
tile:=x/16
offset:=(x//16)*2
if y=>16
offset++
y-=16
p+=4*16*tile+user_charbase-@uchar
'd:=long[p][y//16]
if b
long[p][y//16]|=|<offset
else
long[p][y//16]&=!(|<offset)
PRI FillBlock(left,top,width,height,clr,bBottomBreak,bRightBreak,bTrimRight)|x,y,p,bBottomTile
' fill a block and optionally add break to bottom or right edges
repeat y from top to top+height-1
repeat x from left to left+width-1
bBottomTile:=false
p:=@filled_space
if bRightBreak
if (x==(left+width-1 ))
p:=@hv_break
if bBottomBreak
bBottomTile:=true
if y==(top+height-1)
p:=@hv_break
if (bTrimRight and bBottomBreak) and (x==(left+width-1 ))
if (y==(top+height-1))
p:=@hv_break2
else
p:=@hv_break
bBottomTile:=false
Bitmap1BitTile(p,x,y,clr,bBottomTile)
PRI uPrint(c,ncol,nrow)
uPrintTop(c,ncol,nrow)
uPrintBottom(c,ncol,nrow+1)
PRI uPrintTop(c,ncol,nrow)|i,k
'print top part of a character
k := color << 1 + c & 1
i := user_charbase + (c & $FE) << 6 + k
array.word[nrow * cols + ncol] := i'user_charbase + (c<<6) + color'(color << 1 + c & 1) << 10 + user_charbase>>6 + c & $FE
PRI uPrintBottom(c,ncol,nrow)|i,k
'print bottom part of a character
k := color << 1 + c & 1
i := user_charbase + (c & $FE) << 6 + k
array.word[nrow * cols + ncol] := i+$40'user_charbase + (c<<6) + color+$40'(color << 1 + c & 1) << 10 + user_charbase>>6 + c & $FE +1
PRI Bitmap2Bit(pBitmap, xPos, yPos, xSize, ySize, clr)|c,i,j,BmpAddress
row:=yPos
col:=xPos
c:=0
BmpAddress:=pBitmap+user_charbase-@uchar
repeat j from 0 to (ySize-1)
repeat i from 0 to (xSize-1)
array.word[row * cols + col] := BmpAddress + (c<<6) + clr
'Print2Bit(c,clr,pBitmap)
c++
col++
row++
col:=xPos
PRI Bitmap1Bit(pBitmap, xPos, yPos, xSize, ySize, clr)|c,i,j,BmpAddress
row:=yPos
col:=xPos
c:=0
BmpAddress:=pBitmap+user_charbase-@uchar
repeat j from 0 to (ySize-1) step 2
repeat i from 0 to (xSize-1)
array.word[row * cols + col] := (clr<<1+1) + BmpAddress +c<<6
if ySize<>1
array.word[(row+1) * cols + col] := (clr<<1) + BmpAddress +c<<6
c++
col++
row+=2
col:=xPos
PRI Bitmap1BitTile(pBitmap,x,y,clr,bLower)|BmpAddress
'print just the upper or lower tile of a 2-tile bitmap
BmpAddress:=pBitmap+user_charbase-@uchar
clr:=clr<<1+1
if bLower
clr-=1
array.word[y * cols + x] := clr + BmpAddress
DAT
vgacolors long
'0..1: text color 0:
long $90009000 'orange on black
long $90900000
'2..3: text color 1:
long $5c005c00 'blue on black
long $5c5c0000
'4..5: text color 2:
long $94009400 'light red on black
long $94940000
'6..7: text color 3:
long $98009800 'purple on black
long $98980000
'8..9: text color 4:
long $f800f800 'yellow on black
long $f8f80000
'10..11: text color 5:
long $84008400 'dark red on black
long $84840000
'12: graphics 2: 'card edge colors
long $100000FC ''green,black,black,white
'13: graphics 3: 'red face card colors
long $F0C000FC ' yellow,red,black,white
'14: graphics 4: 'black face card colors
long $F000C0FC ''yellow,black,red,white
'15: graphics 5: button colors
long $FC54A8A8 'lt grey, dk.gray, gray, gray
FontTable word
word 8, 16,21,32,60,72,92,107,114,121,129,138,150,156,164,170,184,195,203,214,225,239,250,261,273,284,295,300,306,316,333,343,354,378,392 'to B
word 403,414,425,435,445,456,467,472,483,496,506,523,537,548,559,570,582,593,605,616,630,649,663,676,686,695,706,720,733,743,751 'note last two chars are dot and degree
padding LONG 7[16] 'alignment padding for the following user defined characters
uchar long
corner_topleft long
file "corner_topleft.dat" '6x2
corner_topright long
file "corner_topright.dat" '6x2
corner_bottomLeft long
file "corner_bottomLeft.dat" '6x2
hv_break long
file "hv_break.dat" '1x2
hv_break2 long
file "hv_break2.dat" '1x2
endcap_med_left long
file "endcap_med_left.dat" '1x2
endcap_med_right long
file "endcap_med_right.dat" '1x2
endcap_small_left long
file "endcap_small_left.dat" '1x2
endcap_small_right long
file "endcap_small_right.dat" '1x2
filled_space long
file "filled_space.dat" '1x2
font long
file "font_29p5.dat" '47x2
title long 0[16*23] 'space for title 23x2
footer long 0[16*23] 'space for footer 23x2
button1 long 0[16*20] 'space for button text 10x2
button2 long 0[16*20] 'space for button text
button3 long 0[16*20] 'space for button text
button4 long 0[16*20] 'space for button text
button5 long 0[16*20] 'space for button text
button6 long 0[16*20] 'space for button text 10x2
button7 long 0[16*20] 'space for button text
button8 long 0[16*20] 'space for button text
button9 long 0[16*20] 'space for button text