{ } 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 long x,y,x1,y1,dx1,dy1,j,mousex,mousey,rflag,k,speed,distx,disty,distx2,disty2,dx2,dy2,x2,y2 OBJ tv : "bel-tv" 'located in default Library gr : "bel-graphics" 'located in default Library mouse : "bel-mouse" PUB main init_subsystem x := x1 := x2 := max_x/2 y := y1 := y2 := max_y/2 dx1 := dx2 := 0 dy1 := dx2 := 0 speed := 3 repeat gr.clear 'draw objects gr.textmode( 3, 3, 6, 0 ) 'cursor gr.colorwidth(2, 0) gr.arc(x, y, 3, 3, 0, $1fff/(arcstep-1), arcstep, 2) ' 1. kugel gr.colorwidth(1, 1) gr.arc(x1, y1, 5, 5, 0, $1fff/(arcstep-1), arcstep, 2) gr.colorwidth(2, 0) gr.plot(x,y) gr.line(x1,y1) ' 2. kugel gr.colorwidth(1, 2) gr.arc(x2, y2, 8, 8, 0, $1fff/(arcstep-1), arcstep, 2) gr.colorwidth(2, 0) gr.plot(x1,y1) gr.line(x2,y2) 'rubberband distx := x - x1 disty := y - y1 distx2 := x1 - x2 disty2 := y1 - y2 if k == speed k~ if distx > 0 dx1 := dx1+2 else 'if distx < 0 dx1 := dx1-2 if disty > 0 dy1 := dy1+2 else 'if disty < 0 dy1 := dy1-2 x1 := x1 + dx1 y1 := y1 + dy1 if distx2 > 0 dx2 := dx2+2 else 'if distx < 0 dx2 := dx2-2 if disty2 > 0 dy2 := dy2+2 else 'if disty < 0 dy2 := dy2-2 x2 := x2 + dx2 y2 := y2 + dy2 if mouse.buttons == 1 x1 := x1 + distx/40 y1 := y1 + disty/40 x2 := x2 + distx2/40 y2 := y2 + disty2/40 'mousefunctions x += mouse.delta_x y += mouse.delta_y k++ gr.copy(display_base) ifexit 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) : cosval cosval := sin(angle + $800) PRI sin(angle) : sinval '' Get sine of angle (0-8191) sinval := angle << 1 & $FFE ' address if angle & $800 sinval := word[$F000 - sinval] else sinval := word[$E000 + sinval] if angle & $1000 -sinval 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