Toolbox-1/source/bellatrix/11-logo1.spin

292 lines
11 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(x,y,0,3)
'mousefunctions
x += mouse.delta_x
y += mouse.delta_y
rflag := mouse.buttons
k++
gr.copy(display_base)
ifexit
PRI ifexit
if mouse.buttons == 2
reboot
PRI logo(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
'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