339 lines
12 KiB
Plaintext
339 lines
12 KiB
Plaintext
|
{
|
||
|
|
||
|
}
|
||
|
|
||
|
CON
|
||
|
_CLKMODE = XTAL1 + PLL16X
|
||
|
_XINFREQ = 5_000_000
|
||
|
_stack = ($3000 + $3000 + 100) >> 2
|
||
|
|
||
|
x_tiles = 16
|
||
|
y_tiles = 12
|
||
|
|
||
|
paramcount = 14
|
||
|
bitmap_base = $2000
|
||
|
display_base = $5000
|
||
|
|
||
|
max_x = x_tiles * 16
|
||
|
max_y = y_tiles * 16
|
||
|
|
||
|
s_obj = 200 'scale
|
||
|
d_obj = 64 'durchmesser
|
||
|
r_obj = d_obj/2 'radius
|
||
|
rotvar = 16 'rotationsvarianz
|
||
|
arcstep = 16
|
||
|
arcdistx = 0
|
||
|
arcdisty = -100
|
||
|
rband = 10
|
||
|
|
||
|
VAR
|
||
|
long tv_status '0/1/2 = off/visible/invisible read-only
|
||
|
long tv_enable '0/? = off/on write-only
|
||
|
long tv_pins '%ppmmm = pins write-only
|
||
|
long tv_mode '%ccinp = chroma,interlace,ntsc/pal,swap write-only
|
||
|
long tv_screen 'pointer to screen (words) write-only
|
||
|
long tv_colors 'pointer to colors (longs) write-only
|
||
|
long tv_hc 'horizontal cells write-only
|
||
|
long tv_vc 'vertical cells write-only
|
||
|
long tv_hx 'horizontal cell expansion write-only
|
||
|
long tv_vx 'vertical cell expansion write-only
|
||
|
long tv_ho 'horizontal offset write-only
|
||
|
long tv_vo 'vertical offset write-only
|
||
|
long tv_broadcast 'broadcast frequency (Hz) write-only
|
||
|
long tv_auralcog 'aural fm cog write-only
|
||
|
|
||
|
word screen[x_tiles * y_tiles] 'tilemap
|
||
|
long colors[64] 'farbregister
|
||
|
|
||
|
|
||
|
|
||
|
OBJ
|
||
|
tv : "bel-tv" 'located in default Library
|
||
|
gr : "bel-graphics-xor" 'located in default Library
|
||
|
mouse : "bel-mouse"
|
||
|
|
||
|
PUB main | x,y,rflag,k
|
||
|
|
||
|
init_subsystem
|
||
|
|
||
|
x := max_x/2
|
||
|
y := max_y/2
|
||
|
|
||
|
repeat
|
||
|
gr.clear
|
||
|
|
||
|
logo(max_x/2,max_y/2,0-cnt>>16,9,1)
|
||
|
logo(max_x/2,max_y/2,cnt>>14,17,2)
|
||
|
|
||
|
'mousefunctions
|
||
|
x += mouse.delta_x
|
||
|
y += mouse.delta_y
|
||
|
rflag := mouse.buttons
|
||
|
|
||
|
' scroller
|
||
|
gr.colorwidth(3, 8)
|
||
|
gr.textmode( 5, 5, 6, 0 )
|
||
|
gr.text( 500-(k & $7ff), 60, @text1 )
|
||
|
k += 2
|
||
|
|
||
|
gr.copy(display_base)
|
||
|
ifexit
|
||
|
|
||
|
PRI ifexit
|
||
|
|
||
|
if mouse.buttons == 2
|
||
|
reboot
|
||
|
|
||
|
DAT 'scrolltext
|
||
|
|
||
|
text1 byte "HIVE"
|
||
|
|
||
|
PRI logo(x,y,angle,radius,col)|x1,y1,x2,y2,x3,y3
|
||
|
|
||
|
gr.colorwidth(col, 10) 'lines
|
||
|
x1 := x + sin(angle)/(radius*100)
|
||
|
y1 := y + cos(angle)/(radius*100)
|
||
|
gr.plot(x1,y1)
|
||
|
x2 := x + sin(angle+2730)/(radius*100)
|
||
|
y2 := y + cos(angle+2730)/(radius*100)
|
||
|
gr.line(x2,y2)
|
||
|
x3 := x + sin(angle+5460)/(radius*100)
|
||
|
y3 := y + cos(angle+5460)/(radius*100)
|
||
|
gr.line(x3,y3)
|
||
|
gr.line(x1,y1)
|
||
|
|
||
|
gr.colorwidth(0, 15) 'black arcs
|
||
|
gr.arc(x1, y1, 9, 9, 0, $1fff/(arcstep-1), arcstep, 2)
|
||
|
gr.arc(x2, y2, 9, 9, 0, $1fff/(arcstep-1), arcstep, 2)
|
||
|
gr.arc(x3, y3, 9, 9, 0, $1fff/(arcstep-1), arcstep, 2)
|
||
|
|
||
|
gr.colorwidth(col, 5) 'colored arcs
|
||
|
gr.arc(x1, y1, 20, 20, 0, $1fff/(arcstep-1), arcstep, 2)
|
||
|
gr.arc(x2, y2, 20, 20, 0, $1fff/(arcstep-1), arcstep, 2)
|
||
|
gr.arc(x3, y3, 20, 20, 0, $1fff/(arcstep-1), arcstep, 2)
|
||
|
|
||
|
|
||
|
PRI kreis(x,y,angle,radius,col)|xc,yc
|
||
|
|
||
|
xc := x + sin(angle)/(radius*100)
|
||
|
yc := y + cos(angle)/(radius*100)
|
||
|
|
||
|
gr.colorwidth(0, 15)
|
||
|
gr.arc(xc, yc, 9, 9, 0, $1fff/(arcstep-1), arcstep, 2)
|
||
|
|
||
|
gr.colorwidth(col, 5)
|
||
|
gr.arc(xc, yc, 20, 20, 0, $1fff/(arcstep-1), arcstep, 2)
|
||
|
|
||
|
|
||
|
PRI logo2(x,y,a,c)
|
||
|
|
||
|
'draw objects
|
||
|
gr.colorwidth(c, 10)
|
||
|
gr.plot(x, y+25)
|
||
|
gr.line(x-29, y-25)
|
||
|
gr.line(x+29, y-25)
|
||
|
gr.line(x,y+25)
|
||
|
|
||
|
gr.colorwidth(0, 15)
|
||
|
gr.arc(x, y+25, 9, 9, 0, $1fff/(arcstep-1), arcstep, 2)
|
||
|
gr.arc(x-29, y-25, 9, 9, 0, $1fff/(arcstep-1), arcstep, 2)
|
||
|
gr.arc(x+29, y-25, 9, 9, 0, $1fff/(arcstep-1), arcstep, 2)
|
||
|
|
||
|
gr.colorwidth(c, 5)
|
||
|
gr.arc(x, y+25, 20, 20, 0, $1fff/(arcstep-1), arcstep, 2)
|
||
|
gr.arc(x-29, y-25, 20, 20, 0, $1fff/(arcstep-1), arcstep, 2)
|
||
|
gr.arc(x+29, y-25, 20, 20, 0, $1fff/(arcstep-1), arcstep, 2)
|
||
|
|
||
|
|
||
|
PRI init_subsystem | i,dx,dy
|
||
|
|
||
|
'tv-treiber starten
|
||
|
longmove(@tv_status, @tvparams, paramcount)
|
||
|
tv_screen := @screen
|
||
|
tv_colors := @colors
|
||
|
tv.start(@tv_status)
|
||
|
|
||
|
' farbtabelle setzen
|
||
|
' PPPP_M_LLL
|
||
|
' ---+ | --+
|
||
|
' | | +- 0..1 sync
|
||
|
' | | 2..6 helligkeit b/w
|
||
|
' | | 2..6 helligkeit col
|
||
|
' | | 7 -
|
||
|
' | +----- 0 - b/w
|
||
|
' | 1 - col
|
||
|
' +------- ntsc-palette (blau...grün..rot)
|
||
|
'
|
||
|
' b/w - 6 helligkeitsstufen 6
|
||
|
' col - 16color x 5 luma 64
|
||
|
' hsat - 16 highsat-farben 16
|
||
|
'
|
||
|
' $aa_bb_cc_dd
|
||
|
' $aa - color 3
|
||
|
' $bb - color 2
|
||
|
' $cc - color 1
|
||
|
' $dd - color 0 (hintergrund)
|
||
|
|
||
|
repeat i from 0 to 63
|
||
|
' colors[i] := %1010_1_101__0000_0_010__0010_1_111__0000_0_111
|
||
|
' colors[i] := %1010_1_101__0000_0_010__0010_1_111__0011_0_111
|
||
|
' colors[i] := c_hsat(3,0)+c_hsat(2,2)+c_hsat(1,6)+c_hsat(0,8) 'gesättigte farben
|
||
|
' colors[i] := c_bw(3,1)+c_bw(2,2)+c_bw(1,3)+c_bw(0,4) 'graustufen
|
||
|
' colors[i] := c_col(3,0,2)+c_col(2,3,2)+c_col(1,6,2)+c_col(0,9,2)
|
||
|
colors[i] := $00001010 * (i<<1+4) & $F + $0D060D02 'farbverlauf
|
||
|
|
||
|
'init tile screen
|
||
|
repeat dx from 0 to tv_hc - 1
|
||
|
repeat dy from 0 to tv_vc - 1
|
||
|
screen[dy * tv_hc + dx] := display_base >> 6 + dy + dx * tv_vc + ((dy & $3F) << 10)
|
||
|
|
||
|
'start and setup graphics
|
||
|
gr.start
|
||
|
gr.setup(tv_hc, tv_vc, 0, 0, bitmap_base)
|
||
|
|
||
|
'mouse
|
||
|
mouse.start(19, 18)
|
||
|
|
||
|
PUB set_tile_color(tilex, tiley, palette) | temp 'doug@opengeek.org
|
||
|
|
||
|
'The screen[] array contains both the tile HUB image data address, and an index into the color palette
|
||
|
'array, which can be defined as a DAT block, as done in this program, or as a VAR as done in the
|
||
|
'original
|
||
|
|
||
|
'The lower 10 bits are the HUB image address data (where the pixels are defined)
|
||
|
'The upper 6 bits point to sets of colors, contained in the colors[] array
|
||
|
|
||
|
temp := screen[tiley * tv_hc + tilex] 'get current screen tile value
|
||
|
temp := temp & %00000011_11111111 'clear color palette index value, leaving image address bits
|
||
|
temp := temp + (palette << 10) 'replace color palette index value with the new one
|
||
|
screen[tiley * tv_hc + tilex] := temp 'update the screen
|
||
|
|
||
|
|
||
|
PUB set_color_palette(palette_num, palette_colors) 'doug@opengeek.org
|
||
|
|
||
|
'only 64 palettes possible... (& %111111) insures no overwrite occurs on larger values
|
||
|
'the colors run like this in the long: 33_22_11_00, where 33 = color 3, 22 = color 2, etc...
|
||
|
'color 00 is the background color.
|
||
|
|
||
|
colors[palette_num & %111111] := palette_colors 'Write the colors into the colors[] array
|
||
|
|
||
|
PUB set_tile_address(tilex, tiley, HUB_address) | temp 'doug@opengeek.org
|
||
|
|
||
|
temp := screen[tiley * tv_hc + tilex] 'Get current screen tile value from screen[] array
|
||
|
temp := temp & %11111100_00000000 'Zero out the screen memory address pointer bits, leaving color bits
|
||
|
temp := temp + (HUB_address >> 6) 'Set screen memory pointer bits, from the most significant bits in the HUB
|
||
|
'address given. Tiles must be 64 byte aligned, due to how the TV driver
|
||
|
'decodes the screen array bits, 6 for color, 10 for screen pixel address in HUB
|
||
|
screen[tiley * tv_hc + tilex] := temp 'Update screen array for that tile, reflecting address change.
|
||
|
|
||
|
PUB get_tile_address(tilex, tiley) | temp 'doug@opengeek.org
|
||
|
|
||
|
temp := screen[tiley * tv_hc + tilex] 'Get current screen tile value from screen[] array
|
||
|
temp := temp & %00000011_11111111 'Zero out the color bits, leaving just the address
|
||
|
temp := temp << 6 'Shift to reflect effective HUB address. Tiles must
|
||
|
'be 64 byte aligned, due to how the TV driver
|
||
|
'decodes the screen array bits, 6 for color, 10 for
|
||
|
'screen pixel address in HUB
|
||
|
return temp 'return that address!
|
||
|
|
||
|
|
||
|
PRI c_hsat(bnr,cnr):col 'tool: erzeugt einen gesättigten farbwert
|
||
|
' bnr : bytenummer
|
||
|
' cnr : 0..15 farbnummer
|
||
|
col := (%0000_1_000 + (cnr<<4))<<(bnr*8)
|
||
|
|
||
|
PRI c_bw(bnr,cnr):col 'tool: erzeugt einen monochromwert
|
||
|
' bnr : bytenummer
|
||
|
' cnr : 0..5 graustufen
|
||
|
col := (%0000_0_000 + cnr+2)<<(bnr*8)
|
||
|
|
||
|
PRI c_col(bnr,chroma,lumi):col 'tool: erzeugt einen farbwert
|
||
|
' bnr : bytenummer
|
||
|
' croma : 0..15 chroma
|
||
|
' lumi : 0..5 luminanz
|
||
|
col := (%0000_1_000+(lumi+2)+(chroma<<4))<<(bnr*8)
|
||
|
|
||
|
PRI cos(angle) : x
|
||
|
x := sin(angle + $800)
|
||
|
|
||
|
PRI sin(angle) : y
|
||
|
'' Get sine of angle (0-8191)
|
||
|
y := angle << 1 & $FFE ' address
|
||
|
if angle & $800
|
||
|
y := word[$F000 - y]
|
||
|
else
|
||
|
y := word[$E000 + y]
|
||
|
if angle & $1000
|
||
|
-y
|
||
|
|
||
|
|
||
|
DAT 'tv-parameter
|
||
|
|
||
|
tvparams long 0 'status
|
||
|
long 1 'enable
|
||
|
long %010_0101 'pins New Board
|
||
|
long %0000 'mode
|
||
|
long 0 'screen
|
||
|
long 0 'colors
|
||
|
long x_tiles 'hc - horizontale tiles
|
||
|
long y_tiles 'vc - vertikale tiles
|
||
|
long 10 'hx
|
||
|
long 1 'vx
|
||
|
long 0 'ho
|
||
|
long 0 'vo
|
||
|
long 60_000_000 '_xinfreq<<4 'broadcast
|
||
|
long 0 'auralcog
|
||
|
|
||
|
DAT 'vektorobjekte
|
||
|
|
||
|
vecdef1 word $4000+$2000/3*0 'triangle
|
||
|
word 50
|
||
|
word $8000+$2000/3*1+1
|
||
|
word 50
|
||
|
word $8000+$2000/3*2-1
|
||
|
word 50
|
||
|
word $8000+$2000/3*0
|
||
|
word 50
|
||
|
word 0
|
||
|
|
||
|
vecdef2 word $4000+$2000/12*0 'star
|
||
|
word 50
|
||
|
word $8000+$2000/12*1
|
||
|
word 20
|
||
|
word $8000+$2000/12*2
|
||
|
word 50
|
||
|
word $8000+$2000/12*3
|
||
|
word 20
|
||
|
word $8000+$2000/12*4
|
||
|
word 50
|
||
|
word $8000+$2000/12*5
|
||
|
word 20
|
||
|
word $8000+$2000/12*6
|
||
|
word 50
|
||
|
word $8000+$2000/12*7
|
||
|
word 20
|
||
|
word $8000+$2000/12*8
|
||
|
word 50
|
||
|
word $8000+$2000/12*9
|
||
|
word 20
|
||
|
word $8000+$2000/12*10
|
||
|
word 50
|
||
|
word $8000+$2000/12*11
|
||
|
word 20
|
||
|
word $8000+$2000/12*0
|
||
|
word 50
|
||
|
word 0
|
||
|
|
||
|
vecdef3 word $4000+$2000/4*0 'box
|
||
|
word 50
|
||
|
word $8000+$2000/4*1
|
||
|
word 30
|
||
|
word $8000+$2000/4*2
|
||
|
word 50
|
||
|
word $8000+$2000/4*3
|
||
|
word 30
|
||
|
word $8000+$2000/4*0
|
||
|
word 50
|
||
|
word 0
|
||
|
|