1program SimpleBGScroll; 2 3{$mode objfpc} 4{$H+} 5 6uses 7 ctypes, gba; 8 9{$l build\r6502_portfont.bin.o} 10 11{$include inc\r6502_portfont.bin.inc} 12 13var 14 MAPADDRESS: pcuint16; 15 16const 17 DELAY = 2; // slow things down 18 TILEWIDTH = 8; // how much to scroll 19 ROW = 10; // what row to place text at 20 21// -------------------------------------------------------------------- 22 23var 24 palette: array [0..6] of cuint16; 25 26// -------------------------------------------------------------------- 27 28const 29 message = ' ' + 30 'Hello, this is an example of an oldschool simple tile scroller ' + 31 'not unlike how it was done in days of yore. The ''@'' symbol ' + 32 'at the top of your screen is intentional, to dispel the illusion ' + 33 'of this scroller, to demonstrate the simple concept behind it. ' + 34 'Check out the source to learn how it works. It is very simple! ' + 35 'This exercise brought to you by r6502... ' + 36 'Text is about to restart... '; 37 38 39 40procedure updatescrolltext(idx: cuint32); 41var 42 i: integer; 43 temppointer: pcuint16; 44begin 45 temppointer := pcuint16(MAPADDRESS + (ROW * 32)); 46 47 // write out a whole row of text to the map 48 for i := 0 to 31 do 49 begin 50 // check for end of message so we can wrap around properly 51 if (message[idx] = #0) then 52 idx := 0; 53 54 // write a character - we subtract 32, because the font graphics 55 // start at tile 0, but our text is in ascii (starting at 32 and up) 56 // in other words, tile 0 is a space in our font, but in ascii a 57 // space is 32 so we must account for that difference between the two. 58 temppointer^ := Ord(message[idx]) - 32; 59 inc(temppointer); 60 inc(idx); 61 end; 62end; 63 64 65var 66 i, scrollx, scrolldelay, textindex: integer; 67 temppointer: pcuint16; 68 69begin 70 MAPADDRESS := MAP_BASE_ADR(31); // our base map address 71 72 palette[0] := RGB8($40,$80,$c0); 73 palette[1] := RGB8($FF,$FF,$FF); 74 palette[2] := RGB8($F5,$FF,$FF); 75 palette[3] := RGB8($DF,$FF,$F2); 76 palette[4] := RGB8($CA,$FF,$E2); 77 palette[5] := RGB8($B7,$FD,$D8); 78 palette[6] := RGB8($2C,$4F,$8B); 79 80 // Set up the interrupt handlers 81 irqInit(); 82 // Enable Vblank Interrupt to allow VblankIntrWait 83 irqEnable(IRQ_VBLANK); 84 85 // Allow Interrupts 86 REG_IME^ := 1; 87 88 // load the palette for the background, 7 colors 89 temppointer := BG_COLORS; 90 91 for i := 0 to 6 do 92 begin 93 temppointer^ := cuint32(palette[i]); // u32 cast avoids u8 memory writing 94 inc(temppointer); 95 end; 96 97 // load the font into gba video mem (48 characters, 4bit tiles) 98 99 CpuFastSet(@r6502_portfont_bin, pcuint16(VRAM), (r6502_portfont_bin_size div 4) or COPY32); 100 101 // clear screen map with tile 0 ('space' tile) (256x256 halfwords) 102 103 //MAP_BASE_ADR(31) := nil; 104 CpuFastSet( MAP_BASE_ADR(31), MAP_BASE_ADR(31), FILL or COPY32 or ($800 div 4)); 105 106 // set screen H and V scroll positions 107 BG_OFFSET[0].x := 0; 108 BG_OFFSET[0].y := 0; 109 110 // initialize our variables 111 scrollx := 0; 112 textindex := 0; 113 scrolldelay := 0; 114 115 // put the '@' symbol on the top of the screen to show how 116 // the screen is only scrolling 7 pixels - to reveal the 117 // illusion of how the scroller works 118 pcuint16((MAPADDRESS + 1))^ := $20; // 0x20 == '@' 119 120 // draw a row of text from beginning of message 121 updatescrolltext(0); 122 123 // set the screen base to 31 (0x600F800) and char base to 0 (0x6000000) 124 BGCTRL[0] := SCREEN_BASE(31); 125 126 // screen mode & background to display 127 SetMode( MODE_0 or BG0_ON ); 128 129 while true do 130 begin 131 VBlankIntrWait(); 132 133 // check if we reached our delay 134 if (scrolldelay = DELAY) then 135 begin 136 // yes, the delay is complete, so let's reset it 137 scrolldelay := 0; 138 139 // check if we reached our scrollcount 140 if (scrollx = (TILEWIDTH-1)) then 141 begin 142 // yes, we've scrolled enough, so let's reset the count 143 scrollx := 0; 144 145 // check if we reached the end of our scrolltext 146 // and if so we need to restart our index 147 if (message[textindex] = #0) then 148 textindex := 0 149 else 150 inc(textindex); 151 152 // finally, let's update the scrolltext with the current text index 153 updatescrolltext(textindex); 154 end else 155 inc(scrollx); 156 end else 157 inc(scrolldelay); 158 159 // update the hardware horizontal scroll register 160 BG_OFFSET[0].x := scrollx; 161 end; 162end. 163 164