>TestDither
 : Cy Booker
 : 86 Church View
 : Main Road
 : Crockenhill
 : Swanley
 : Kent
 : BR8 8 JW
 run this in a 16 colour Wimp mode with default palette
 the bottom half uses an accurate 2x2 dither algorithm
 the top half uses ColourTrans
 if change parameters to xdither_rgb then works in any mode/palette (upto 8bpp)
 the suprising fact is that for 4bpp it looks as though we have changed
 the working resolution from 0..255 to 0..65536 (extra 2.4 decimal places)
 only doubles the "resolution"
 all sub-routines conform to
     parameters in R0, R1, R2, ...
     returns in R0, R1, R2, ... [F0, F1, F2, ...]
     corrupts R0-R3, ip, lr
     preserves R4-R9, sl, gb, sp
     if name has `x' prefix then
             PSR_V set on SWI error, PSR_NZC undefined
             PSR_V clear if OK,  PRS_NZC preserved
     else if name has `v' prefix then
             PSR_Z is state of R0, PSR_NCV preserved
     else PSR_NZCV preserved
$+ " ["+ 
)+ "]"
  sp = 13
  lr = 14
!3  gb = 12                       :
 not APCS !!!
"3  ip = 11                       :
 not APCS !!!
  PSR_V = &10000000
  L% = 10240
 code% L% : L% += code%
 pass%= %1000 
 %1010 
    O% = 0 : P% = code%
    [OPT pass%
        
udivide_255
        
udivide_3
        
udivmod
        
xdither_rgb
.(        
convert_paletteentry_to_rgb
/(        
convert_rgb_to_paletteentry
0E.Palette                        ; standard 16-colour wimp palette
        EQUD    &FFFFFF00
        EQUD    &DDDDDD00
        EQUD    &BBBBBB00
        EQUD    &99999900
        EQUD    &77777700
        EQUD    &55555500
        EQUD    &33333300
        EQUD    &00000000
        EQUD    &99440000
        EQUD    &00EEEE00
        EQUD    &00CC0000
        EQUD    &0000DD00
        EQUD    &BBEEEE00
        EQUD    &00885500
        EQUD    &00BBFF00
        EQUD    &FFBB0000
.xdither
        STMFD   (sp)!, {lr}
        MOV     R3, #20
        ADR     R4, Palette
        MOV     R5, #4
        BL      xdither_rgb
        LDMvsFD (sp)!, {pc}
H"        STMFD   (sp)!, {R0-R3}
I"        STMFD   (sp)!, {R0-R3}
        MOV     R0, #1 << 5
        MOV     R1, sp
L#        SWI     "XOS_SetColour"
M"        ADD     sp, sp, #4*4*2
        LDMFD   (sp)!, {pc}
O	    ]
 pass%
 s(2), e(2), c(2)
  s() = 0.03, 0.80, 0.42
  e() = 0.94, 0.05, 0.79
 i%= 0 
    s(i%) = 
    e(i%) = 1 - (
(1) < 0.7
X	    
  nstep = 512
 i= 0 
 1.00 
 1/nstep
    c() = e()-s()
    c() = i*c()
    c() = c() + s()
    A% = c(0)*&10000 + 0.5
    B% = c(1)*&10000 + 0.5
    C% = c(2)*&10000 + 0.5
 xdither
c(    
 i*1024, 0, 1024/nstep, 512
    A% = c(0)*&ff + 0.5
    B% = c(1)*&ff + 0.5
    C% = c(2)*&ff + 0.5
gD    
 "ColourTrans_SetGCOL", (A%<<8)+(B%<<16)+(C%<<24),,,&100,0
h,    
 i*1024, 512, 1024/nstep, 512  
  *ScreenSave <d>.Tmp.screen
link(a$):
udivide_3
[OPT pass%
qS; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
r*; Calculates round(n/3) extremely fast
; In    R0 = n
; Out   R0 = round(n 
.udivide_3
x'        MOV     R2, R0, LSR #32 - 2
y&        ADDS    R1, R0, R0, LSL #2
zD        ADDcs   R2, R2, #1              ; R2.R1 = R0 * &00000005
{'        ADD     R2, R2, R2, LSL #16
|'        ADDS    R3, R1, R1, LSL #16
}D        ADC     R2, R2, R1, LSR #32 - 16; R2.R3 = R0 * &00050005
~&        ADD     R2, R2, R2, LSL #8
&        ADDS    R1, R3, R3, LSL #8
D        ADC     R2, R2, R3, LSR #32 - 8 ; R2.R1 = R0 * &05050505
&        ADD     R2, R2, R2, LSL #4
&        ADDS    R3, R1, R1, LSL #4
D        ADC     R0, R2, R1, LSR #32 - 4 ; R0.R3 = R0 * &55555555
6        ADDmi   R0, R0, #1              ; round up
        MOVS    pc, lr
	]:= 0
udivide_255
[OPT pass%
S; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
,; Calculates round(n/255) extremely fast
; In    R0 = n
; Out   R0 = round(n 
 255)
.udivide_255
'        MOV     R2, R0, LSR #32 - 8
&        ADDS    R1, R0, R0, LSL #8
D        ADDcs   R2, R2, #1              ; R2.R1 = R0 * &00000101
'        ADD     R2, R2, R2, LSL #16
'        ADDS    R3, R1, R1, LSL #16
D        ADC     R0, R2, R1, LSR #32 - 16; R0.R3 = R0 * &01010101
6        ADDmi   R0, R0, #1              ; round up
        MOVS    pc, lr
	]:= 0
udivmod
[OPT pass%
R;~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
; In    R0 = unsigned
#;       R1 = unsigned, non-zero
4; Out   R0 = R0 / R1 (rounded down towards zero)
;       R1 = R0 
6; Note  if R1 = 0 then get stuck in infinite loop!
.udivmod
        
divrem(2, 0, 1, 3)
        MOV     R1, R0
        MOV     R0, R2
        MOVS    pc, lr
	]:= 0
xdither_rgb
 L_TopLeft, L_BottomRight, L_TopRight, L_Mode, L_BPP
 loop
 first 3 words are accumulator (ie tl, tl+br, tl+br+tr)
  L_TopLeft     = 3 << 2
  L_BottomRight = 4 << 2
  L_TopRight    = 5 << 2
7  L_Mode        = 6 << 2                :
 implicit
7  L_BPP         = 7 << 2                :
 implicit
link("convert_paletteentry_to_rgb,convert_rgb_to_paletteentry,udivide_3")
[OPT pass%
S; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
R; Calculate a 2x2 dither pattern for an rgb given a mode and a palette pointer
M; This routine needed since cant change palette when redirected output to
; sprite
.; The algorithm based on colourtrans's, ie
;  tl = closest
O;  br = 2.actual - tl              = actual - (tl - actual) = actual - diff
 ;  tr = 2.actual - (tl+br)/2
%;  bl = 2.actual - (tl+br+tr) / 3
; In    R0 = &000r.rrrr
;       R1 = &000g.gggg
;       R2 = &000b.bbbb
;       R3 = mode
/;       R4 = pointer to colourtrans palette
+;       R5 = bpp for mode {2, 4, 8, 16}
8; Out   R0 = top row of screen bytes (word expanded)
;;       R1 = bottom row of screen bytes (word expanded)
;       R2 = R0
;       R3 = R1
.xdither_rgb
:        STMFD   (sp)!, {R0, R1, R2, R3, R5, R6-R9, lr}
J        LDMIA   (sp)!, {R6, R7, R8}             ; R6/R7/R8= rgb wanted
#        SUB     sp, sp, #L_Mode
/        BL      convert_rgb_to_paletteentry
%        LDR     R1, [sp, #L_Mode]
        MOV     R2, R4
<        SWI     "XColourTrans_ReturnColourNumberForMode"
$        Bvs     error_dither_rgb
(        STR     R0, [sp, #L_TopLeft]
        ;
(        LDR     R0, [R4, R0, LSL #2]
/        BL      convert_paletteentry_to_rgb
B        STMIA   sp, {R0, R1, R2}                ; Stack tl rgb
A        
aux_dithers_rgb                       ; br = 2x - tl
,        STR     R0, [sp, #L_BottomRight]
        ;
(        LDR     R0, [R4, R0, LSL #2]
/        BL      convert_paletteentry_to_rgb
$        LDMIA   sp, {R3, ip, lr}
        ADD     R0, R0, R3
        ADD     R1, R1, ip
        ADD     R2, R2, lr
E        STMIA   sp, {R0, R1, R2}                ; Stack tl+br rgb
"        MOVS    R0, R0, ASR #1
K        ADDcs   R0, R0, #1                      ; ensure lsb is correct
"        MOVS    R1, R1, ASR #1
        ADDcs   R1, R1, #1
"        MOVS    R2, R2, ASR #1
        ADDcs   R2, R2, #1
J        
aux_dithers_rgb                       ; tr = 2x - (tl + br)/2
)        STR     R0, [sp, #L_TopRight]
        ;
(        LDR     R0, [R4, R0, LSL #2]
/        BL      convert_paletteentry_to_rgb
$        LDMIA   sp, {R3, ip, lr}
H        ADD     R5, R0, R3                      ; R5 = red(tl+br+tr)
J        ADD     R9, R1, ip                      ; R9 = green(tl+br+tr)
4        ADD     R0, R2, lr                      
Q        BL      udivide_3                       ; this ensures lsb is correct
N        STR     R0, [sp, #8]                    ; stack blue(tl+br+tr) / 3
        MOV     R0, R9 
        BL      udivide_3
O        STR     R0, [sp, #4]                    ; stack green(tl+br+tr) / 3
        MOV     R0, R5
        BL      udivide_3
         LDMIB   sp, {R1, R2}
K        
aux_dithers_rgb                       ; bl = 2x - (tl+br+tr)/3
$        LDR     R5, [sp, #L_BPP]
,        LDR     R2, [sp, #L_BottomRight]
)        LDR     R3, [sp, #L_TopRight]
(        LDR     R4, [sp, #L_TopLeft]
C        
R     R1, R2, R0, LSL R5              ; R1= bottom row
@        
R     R0, R3, R4, LSL R5              ; R0= top row
.loop   ADD     R5, R5, R5
        CMP     R5, #16
K        
Rls   R0, R0, R0, LSL R5              ; Expand into full words
%        
Rls   R1, R1, R1, LSL R5
        Blo     loop
        MOV     R2, R0
        MOV     R3, R1
	A        CMP     pc, #0                          ; clear psr_v
.error_dither_rgb
'        ADD     sp, sp, #L_Mode + 4
&        LDMFD   (sp)!, {R5-R9, pc}
	]:= 0
aux_dithers_rgb
[OPT pass%
H        RSB     R0, R0, R6, LSL #1              ; red = 2*x - f(red)
&        RSB     R1, R1, R7, LSL #1
&        RSB     R2, R2, R8, LSL #1
H        CMP     R0, #&10000                     ; check for overflow
D        MOVhi   R0, #0                          ; and underflow!
        MOVgt   R0, #&10000
        CMP     R1, #&10000
        MOVhi   R1, #0
        MOVgt   R1, #&10000
        CMP     R2, #&10000
        MOVhi   R2, #0
        MOVgt   R2, #&10000
/        BL      convert_rgb_to_paletteentry
%        LDR     R1, [sp, #L_Mode]
        MOV     R2, R4
 <        SWI     "XColourTrans_ReturnColourNumberForMode"
!$        Bvs     error_dither_rgb
"	]:= 0
xconvert_cmyk_to_rgb
[OPT pass%
&R; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; In    R0 = &000c.cccc
;       R1 = &000y.yyyy
;       R2 = &000m.mmmm
;       R3 = &000k.kkkk
; Out   R0 = &000r.rrrr
;       R1 = &000g.gggg
;       R2 = &000b.bbbb
.xconvert_cmyk_to_rgb
13        SWI     "XColourTrans_ConvertCMYKToRGB"
        MOV     pc, lr
3	]:= 0
xconvert_hsv_to_rgb
[OPT pass%
7R; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
91; In    R0 = &0hhh.hhhh (or -1 if achromatic)
;       R1 = &000s.ssss
;       R2 = &000v.vvvv
; Out   R0 = &000r.rrrr
;       R1 = &000g.gggg
;       R2 = &000b.bbbb
.xconvert_hsv_to_rgb
AP        CMN     R0, #+1                         ; Achromatic ? [clear PSR_V]
        MOVeq   R0, R2
        MOVeq   R1, R2
D2        SWIne   "XColourTrans_ConvertHSVToRGB"
        MOV     pc, lr
F	]:= 0
convert_paletteentry_to_rgb
link("udivide_255")
[OPT pass%
KR; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; In    R0 = &bbggrr??
; Out   R0 = &000r.rrrr
;       R1 = &000g.gggg
;       R2 = &000b.bbbb
R .convert_paletteentry_to_rgb
S&        STMFD   (sp)!, {R4-R5, lr}
        MOV     R4, R0
U"        MOV     R5, #&00ff0000
V=        
     R0, R5, R4, LSR #8              ; &00bb0000
W@        BL      udivide_255                     ; &000b.bbbb
        STMFD   (sp)!, {R0}
Y=        
     R0, R5, R4                      ; &00gg0000
Z@        BL      udivide_255                     ; &000g.gggg
        STMFD   (sp)!, {R0}
\=        
     R0, R5, R4, LSL #8              ; &00rr0000
]@        BL      udivide_255                     ; &000r.rrrr
^.        LDMFD   (sp)!, {R1-R2, R4-R5, pc}^
_	]:= 0
xconvert_rgb_to_cmyk
[OPT pass%
cR; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; In    R0 = &000r.rrrr
;       R1 = &000g.gggg
;       R2 = &000b.bbbb
; Out   R0 = &000c.cccc
;       R1 = &000y.yyyy
;       R2 = &000m.mmmm
;       R3 = &000k.kkkk
.xconvert_rgb_to_cmyk
n3        SWI     "XColourTrans_ConvertRGBToCMYK"
        MOV     pc, lr
p	]:= 0
xconvert_rgb_to_hsv
[OPT pass%
tR; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; In    R0 = &000r.rrrr
;       R1 = &000g.gggg
;       R2 = &000b.bbbb
y>; Out   R0 = &0hhh.hhhh  (or -1 if achromatic, ie r==g==b)
;       R1 = &000s.ssss
;       R2 = &000v.vvvv
.xconvert_rgb_to_hsv
        CMP     R0, R1
@        CMPeq   R1, R2                          ; Achromatic
K        MVNeq   R0, #
(-1)                    ; So undefined (sentinel)
        MOVeq   R1, #0
2        SWIne   "XColourTrans_ConvertRGBToHSV"
        MOV     pc, lr
	]:= 0
convert_rgb_to_paletteentry
[OPT pass%
R; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; In    R0 = &000r.rrrr
;       R1 = &000g.gggg
;       R2 = &000b.bbbb
; Out   R0 = &bbggrr00
 .convert_rgb_to_paletteentry
I        RSB     R2, R2, R2, LSL #8              ; R2= blue * &ff.0000
#        MOVS    R2, R2, LSR #16
C        ADDcs   R2, R2, #1                      ; R2= &000000bb
J        RSB     R1, R1, R1, LSL #8              ; R1= green * &ff.0000
#        MOVS    R1, R1, LSR #16
C        ADC     R1, R1, R2, LSL #8              ; R1= &0000bbgg
H        RSB     R0, R0, R0, LSL #8              ; R0= red * &ff.0000
#        MOVS    R0, R0, LSR #16
C        ADC     R0, R0, R1, LSL #8              ; R0= &00bbggrr
"        MOV     R0, R0, LSL #8
        MOVS    pc, lr
	]:= 0
 **********************************************************
 ***   Macro DIVREM - rc := ra DIV rb; ra := ra REM rb  ***
 ***   rb preserved, rtemp corrupt                      ***
 ***   Now up to 37% faster                             ***
 **********************************************************
 from Acorn AAsm header file 'macros'
divrem(rc%, ra%, rb%, rtemp%)
 loop
[OPT pass%
        MOV     rtemp%, rb%
'        CMP     rtemp%, ra%, LSR #1
*.loop   MOVls   rtemp%, rtemp%, LSL #1
'        CMPls   rtemp%, ra%, LSR #1
        Bls     loop
        MOV     rc%, #0
.loop   CMP     ra%, rtemp%
$        SUBcs   ra%, ra%, rtemp%
!        ADC     rc%, rc%, rc%
*        MOV     rtemp%, rtemp%, LSR #1
        CMP     rtemp%, rb%
        Bcs     loop
	]:= 0