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