{ } 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 max_mx = 16 max_my = 16 max_matrix = max_mx * max_my mx_step = max_x / max_mx my_step = max_y / max_my 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 byte matrix[max_matrix] OBJ tv : "tv" 'located in default Library gr : "graphics_xor" 'located in default Library mouse : "mouse" PUB main | x,y,rflag,k,mx,my init_subsystem x := max_x/2 y := max_y/2 repeat gr.clear gr.colorwidth(3, 0) repeat mx from 0 to max_mx-1 gr.plot(0,mx * mx_step) gr.line(max_y,mx * mx_step) repeat my from 0 to max_my-1 gr.plot(my * my_step,0) gr.line(my * my_step,max_x) gr.colorwidth(2, 10) gr.plot(x,y) 'mousefunctions x += mouse.delta_x y += mouse.delta_y rflag := mouse.buttons gr.copy(display_base) 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