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
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
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.
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
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 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.
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 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