_ALGORITHM ALLEY_
edited by Bruce Schneier
written by Pieter Gosselink


REM>$.D.Dither+

REM Number of bits per primary color
rbits%=5
gbits%=5
bbits%=5

REM The size of the ordered dither matrix
accurate%=4

REM The number of colors in the palette ( <=256)
num_of_colors = 256-1

tot% = (1<<accurate%)-1
tr%  = (1<<rbits%)-1
tg%  = (1<<gbits%)-1
tb%  = (1<<bbits%)-1
max  = 4*(tot%+1)

REM Reserve the necessary memory
DIM bytes%(tot%)
DIM red(num_of_colors),green(num_of_colors),blue(num_of_colors)
DIM grey(num_of_colors)
DIM grid%(tot%)
DIM table%(tr%,tb%,tg%,tot%)

REM The indeces in the ordered dither matrix
CASE accurate% OF
WHEN 2:grid%()=0,3,2,1
WHEN 4:grid%()=0,12,3,15,8,4,11,7,2,14,1,13,10,6,9,5
OTHERWISE : PRINT "Invalid size":END
ENDCASE

REM Palette specification
REM The file consist records with the RGB value and the grey value
REM of each palette entry
f%=OPENIN("Palette")
IF f%=0 THEN PRINT "Couldn't open palette file for reading":END
FOR i%=0 TO num_of_colors
 INPUT#f%,red(i%),green(i%),blue(i%),grey(i%)
NEXT
CLOSE#f%

tableentry%=0
PRINT TIME$
FOR ir%=0 TO tr%
 PRINT ;tr%-ir%;" ";
 fr=ir%/tr%
 FOR ig%=0 TO tg%
  fg=ig%/tg%
  FOR ib%=0 TO tb%
   fb=ib%/tb%
   sr = fr
   sg = fg
   sb = fb
   FOR i%=0 TO tot%
    a=max
    FOR j%=0 TO num_of_colors
     d  = (red(j%)-sr)*(red(j%)-sr)
     d += (green(j%)-sg)*(green(j%)-sg)
     d += (blue(j%)-sb)*(blue(j%)-sb)
     IF d<a THEN a=d:c%=j%
    NEXT
    bytes%(i%)=c%
    IF i%<tot% THEN
     f=tot%-i%
     sr+=(sr-red(c%))/f
     sg+=(sg-green(c%))/f
     sb+=(sb-blue(c%))/f
    ENDIF
   NEXT
   FOR i%=0 TO tot%-1
    FOR j%=i%+1 TO tot%
     IF grey(bytes%(i%))>grey(bytes%(j%)) THEN SWAP bytes%(i%),bytes%(j%)
    NEXT
   NEXT
   FOR i%=0 TO tot%
    table%(ir%,ig%,ib%,i%)=bytes%(grid%(i%))
   NEXT
   tableentry%+=1
  NEXT
 NEXT
NEXT
PRINT TIME$

a$="RGB"+STR$(rbits%)+STR$(gbits%)+STR$(bbits%)+STR$(accurate%)
F%= OPENOUT(a$)
IF F%=0 THEN PRINT "Couldn't open table file for writing":END
FOR r%=0 TO tr%
 FOR g%=0 TO tg%
  FOR b%=0 TO tb%
   FOR c% = 0 TO tot%
    BPUT#F%,table%(r%,g%,b%,c%)
   NEXT
  NEXT
 NEXT
NEXT
CLOSE#F%
END