Bottom     Previous     Contents

Chapter Eight
Direct Screen Addressing and Hardware Scrolling

Direct screen addressing overview

Addressing screen locations directly has some advantages over using operating system subroutines such as OSWRCH. Faster and smoother moving graphics can be devised. The disadvantage of directly addressing screen locations (incompatibility with the Tube) has been emphasised before. When using direct screen addressing, the extra work involved in programming is considerable. The screen can no longer be considered as a convenient rectangle of plot points with X, Y coordinates. Instead, the screen is considered as a block of memory locations, laid out in a form similar to the screen layout map for MODE 2 shown in Fig. 8.1. In practice, the most commonly used mode for this method of programming is MODE 2 since the full sixteen colours are available to the user with a reasonably high resolution of 160*256 pixels. It is not practicable in a book of this size to discuss all MODES so direct screen addressing in this chapter will refer entirely to a MODE 2 screen.
The programs in this chapter should be helpful when writing games or educational material, particularly those which involve animation. They show how faster and smoother graphic displays appear when use is made of machine code routines called from BASIC.
In MODE 2, each screen memory location which is written to will light up two pixels. If we are happy with a minimum movement of two pixels at a time in an animated sequence then the whole process simplifies to shifting bytes around in the screen memory area shown in Fig. 8.1. Any of the sixteen colours can be selected for each pixel by setting appropriate bits within the byte written to screen memory. Figure 8.2 shows how this is done and the relationship to pixels lit on the screen.
Each pixel is represented by a nibble (4 bits) In a somewhat staggered format as shown. All that is needed is to set each nibble to the required colour code. These are the standard colour numbers as used in BASIC (0 to 15). If only one pixel is required to be lit then the other can be set to the relevant background colour, usuall all zeroes (default black). To reinforce the point, try the following simple routine and experiment with the value loaded into the accumulator in line 40.

10 MODE 2

20 P%=&0D00

30 [

40 LDA #7 \Load byte

50 STA &7FF0 \Light up pixel pair

60 RTS:]

70 CLS

80 CALLL &0D00

Fig. 8.1. The MODE 2 screen map

Fig. 8.2. How a MODE 2 screen byte is set up,

The routine lights up a red pixel to the left of a yellow pixel at the bottom right-hand corner of the screen. The byte loaded in line 40 consists of the code fored (1 binary) and the code for yellow (11 binary). These amalgamated in the form shown in Fig. 8.2 produce a byte 0000 0111.
As an example of how fast direct screen addressing can be, a screen fill routine is given in Program 8.1. This program sets the whole screen to red by writing a byte of 0000 0011 to each screen location. Blocks of 128 bytes are sent to the screen memory by indirect indexed addressing. The reason for this will become apparent later when we start to whip UFOs and things around the screen.

Program 8.1. Filling a colour screen.

10 REM FILLING A COLOUR SCREEN

20 REM DIRECT SCREEN LOCATIONS MODE 2

30 OSWRCH=&FFEE

40 LOC=&70

50 DIM START 256

60 FOR PASS=0 TO 2 STEP 2

70 P%=START

80 [OPT PASS

90 LDA #&16 \SET UP MODE 2

100 JSR OSWRCH

110 LDA #2

120 JSR OSWRCH

130 LDA #&00 \SET LOC TO SCREEN

140 STA LOC \START ADDRESS

150 LDA #&30 \(2 BYTES)

160 STA LOC+1

170 .BEGIN

180 LDA #3

190 LDY #&7F

200 .LOOP

210 STA (LOC),Y

220 DEY

230 BPL LOOP

240 CLC

250 LDA LOC \ADD 128 TO LOC

260 ADC #&80

270 STA LOC

280 BCC SKIP

290 INC LOC+1

300 .SKIP

310 CMP #&00 \COMPARE LOC TO END

320 BNE BEGIN \ADDRESS OF SCREEN

330 LDA LOC+1 \IF NOT THE SAME

340 CMP #&80 \BRANCH TO BEGIN

350 BNE BEGIN

360 RTS:]

370 NEXT PASS

380 CALL START

Colour animation by addressing direct screen locations

In this section, a simple animated sequence will be described which movesu 32 pixel red rectangle from the top to the bottom of the screen smoothh and without any perceptible flicker. The routine is artificially slowed down by waiting for the field synchronisation pulse. If this is not done the rectangle flies across the screen so fast that the TV system cannot reproduced it. This is not a problem in a large practical game, since many other objects will be moved in between. However, timing plays an important part in animation if pleasing results are to be obtained.
The labelled address LOC is set to the screen start address in MODE 2 which is &3000 taking 2 bytes of zero page memory. After waiting for the frame synchronisation pulse, the red rectangle is placed on the screen with indirect indexed addressing, scooping up the arbitrary 16 bytes necessary to form the image. Since in this case we want a red rectangle, the accumulator is set to &03. The image is then deleted in a similar manner but this time the accumulator contains the code for black (&00). The value 8 is then added to the location LOC to calculate the next image position. The reason for this is to move the image by two pixels to the right. Reference to the MODE 2 screen map in Fig. 8.1 will help here. After checking that the calculated position is still on the screen, the cycle is restarted. Program 8.2 shows how single colour objects can be moved over the screen.

Program 8.2. Single colour MOBs.

10 REM COLOUR ANIMATION BY ADDRESSING

20 REM DIRECT SCREEN LOCATIONS MODE 2

30 OSWRCH=&FFEE:OSBYTE=&FFF4

40 LOC=&70:COL=&72

50 DIM START 500

60 FOR PASS=0 TO 2 STEP 2

70 P%=START

80 [OPT PASS

90 LDA #&16 \SET UP MODE 2

100 JSR OSWRCH

110 LDA #2

120 JSR OSWRCH

130 LDA #&00 \SET LOC TO SCREEN

140 STA LOC \START ADDRESS

150 LDA #&30 \(2 BYTES)

160 STA LOC+1

170 .BEGIN

180 LDA #3 \SET BOTH PIXEL

190 STA COL \COLOURS TO RED.

200 JSR OBJECT

210 LDA #&13 \WAIT FOR FIELD SYNC

220 JSR OSBYTE

230 LDA #0 \SET BOTH PIXEL

240 STA COL \COLOURS TO BLACK

250 JSR OBJECT \(BACKGROUND COLOUR)

260 CLC

270 LDA LOC \ADD 8 TO LOC

280 ADC #&8

290 STA LOC

300 BCC SKIP

310 INC LOC+1

320 .SKIP

330 CMP #&00 \COMPARE LOC TO END

340 BNE BEGIN \ADDRESS OF SCREEN

350 LDA LOC+1 \IF NOT THE SAME

360 CMP #&80 \BRANCH TO BEGIN

370 BNE BEGIN

380 BEQ FINISH

390 .OBJECT \PLACE OBJECT ON

400 LDY #&0F \SCREEN (16 BYTES)

410 LDA COL \(32 PIXELS)

420 .LOOP

430 STA (LOC),Y

440 DEY

450 BPL LOOP

460 RTS

470 .FINISH

480 RTS:]

490 NEXT PASS

500 CALL START

Multi-colour MOBs

The use of user-defined characters has one drawback - only single colour characters can be defined. The standard way to get over this is overprinting with another character of chosen colour, thus building up the required multicolour object. This can be a time-consuming process even in assembly language. The problem does not arise with direct screen addressing. Program 8.3 shows the essential details.

Program 8.3. A UFO as an example of a multi-colour MOB.

10 REM MULTICOLOUR ANIMATION BY

20 REM ADDRESSING DIRECT SCREEN

30 REM LOCATIONS IN MODE2

40 GOTO140

50

60 DEFPROCdatatable(N)

70 FOR item=1 TO N

80 READ D$

90 D=EVAL(D$)

100 ?P%=D:P%=P%+1

110 NEXT item

120 ENDPROC

130

140 OSWRCH=&FFEE:OSBYTE=&FFF4

150 LOC=&70

160 DIM START 500

170 FOR PASS=0 TO 2 STEP 2

180 P%=START

190 RESTORE

200 [OPT PASS

210 LDA #&16 \SET UP MODE2

220 JSR OSWRCH

230 LDA #2

240 JSR OSWRCH

250 LDA #&00 \SET LOC TO SCREEN

260 STA LOC \START ADDRESS

270 LDA #&30 \(2 BYTES)

280 STA LOC+1

290

300 .BEGIN

310 LDY #&1F \PLACE OBJECT ON

320 .LOOP2 \SCREEN DEFINED

330 LDA data,Y \BY data

340 STA (LOC),Y

350 DEY

360 BPL LOOP2

370 LDA #&13 \WAIT FOR FIELD SYNC

380 JSR OSBYTE

390 LDA #0 \LENOBJECT ON

400 LDY #&1F \SCREEN BY BLANKING

410 .LOOP1 \IN BACKGROUND

420 STA (LOC),Y \COLOUR (BLACK)

430 DEY

440 BPL LOOP1

450 CLC

460 LDA LOC \ADD 8 TO LOC

470 ADC #&8

480 STA LOC

490 BCC SKIP

500 INC LOC+1

510 .SKIP

520 LDA LOC \COMPARE LOC TO END

530 BNE BEGIN \ADDRESS OF SCREEN

540 LDA LOC+1 \IF NOT THE SAME

550 CMP #&80 \BRANCH TO BEGIN

560 BNE BEGIN

570 BEQ FINISH

580

590 .data

600 ]PROCdatatable(32)

610 DATA 0,0,0,1,3,3,3,0,&40,1,3,3,9,3

,3,2,&80,2,3,3,6,3,3,1,0,0,0,2,3,3,3,0

620

630 [OPT PASS

640 .FINISH

650 RTS:]

660 NEXT PASS

670 CALL START

The program differs from the previous one in that a look-up table is used to form the object's colours. The data consists of 32 sequential bytes (64 pixels) which are 'looked up' in a method similar to that described in Chapter 7. Notice that this program is less complex, since only single byte data is handled by the BASIC procedure. Do not forget the even simpler method with BASIC II (or later versions) involving EQUS.
The object itself can be planned out on grid paper with up to 128 consecutive bytes, since BPL is used in the loop loading sequence.

Address coordinates

The method described previously is, by virtue of speed, preferred for small MOBs travelling in a horizontal direction. However, the movement in the Vertical direction leaves a lot to be desired. Movement by 8 pixels at a time is not very satisfactory! Furthermore, the height of the MOB is restricted to 8 pixels. The standard method of overcoming these problems is to employ a routine which translates address coordinates (80*256) to absolute screen addresses so that discontinuities in the memory map in the X and Y directions are avoided. The MOl)E 2 screen map consists of a matrix of 80 bytes (2 pixels a byte) in the X direction and 256 bytes in the Y direction making 80*256=20K bytes in all. If we are satisfied with two-pixel movement in the horizontal direction as before, the concept of address coordinates can be envisaged. The screen memory map given earlier is set out in blocks of eight seqnential addresses. The difference between equivalent positions in any adjacent block of 8 in the Y direction is &280 or 640 decimal. Similarly in the X direction the difference is 8. Therefore the equation to calculate a unique screen address from an XY address coordinate is given by:

Screen address = &3000 + 8X + 640(Y DIV 8) + (Y MOD 8)

where, &3000 is the screen start address; 8X is the X contribution because there are 8 address locations difference between adjacent X coordinates, 640(Y DIV 8) specifies the block of eight containing the Y coordinate; and Y MOD 8 specifies the position in that block of 8. The above equation is not suited to machine coding in its present form. We need to rearrange the equation so that all multipliers are, as far as possible. in exact powers of 2. Any multiplication or division then simplified to shifting bits left or right respectively. This can be conveniently achieved as follows:

&3000 + 8X + 640(Y DIV 8) + (Y MOD 8) &3000 + 8X + 80(8(Y DIV 8)) + (Y MOD 8)
Let Y1=8(Y DIV 8
= &3000 + 8X + 80Y1 + (Y MOD 8
= &3000 + 8X + 16Y1 + 64Y1 + (Y MOD 8)

The coding of the above is now relatively easy. All (Y DIV 8) means is shift Y right 3 times, thus losing the 3 least significant bits. Multiplying by 8, giving 8(Y DIV 8), is then achieved by shifting the result left 3 times. The net result of all this is just to jose the 3 least significant bits. They have fallen off the end.
A simpler way of arriving at the same result is to mask out the 3 least significant bits of Y with AND#&FE. Similarly, all (Y MOD8) means is to recover the bits we lost in the previous operation by masking out the 5 most significant bits of Y with AND #&7. The expression 8X is achieved by shifting X left 3 times. Two bytes will be required to accommodate the result on the last two shifts.
The 64Y1 expression can be arrived at by shifting Y1 left six times. However, if you can imagine a two-byte result, shifting Y1 right twice and storing it as the high-byte of the result will be the exact equivalent. The low-byte of the result can be set to all zeros.
Two further shifts rrght of the 64Y1 result will divide by 4, giving 16Y1. However, we must rotate the carry into the low-byte of the result on the last shift right. The LSR and ROR instructions, respectively, are needed.
Adding the whole lot together gives the required screen address. Program 8.4 (lines 1080 to 1380) shows one way of coding the above.

Program 8.4. Moving more than one shape.

10 REM MOVING MULTICOLOURED OBJECTS

20 REM AN IMPROVED METHOD FOR MODE 2

30 REM USING 80*256 BYTE COORDINATES

40 GOTO140

50

60 DEF FNdatatable(N)

70 FOR item=1 TO N

80 READ D$

90 D=EVAL("&"+D$)

100 ?P%=D:P%=P%+1

110 NEXT item

120 =PASS

130

140 OSWRCH=&FFEE:OSBYTE=&FFF4

150 XCOORD=&70:YCOORD=&71:width=&72:he

ight=&73:wcount=&74:LOC=&75

160 STORE=&77:data=&79:Yreg=&7B

170 table1=&7C:table2=&7E

180 XCOORD1=&80:YCOORD1=&81

190 XCOORD2=&82:YCOORD2=&83

200 DIM START 1000

210 FOR PASS=0 TO 2 STEP 2

220 P%=START

230 RESTORE

240 [OPT PASS

250

260 LDA #&16 \SET UP MODE2

270 JSR OSWRCH

280 LDA #2

290 JSR OSWRCH

300 LDA #(shape1 MOD 256) \STORE SHAPE

310 STA table1 \TABLE

320 LDA #(shape1 DIV 256) \ADDRESSES

330 STA table1+1

340 LDA #(shape2 MOD 256)

350 STA table2

360 LDA #(shape2 DIV 256)

370 STA table2+1

380 LDA #0

390 STA XCOORD1 \INITIALISE BYTE

400 STA YCOORD1 \COORDINATES OF

410 LDA #34 \SHAPES

420 STA XCOORD2

430 LDA #200

440 STA YCOORD2

450

460 .LOOP

470 INC XCOORD1 \UPDATE OF SHAPE

480 INC YCOORD1 \COORDINATES

490 DEC YCOORD2

500 JSR SCREEN

510 LDA YCOORD2

520 CMP #80

530 BNE LOOP

540 BEQ START

550

560 .SCREEN

570 LDA table1 \STORE ADDRESS OF

580 STA data \FIRST SHAPE TABLE

590 LDA table1+1 \IN data

600 STA data+1

610 LDA #&13 \WAIT FOR FIELD SYNC

620 JSR OSBYTE

630 LDX XCOORD1 \CALL draw SUBROUT'E

640 LDY YCOORD1 \WITH PARAMETERS IN

650 JSR draw \X AND Y REG'S

660 LDA table2

670 STA data \STORE ADDRESS OF

680 LDA table2+1 \SECOND SHAPE TABLE

690 STA data+1

700 LDX XCOORD2

710 LDY YCOORD2 \CALL draw SUBROUT'E

720 JSR draw

730 RTS

740

750 .draw

760 STX XCOORD \STORE PARAMETERS

770 STY YCOORD \PASSED

780 LDY #0

790 LDA (data),Y \STORE SHAPE'S

800 STA height \HEIGHT AND WIDTH

810 INY \PARAMETERS OBTAINED

820 LDA (data),Y \FROM DATA TABLE

830 STA width

840 LDX #2 \X SAVES Y (TEMP)

850 .newrow

860 LDA #0 \CLEAR Yreg STORE

870 STA Yreg

880 LDA width \RELOAD wcount

890 STA wcount

900 JSR CALCADDRESS \CALC SCREEN ADDr

910 .newcolumn

920 TXA \TRANSFER X TO Y

930 TAY

940 LDA (data),Y \PLACE ROWS OF DATA

950 LDY Yreg \INTO SCREEN

960 STA (LOC),Y \MEMORY UNTIL

970 TYA \SHAPE IS COMPLETED

980 ADC #8

990 STA Yreg \Yreg ENDIFS Y (TEMP)

1000 INX

1010 DEC wcount

1020 BNE newcolumn

1030 INC YCOORD

1040 DEC height

1050 BNE newrow

1060 RTS

1070

1080 .CALCADDRESS

1090 LDA #0 \CLEAR LOCATIONS

1100 STA STORE+1

1110 STA LOC

1120 LDA XCOORD \CALC. 8*X

1130 ASL A

1140 ASL A

1150 ROL STORE+1

1160 ASL A

1170 ROL STORE+1

1180 STA STORE

1190 LDA YCOORD \CALC Y1=8*(YDIV8)

1200 AND #&F8

1210 LSR A \CALC 64*Y1

1220 LSR A

1230 STA LOC+1

1240 LSR A \CALC 16*Y1

1250 LSR A

1260 ROR LOC \also clears carry

1270 ADC LOC+1 \CALC 80*Y1

1280 TAY

1290 LDA YCOORD

1300 AND #7 \CALC Y MOD 8

1310 ADC LOC

1320 ADC STORE \CALCULATE

1330 STA LOC \CUMMULATIVE RESULT

1340 TYA \FOR SCREEN ADDRESS

1350 ADC STORE+1

1360 ADC #&30

1370 STA LOC+1

1380 RTS

1390

1400 .shape1

1410 OPT FNdatatable(86)

1420 .shape2

1430 OPT FNdatatable(62)

1440 RTS:]

1450 NEXT PASS

1460 CALL START

1470

1480 REM THIS IS THE shape1 DATA

1490 DATA E,6

1500 DATA 0,0,0,0,0,0

1510 DATA 0,0,0,0,0,0

1520 DATA 0,0,4F,8F,0,0

1530 DATA 0,0,1,2,0,0

1540 DATA 0,0,1,2,0,0

1550 DATA 0,0,3,3,0,0

1560 DATA 0,1,3,3,2,0

1570 DATA 0,3,9,6,3,0

1580 DATA 0,3,3,3,3,0

1590 DATA 0,3,3,3,3,0

1600 DATA 0,3,3,3,3,0

1610 DATA 0,0,2,1,0,0

1620 DATA 0,0,0,0,0,0

1630 DATA 0,0,0,0,0,0

1640

1650 REM THIS IS THE shape2 DATA

1660 DATA A,6

1670 DATA 0,0,0,0,0,0

1680 DATA 0,0,0,0,0,0

1690 DATA 0,0,1,2,0,0

1700 DATA 0,0,3,3,0,0

1710 DATA 0,1,3,3,2,0

1720 DATA 0,3,9,6,3,0

1730 DATA 0,3,3,3,3,0

1740 DATA 0,0,2,1,0,0

1750 DATA 0,0,0,0,0,0

1760 DATA 0,0,0,0,0,0

Moving more than one shape

The above program independently moves two shapes on the screen by accessing two separate data tables with a common draw routine. The shapes are built up, a data byte at a time, by the subroutine 'draw'. This subroutine constructs a shape in a row by row fashion until completely drawn. The shape's height and width in bytes must be first read in from the data table. Line 1490 contains this data. The subroutine places the requested shape on the screen by invoking the CALCADDRESS routine prim to placing each data byte of a new row into screen memory. There in no need to call CALCADDRESS for adjacent bytes in a row since simply adding 8 to the previous address gives the address of the next byte in the row. Two loops are needed for this and the routine is given in lines 750 In 1060. The relevant data tables are at the foot of the program but note yet another way of incorporating data into a machine code program. The statement has FNdatable(86) following it. Providing the datatable function returns PASS, all BASIC lines in the function are executed without 'officially' leaving the assembler.
A border of background colour, one byte wide in the horizontal and two bytes in the vertical direction is useful. This ensures that all the bits and pieces remaining from the last drawn position are automatically erased which ever direction the shape is moving. On initialisation, the addresses of the supplied shape tabjes must be stored so that the subroutine SCREEN can specify which shape to draw. The X and Y address coordinates are then passed over to the draw subroutine in the X and Y registers respectively. Lines 560 to 730 are responsible for this. Lines 460 to 540 complete the program by incrementing the various coordinates of shape1 and shape2 to update the next drawing positions. The overall structure of the program is such that more shapes can easily be added.
A study of Program 8.4 (and its remarks) will reveal a few of the essential techniques for producing action video games.

Hardware scrolling by programming the 6845 CRTC

Hardware scrolling has many uses but ones that immediately spring to mind are applications such as word processing and producing moving landscapes in games programs.
The 6845 CRTC controller has eighteen internal registers of which only two are of interest to us in this chapter. These are registers 12 and 13 which together, high-byte and low-byte respectively, are known as the Displayed Screen Start Address Register. By re-specifying the displayed screen start address, we can scroll in any direction (wrap around) as long as the register contains a 'legal' screen memory location for the particular MODE used. The software must ensure that this does not happen or some unpredictable results will occur! In MODES 0, 1, 2, 3 the 6845 CRTC controller generates 80 characters a line where as in MODES 4, 5, 6 there are 40. These are not characters as seen on the screen, however. In MODE 2, for instance, a (CRTC character is only a quarter of a displayed character. The CRTC, then, sees a MODE 2 screen as 80*32=&0A00 characters. It is important to remember that the screen address, sent to the displayed screen start register, must be the actual screen memory location divided by 8. This arises from the CRTC dealing with characters consisting of 256/32=8 output scan lines in MODE 2. From now on we will be concentrating exclusively on MODE 2 graphics screens for the reasons outlined at the beginning of the chapter. There is an added advantage in that each CRTC character sideways scroll represents only two pixels' displacement, producing a very smooth movement.

Sideways scrolling

To scroll the screen one CRTC characten to the left, the screen start address register must be incremented. Decrementing the register on the other hand, will scroll the screen one character to the right. There are two ways of achieving this in assembly langunge. The first is to use the assembler equivalent of the BASIC VDU 23 command; the other is to address directly the memory-mapped area SHEILA (256 bytes starting from &FE00). Incidentally, all the BBC Micro's internal hardware registers are accessible at these locations.
First, the operating system subroutine method will be described. The necessary VDU 23 commands to enable sideways scrolling are as follows, if SCR is the screen address low-byte and SCR+1 is the high-byte:

VDU 23;12,SCR;0;0;0

VDU 23;13,SCR+1;0;0;0

Only the first of the two lines above is necessary if the screen is to be sideways scrolled left by less than 256 characters since the actual screen start address in MODE 2 is &3000. The equivalent address. as required by displayed screen start address register, is &3000/8=&0600. Thus, SCR+1 will be constant at &06 for 256 bytes or scrolls. The VDU 23 commands can be conveniently coded in assembly language by our macro developed in Chapter 7 along with a simple test graphics screen. Program 8.5 shows this method, the object being to create a continuous sideways scroll to the left.

Program 8.5. Continuous sideways scrolling using operating system subroutines.

10 REM SIDEWAYS SCROLLING USING THE

20 REM OPERATING SYSTEM SUBROUTINES

30 GOTO240

40

50 DEFPROCvdu(N)

60 LOCAL D,D$,B,byte,item,lbyte

70 FOR item=1 TO N

80 READ D$

90 IF RIGHT$(D$,1)="@" THEN B=2 ELSE

B=1

100 D=EVAL(D$)

110 IF ASC(D$)>64 THEN [OPT PASS:LDA D

:JSR OSWRCH:]:GOTO150

120 IF D<0 THEN D=(ABS(D) EOR &FFFF)+1

130 byte=D MOD 256:PROCform

140 IF B=2 THEN byte=D DIV 256:PROCfor

m

150 NEXT item

160 ENDPROC

170

180 DEFPROCform

190 IF byte<>lbyte THEN [OPT PASS:LDA

#byte:]

200 [OPT PASS:JSR OSWRCH:]

210 lbyte=byte

220 ENDPROC

230

240 OSWRCH=&FFEE:OSBYTE=&FFF4

250 SCR=&70

260 DIM START 1000

270 FOR PASS=0 TO 3 STEP 3

280 P%=START

290 RESTORE

300 PROCvdu(29)

310 REM SET UP TEST GRAPHICS SCREEN

320 DATA 22,2,18,0,132,16,18,0,3,25,4,

500@,500@,25,1,200@,0@,25,81,0@,-200@,25

,1,-200@,0@,25,81,0@,200@

330

340 [OPT PASS

350 .BEGIN

360 LDA #&00 \SET SCR (2 BYTES) TO

370 STA SCR \SCREEN START ADDRESS

380 LDA #&06 \AS SEEN BY THE CRTC

390 STA SCR+1

400 .SCROLL

410 LDA #&13 \WAIT FOR FIELD SYNC

420 JSR OSBYTE

430 ]

440 PROCvdu(7)

450 [OPT PASS

460 LDA SCR

470 BNE OVER

480 ]PROCvdu(7)

490 [OPTPASS

500 .OVER

510 INC SCR \INCREMENT SCR

520 BNE SKIP \(2 BYTES)

530 INC SCR+1

540 .SKIP

550 LDA SCR \CHECK IF SCREEN END

560 BNE SCROLL \ADDRESS AS SEEN BY

570 LDA SCR+1 \CRTC IS EXCEEDED

580 CMP #&10 \(MEM DIV 8)

590 BNE SCROLL

600 BEQ BEGIN \IF SO RESTART CYCLE

610 RTS:]

620 NEXT PASS

630 CALL START

640

650 REM DATA TO SET UP 6845 CRTC REG'S

660 DATA 23@,13,SCR,0,0@,0@,0

670 DATA 23@,12,SCR+1,0,0@,0@,0

When executed the first thing to nolice is that, when an object scrolls off the left-hand side of the screen, it will appear a character line higher at the right-hand side. The exception is at the top left of the screen where it will reappear at the bottom right. To achieve a true sideways scroll, all the 'current' bytes on the right-hand side of the screen will need to be moved down a character line in memory (wrap around). We say 'current', because the screen addresses corresponding to any fixe position on the screen will change as each hardware scroll is executed. Another option is continuously to generate a landscape strip a byte wide at the current memory locations corresponding to the screen's extreme right-hand side, thus overprinting the above results. All this, however, will be regarded as an exercise. Experimenting with the programs can be a help here by placing markers at various known addresses and watching their progressions on the screen when scrolled. For example, the following could be inserted into Program 8.5:

LDA #3 \red marker (one byte wide)

STA &3000\at default screen addr.

An annoying flash occasionally occurs when register 12 is updated every 256 scrolls. This is due to the time lag in setting register 12 after register 13 or vice versa. Even waiting for the field synchronisation pulse has little effect on this. The problem can be overcome by directly addressing the 6845 CRTC. The corresponding routine is shown in Program 8.6.

Program 8.6. Sideways scrolling by directly addressing SHEILA locations.

10 REM PROGRAMMING THE 6845 CRTC

20 REM SIDEWAYS SCROLLING BY DIRECTLY

30 REM ADDRESSING SHEILA LOCATIONS

40 GOTO250

50

60 DEFPROCvdu(N)

70 LOCAL D,D$,B,byte,item,lbyte

80 FOR item=1 TO N

90 READ D$

100 IF RIGHT$(D$,1)="@" THEN B=2 ELSE

B=1

110 D=EVAL(D$)

120 IF ASC(D$)>64 THEN [OPT PASS:LDA D

:JSR OSWRCH:]:GOTO160

130 IF D<0 THEN D=(ABS(D) EOR &FFFF)+1

140 byte=D MOD 256:PROCform

150 IF B=2 THEN byte=D DIV 256:PROCfor

m

160 NEXT item

170 ENDPROC

180

190 DEFPROCform

200 IF byte<>lbyte THEN [OPT PASS:LDA

#byte:]

210 [OPT PASS:JSR OSWRCH:]

220 lbyte=byte

230 ENDPROC

240

250 OSWRCH=&FFEE:OSBYTE=&FFF4

260 SCR=&70

270 DIM START 1000

280 FOR PASS=0 TO 3 STEP 3

290 P%=START

300 RESTORE

310

320 REM SET UP TEST GRAPHICS SCREEN

330 PROCvdu(29)

340 DATA 22,2,18,0,132,16,18,0,3,25,4,

500@,500@,25,1,200@,0@,25,81,0@,-200@,25

,1,-200@,0@,25,81,0@,200@

350

360 [OPT PASS

370 .BEGIN

380 LDA #&00 \SET SCR (2 BYTES) TO

390 STA SCR \SCREEN START ADDRESS

400 LDA #&06 \AS SEEN BY THE CRTC

410 STA SCR+1

420 .SCROLL

430 LDA #&13 \WAIT FOR FIELD SYNC

440 JSR OSBYTE

450 LDA #&0D \SEND (R13) ADDRESS

460 STA &FE00 \TO ADDRESS REGISTER

470 LDA SCR

480 STA &FE01 \SEND SCR TO (R13)

490 BNE OVER

500 LDA #&0C

510 STA &FE00 \SEND (R12) ADDRESS

520 LDA SCR+1

530 STA &FE01 \SEND SCR+1 TO (R12)

540 .OVER

550 INC SCR

560 BNE SKIP \INCREMENT SCR

570 INC SCR+1 \(2 BYTES)

580 .SKIP

590 LDA SCR \CHECK IF SCREEN END

600 BNE SCROLL \ADDRESS AS SEEN BY

610 LDA SCR+1 \CRTC IS EXCEEDED

620 CMP #&10 \(MEM DIV 8)

630 BNE SCROLL

640 BEQ BEGIN \IF SO RESTART CYCLE

650 RTS:]

660 NEXT PASS

670 CALL START

The 6845 CRTC registers can be accessed directly by storing the required register address (or number) in the 6845 address register at SHEILA location &00 (that is, &FE00). The selected register can then be read from or written to at SHEILA address &01. This is fairly straightforward and details are documented on the listing.

Vertical scrolling

Vertical scrolling involves no new principles other than adding 80 each time, the number of 6845 CRTC characters in a line, to the current screen start address. The listing is shown in Program 8.7 with the necessary details. Notice that, in this case. the high-byte of the screen start address register is set each time within the loop since the extra code needed to bypass it would be counter-productive.

Program 8.7. Vertical scrolling of a MODE 2 graphics screen

10 REM PROGRAMMING THE 6845 CRTC

20 REM VERTICAL SCROLLING BY DIRECTLY

30 REM ADDRESSING SHEILA LOCATIONS

40 GOTO250

50

60 DEFPROCvdu(N)

70 LOCAL D,D$,B,byte,item,lbyte

80 FOR item=1 TO N

90 READ D$

100 IF RIGHT$(D$,1)="@" THEN B=2 ELSE

B=1

110 D=EVAL(D$)

120 IF ASC(D$)>64 THEN [OPT PASS:LDA D

:JSR OSWRCH:]:GOTO160

130 IF D<0 THEN D=(ABS(D) EOR &FFFF)+1

140 byte=D MOD 256:PROCform

150 IF B=2 THEN byte=D DIV 256:PROCfor

m

160 NEXT item

170 ENDPROC

180

190 DEFPROCform

200 IF byte<>lbyte THEN [OPT PASS:LDA

#byte:]

210 [OPT PASS:JSR OSWRCH:]

220 lbyte=byte

230 ENDPROC

240

250 OSWRCH=&FFEE:OSBYTE=&FFF4

260 SCR=&70

270 DIM START 1000

280 FOR PASS=0 TO 3 STEP 3

290 P%=START

300 RESTORE

310

320 REM SET UP TEST GRAPHICS SCREEN

330 PROCvdu(29)

340 DATA 22,2,18,0,132,16,18,0,3,25,4,

500@,500@,25,1,200@,0@,25,81,0@,-200@,25

,1,-200@,0@,25,81,0@,200@

350

360 [OPT PASS

370 .BEGIN

380 LDA #&00 \SET SCR (2 BYTES) TO

390 STA SCR \SCREEN START ADDRESS

400 LDA #&06 \AS SEEN BY THE CRTC

410 STA SCR+1

420 .SCROLL

430 LDA #&13 \WAIT FOR FIELD SYNC

440 JSR OSBYTE

450 LDA #&0D \SEND (R13) ADDRESS

460 STA &FE00 \TO ADDRESS REGISTER

470 LDA SCR

480 STA &FE01 \SEND SCR TO (R13)

490 LDA #&0C

500 STA &FE00 \SEND (R12) ADDRESS

510 LDA SCR+1

520 STA &FE01 \SEND SCR+1 TO (R12)

530 CLC

540 LDA SCR \ADD 80 CHARACTER

550 ADC #&50 \POSITIONS AS SEEN BY

560 STA SCR \CRTC(2 BYTES)

570 BCC SKIP

580 INC SCR+1

590 .SKIP

600 LDA SCR \CHECK IF SCREEN END

610 BNE SCROLL \ADDRESS AS SEEN BY

620 LDA SCR+1 \CRTC IS EXCEEDED

630 CMP #&10 \(MEM DIV 8)

640 BNE SCROLL

650 BEQ BEGIN \IF SO RESTART CYCLE

660 RTS:]

670 NEXT PASS

680 CALL START

Summary

  1. Machine code graphics can be smoother and faster if direct screen addressing is used.
  2. Mode 2 is popular for coloured graphics because of the 16 variations.
  3. In Mode 2, each screen memory location handles two pixels.
  4. Movement of objects on the screen can be reduced to shifting bytes around in memory. This allows a dynamic resolution of two pixels per byte in Mode 2.
  5. The bit pattern within the byte determines the pixel colour.
  6. Each pixel within the byte occupies 4 bits (a nibble) so a single pixel blob of colour is achieved by setting the other nibble to background colour.
  7. Mode 2 screen locations extend from &3000 (top left) to &7FFF (bottom right).
  8. Direct screen addressing is often fast enough to beat the field synchronisation pulses so a 'wait until pulse' trap is often required
  9. Moving multicolour objects (MOBs), can be programmed by userdefined characters but overprinting with another colour is timeconsuming and causes flickering. This problem does not arise with direct screen addressing.
  10. MOB colours can be achieved by look-up tabies.
  11. Hardware scrolling can be achieved by direct action on the 6845 CRTC controller. Registers 12 and 13 in the controller contain the start address of the displayed screen. They are within the SHEILA address band.
  12. Sideways scrolling to the left can be achieved by incrementing, and to the right by decrementing, the start address register.
  13. Vertical scrolling is achieved by adding 80 to, or subtracting 80 from, the start address register. This is because there are 80 CRTC characters per line in Mode 2.

Self test

  1. Adapt Program 8.5 to scroll the screen to the right.
  2. Adapt Program 8.7 to scroll the screen downwards.
  3. Adapt Program 8.4 to move three MOBs independently.
  4. Design a MOB of your own which traverses the screen horizontally.

Next     Top