The maximum number of colours that you can have on screen at any one time on the Archimedes is 256. But by using a technique known as dithering, it is possible to increase that number to a staggering 32,000. Essentially, dithering involves mixing two or more colours on a pixel by pixel basis so that the eye perceives a single colour.
The program in listing 1 contains a procedure called PROCdither, which takes as parameters a pair of colour and tint numbers, and a flag indicating whether the foreground (TRUE) or background (FALSE) is to be dithered. Calling the procedure sets up a dither pattern for the pair of colours; and all subsequent graphics commands will use the new colour (including text after VDU5). If you run the program, three filled circles will be displayed. The outer two are in native mode 15 colours, but the centre circle is drawn in a colour made up from the other two.
To make use of the procedure, just insert your own GCOL and TINT numbers, and then proceed to use the new colour. To return to normal colours, use:
GCOL n TINT m
where n and m are the new colour and tint which you require. To return to the same dither pattern you can simply use GCOL 80,0 for a foreground colour, or GCOL 80,128 for a background; or you can call PROCdither again with your new component colours. For example, to produce a (dull) grey foreground by mixing white (colour 63 tint 192) with black (colour 0 tint 0), use:
PROCdither(63,192,0,0,TRUE)
Selecting dither combinations to produce a precise colour is no easy task, but the program in listing 2 should make the job a little easier. If you type it in carefully, and run it, you will see that the screen is split into three areas. The top two sections contain colour palette displays, while the bottom part is a drawing area.
First select a colour from the lower palette using the Select button. The top palette will immediately alter to display the 256 new colours that can be generated using the selected colour as one of the two components. You can now select one of the (dithered) colours from the top palette, and draw with this in the sketch area below.
When colour selections are made, a display appears giving the exact colour and tint numbers used, and these may be noted for subsequent use with PROCdither, as described above.
The technique used in this article makes extensive use of the so-called ECF patterns, and we will take a closer look at these in a future issue.
Note: Although the high resolution provided by the Arc's mode 15 is adequate for the pixel mixing techniques used in these programs, some low resolution monitors may show fine patterning effects.
10 REM >DitherTest
20 REM by Lee Calcraft
30 :
40 MODE15
50 GCOL 3 TINT 192
60 CIRCLE FILL 300,500,250
70 GCOL 14
80 CIRCLE FILL 980,500,250
90 PROCdither(3,192,14,0,TRUE)
100 CIRCLE FILL 640,500,300
110 END
120 :
130 DEFPROCdither(gcola,tinta,gcolb,tintb,foreground)
140 LOCAL A,B
150 A=tinta DIV 64+(gcola AND 33)*4+(gcola AND 14)*8+(gcola AND 16)/2
160 B=tintb DIV 64+(gcolb AND 33)*4+(gcolb AND 14)*8+(gcolb AND 16)/2
170 VDU 23,2,A,B,A,B,A,B,A,B
180 VDU 23,3,B,A,B,A,B,A,B,A
190 VDU 23,4,A,B,A,B,A,B,A,B
200 VDU 23,5,B,A,B,A,B,A,B,A
210 GCOL 80,128+foreground*128
220 ENDPROC
10 REM >Dither
20 REM Program Colour Mixer
30 REM Version A 0.3
40 REM Author Barry W. Christie
50 REM RISC User June 1989
60 REM Program Subject to Copyright
70 :
80 MODE 15:OFF
90 PROCinitialise
100 WHILE mbut<>1
110 IF FNslabarea( 3,37,64, 8,4) THEN PROCcolourchoose
120 IF FNslabarea( 3,53,64, 8,4) THEN PROCditherchoose
130 IF FNslabarea( 2, 2,76,30,4) THEN PROCditherdoodle
140 PROCmouse
150 ENDWHILE
160 END
170 :
180 DEF PROCcolourchoose
190 WHILE FNslabarea( 3,37,64, 8,4)
200 PROCgcoltint:PROCcolrmenu(3 ,52,0,byteb):PROCmouse
210 ENDWHILE
220 ENDPROC
230 :
240 DEF PROCditherchoose
250 WHILE FNslabarea( 3,53,64, 8,4)
260 PROCgcoltint:PROCmouse
270 ENDWHILE
280 ENDPROC
290 :
300 DEF PROCditherdoodle
310 MOUSE RECTANGLE 48,48,1183,447
320 VDU 24,48;48;1231;495;
330 WHILE FNslabarea( 2, 2,76,30,4)
340 CIRCLE FILL mxco,myco,16:PROCmouse
350 ENDWHILE
360 MOUSE RECTANGLE 0,0,1279,1023
370 VDU 26
380 ENDPROC
390 :
400 DEF PROCgcoltint
410 gcolx=(mxco DIV 16)*16:gcoly=(myco
DIV 16)*16
420 bytea=FNcolrbyte(gcolx+0,gcoly)
430 byteb=FNcolrbyte(gcolx+2,gcoly)
440 gcola=POINT(gcolx+0,gcoly)
450 tinta=TINT(gcolx+0,gcoly)
460 gcolb=POINT(gcolx+2,gcoly)
470 tintb=TINT(gcolx+2,gcoly)
480 VDU 23,2,bytea,byteb,bytea,byteb,bytea,byteb,bytea,byteb
490 VDU 23,3,byteb,bytea,byteb,bytea,byteb,bytea,byteb,bytea
500 VDU 23,4,bytea,byteb,bytea,byteb,bytea,byteb,bytea,byteb
510 VDU 23,5,byteb,bytea,byteb,bytea,byteb,bytea,byteb,bytea
520 GCOL gcola TINT tinta
530 RECTANGLE FILL 1120,879,111,95
540 GCOL gcolb TINT tintb
550 RECTANGLE FILL 1120,592,111,95
560 GCOL 80,0
570 RECTANGLE FILL 1120,720,111,127
580 PRINT TAB( 9,7)FNnmbrtext(gcola,2)TAB(17,7)FNnmbrtext(tinta,3)
590 PRINT TAB(55,7)FNnmbrtext(gcolb,2)TAB(63,7)FNnmbrtext(tintb,3)
600 ENDPROC
610 :
620 DEF PROCcolrmenu(menux,menuy,menut,menus)
630 !addr=scrnbase+menux*8+(55-menuy)*&A00
640 !colr=menus:A%=menut
650 CALL draw
660 ENDPROC
670 :
680 DEF PROCslab(slabx,slaby,slabw,slabh,slabt)
690 slabx=slabx*16:slabw=slabw*16-1
700 slaby=slaby*16:slabh=slabh*16-1
710 FOR slabbits=0 TO 3
720 gcolbit1=(slabbits DIV 2)*21+21
730 gcolbit2=gcolbit1+21
740 IF slabt=1 THEN SWAP gcolbit1,gcolbit2
750 GCOL 0 TINT (slabbits MOD 2)*128
760 GCOL gcolbit1:RECTANGLE FILL slabx+0,slaby,slabw-0,slabh-0
770 GCOL gcolbit2:RECTANGLE FILL slabx+4,slaby,slabw-4,slabh-4
780 slabx+=4:slaby+=4
790 slabw-=8:slabh-=8
800 NEXT slabbits
810 GCOL 42 TINT 192:RECTANGLE FILL slabx,slaby,slabw,slabh
820 ENDPROC
830 :
840 DEF PROCmouse
850 MOUSE mxco,myco,mbut
860 ENDPROC
870 :
880 DEF PROCinitialise
890 PROCassemble:PROCmouse:*POINTER
900 COLOUR 170 TINT 192:COLOUR 0 TINT 128
910 PROCslab( 0,34,80,30,1):PROCslab( 2,52,66,10,0):PROCslab( 2,47,66, 4,1)
920 PROCslab( 2,36,66,10,0):PROCslab(69,54, 9, 8,0):PROCslab(69,44, 9,10,1)
930 PROCslab(69,36, 9, 8,0):PROCslab( 0, 0,80,34,1):PROCslab( 2, 2,76,30,0)
940 PROCcolrmenu(3 ,52,0,0):PROCcolrmenu(3 ,36,1,0)
950 PRINT TAB(3,7)"<gcol .. tint ...> colours used for dithering <gcol .. tint
...>"
960 ENDPROC
970 :
980 DEF PROCassemble
990 DIM codearea 1024
1000 scrnbase=FNscrnbase
1010 FOR pass=0 TO 2 STEP 2
1020 P%=codearea
1030 [ OPT pass
1040 .draw MOV R10,R0
1050 LDR R0 ,colr
1060 LDR R1 ,addr
1070 ORR R0 ,R0 ,R0 ,LSL#&10
1080 MOV R2 ,#&00
1090 MOV R3 ,#&04
1100 .loop1 MOV R4 ,#&40
1110 MOV R5 ,R1
1120 .loop2 ORR R6 ,R2 ,R2 ,LSL#&10
1130 ORR R6 ,R6 ,R0 ,LSL#&08
1140 MOV R7 ,R6
1150 CMP R10,#&00
1160 ORRNE R6 ,R2 ,R2 ,LSL#&08
1170 ORRNE R6 ,R6 ,R6 ,LSL#&10
1180 MOVNE R7 ,R6
1190 MOV R8 ,R5
1200 MOV R9 ,#&08
1210 .loop3 STMIA R8 ,{R6-R7}
1220 MOV R6 ,R6 ,ROR#&08
1230 MOV R7 ,R7 ,ROR#&08
1240 ADD R8 ,R8 ,#&280
1250 SUBS R9 ,R9 ,#&01
1260 BNE loop3
1270 ADD R2 ,R2 ,#&01
1280 ADD R5 ,R5 ,#&08
1290 SUBS R4 ,R4 ,#&01
1300 BNE loop2
1310 ADD R1 ,R1 ,#&1400
1320 SUBS R3 ,R3 ,#&01
1330 BNE loop1
1340 MOV R15,R14
1350 .colr EQUD &00000000
1360 .addr EQUD &00000000
1370 ]
1380 NEXT pass
1390 ENDPROC
1400 :
1410 DEF FNnmbrtext(nmbr,size)
1420 =LEFT$(STR$(nmbr)+" ",size)
1430 :
1440 DEF FNcolrbyte(bytex,bytey)
1450 =?(scrnbase+(bytex DIV 2)+(255-(bytey DIV 4))*&280)
1460 :
1470 DEF FNscrnbase
1480 codearea!&00=148:codearea!&04=-1
1490 SYS &31,codearea,codearea
1500 =!codearea
1510 :
1520 DEF FNslabarea(mposx,mposy,mposw,mposh,mposb)
1530 mposx=mposx*16
1540 mposw=mposx+mposw*16-1
1550 mposy=mposy*16
1560 mposh=mposy+mposh*16-1
1570 IF mposb<>mbut THEN =FALSE
1580 IF mxco<mposx OR mxco>mposw THEN =FALSE
1590 IF myco<mposy OR myco>mposh THEN =FALSE
1600 =TRUE