Toolbox-1/source/bellatrix/6-mouse2.spin

263 lines
8.4 KiB
Plaintext
Raw Permalink Normal View History

2014-05-03 10:52:31 +02:00
{
}
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 = 15 'scale
d_obj = 64 'durchmesser
r_obj = d_obj/2 'radius
rotvar = 14 'rotationsvarianz
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" 'located in default Library
mouse : "bel-mouse"
PUB main | x,y,rot,dx,dy,j,i,mousex,mousey,rflag
init_subsystem
x := max_x/2
y := max_y/2
rot := 0
dx := 1
dy := 1
repeat
gr.clear
' koordinatenkreuz zeichnen
gr.colorwidth(2, 0)
gr.plot(x,192)
gr.line(x,0)
gr.plot(0,y)
gr.line(255,y)
'cursor zeichnen
gr.colorwidth(0, 15)
gr.plot(x,y)
gr.colorwidth(2, 1)
gr.plot(x-3,y-3)
gr.line(x,y)
gr.line(x+3,y-3)
x += mouse.delta_x
y += mouse.delta_y
rot += mouse.delta_z * 500
rflag := mouse.buttons
if rflag == 1
rot += 50
' koordinaten anzeigen
j := x
repeat i from 3 to 0
ifnot (j//10) < 0
kx[ i ] := ( j // 10 ) + "0"
j := j / 10
j := y
repeat i from 3 to 0
ifnot (j//10) < 0
ky[ i ] := ( j // 10 ) + "0"
j := j / 10
gr.colorwidth(2,0)
gr.text(5,5,@kx )
gr.copy(display_base)
ifexit
dat 'koordinatenstring
kx byte "0000"
byte ":"
ky byte "0000", 0
PRI ifexit
if mouse.buttons == 2
reboot
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)
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