UNIT COLOR;

INTERFACE

TYPE
  SmallRGBPtr     = ^SmallRGBPalette;
  SmallRGBPalette = ARRAY[0..15, 0..2] OF BYTE;
  BigRGBPtr       = ^BigRGBPalette;
  BigRGBPalette   = ARRAY[0..255, 0..2] OF BYTE;
  BigIndexArray   = ARRAY[0..255] OF BYTE;
  RGBHistoCount   = ARRAY[0..255] OF LongInt;
  RGBGrayArray    = ARRAY[0..255] OF REAL;
  RGBHistoPtr     = ^RGBHistoArray;
  RGBHistoArray   = RECORD
                      HistoCount : RGBHistoCount;
                      GrayValues : RGBGrayArray;
                      RGBValues  : BigRGBPalette;
                    END;
  RGBSortStyle    = (SortByGray, SortByCount);
  RGBLessProc     = FUNCTION (X, Y : INTEGER;
                              RH   : RGBHistoPtr) : BOOLEAN;

CONST
  EGAStandardIndex   : ARRAY[0..15] OF BYTE = (
    0, 1, 2, 3, 4, 5, 20, 7, 56, 57, 58, 59, 60, 61, 62, 63);
  EGAStandardPalette : ARRAY[0..63, 0..2] OF BYTE = (
   ($00,$00,$00), ($00,$00,$2b), ($00,$2b,$00), ($00,$2b,$2b),
   ($2b,$00,$00), ($2b,$00,$2b), ($2b,$2b,$00), ($2b,$2b,$2b),
   ($00,$00,$15), ($00,$00,$3F), ($00,$2b,$15), ($00,$2b,$3F),
   ($2b,$00,$15), ($2b,$00,$3F), ($2b,$2b,$15), ($2b,$2b,$3F),
   ($00,$15,$00), ($00,$15,$2b), ($00,$3F,$00), ($00,$3F,$2b),
   ($2b,$15,$00), ($2b,$15,$2b), ($2b,$3F,$00), ($2b,$3F,$2b),
   ($00,$15,$15), ($00,$15,$3F), ($00,$3F,$15), ($00,$3F,$3F),
   ($2b,$15,$15), ($2b,$15,$3F), ($2b,$3F,$15), ($2b,$3F,$3F),
   ($15,$00,$00), ($15,$00,$2b), ($15,$2b,$00), ($15,$2b,$2b),
   ($3F,$00,$00), ($3F,$00,$2b), ($3F,$2b,$00), ($3F,$2b,$2b),
   ($15,$00,$15), ($15,$00,$3F), ($15,$2b,$15), ($15,$2b,$3F),
   ($3F,$00,$15), ($3F,$00,$3F), ($3F,$2b,$15), ($3F,$2b,$3F),
   ($15,$15,$00), ($15,$15,$2b), ($15,$3F,$00), ($15,$3F,$2b),
   ($3F,$15,$00), ($3F,$15,$2b), ($3F,$3F,$00), ($3F,$3F,$2b),
   ($15,$15,$15), ($15,$15,$3F), ($15,$3F,$15), ($15,$3F,$3F),
   ($3F,$15,$15), ($3F,$15,$3F), ($3F,$3F,$15), ($3F,$3F,$3F) );

  VGAStandardPalette : ARRAY[0..255, 0..2] OF BYTE = (
   ($00,$00,$00), ($00,$00,$2A), ($00,$2A,$00), ($00,$2A,$2A),
   ($2A,$00,$00), ($2A,$00,$2A), ($2A,$15,$00), ($2A,$2A,$2A),
   ($15,$15,$15), ($15,$15,$3F), ($15,$3F,$15), ($15,$3F,$3F),
   ($3F,$15,$15), ($3F,$15,$3F), ($3F,$3F,$15), ($3F,$3F,$3F),
   ($3B,$3B,$3B), ($37,$37,$37), ($34,$34,$34), ($30,$30,$30),
   ($2D,$2D,$2D), ($2A,$2A,$2A), ($26,$26,$26), ($23,$23,$23),
   ($1F,$1F,$1F), ($1C,$1C,$1C), ($19,$19,$19), ($15,$15,$15),
   ($12,$12,$12), ($0E,$0E,$0E), ($0B,$0B,$0B), ($08,$08,$08),
   ($3F,$00,$00), ($3B,$00,$00), ($38,$00,$00), ($35,$00,$00),
   ($32,$00,$00), ($2F,$00,$00), ($2C,$00,$00), ($29,$00,$00),
   ($26,$00,$00), ($22,$00,$00), ($1F,$00,$00), ($1C,$00,$00),
   ($19,$00,$00), ($16,$00,$00), ($13,$00,$00), ($10,$00,$00),
   ($3F,$36,$36), ($3F,$2E,$2E), ($3F,$27,$27), ($3F,$1F,$1F),
   ($3F,$17,$17), ($3F,$10,$10), ($3F,$08,$08), ($3F,$00,$00),
   ($3F,$2A,$17), ($3F,$26,$10), ($3F,$22,$08), ($3F,$1E,$00),
   ($39,$1B,$00), ($33,$18,$00), ($2D,$15,$00), ($27,$13,$00),
   ($3F,$3F,$36), ($3F,$3F,$2E), ($3F,$3F,$27), ($3F,$3F,$1F),
   ($3F,$3E,$17), ($3F,$3D,$10), ($3F,$3D,$08), ($3F,$3D,$00),
   ($39,$36,$00), ($33,$31,$00), ($2D,$2B,$00), ($27,$27,$00),
   ($21,$21,$00), ($1C,$1B,$00), ($16,$15,$00), ($10,$10,$00),
   ($34,$3F,$17), ($31,$3F,$10), ($2D,$3F,$08), ($28,$3F,$00),
   ($24,$39,$00), ($20,$33,$00), ($1D,$2D,$00), ($18,$27,$00),
   ($36,$3F,$36), ($2F,$3F,$2E), ($27,$3F,$27), ($20,$3F,$1F),
   ($18,$3F,$17), ($10,$3F,$10), ($08,$3F,$08), ($00,$3F,$00),
   ($00,$3F,$00), ($00,$3B,$00), ($00,$38,$00), ($00,$35,$00),
   ($01,$32,$00), ($01,$2F,$00), ($01,$2C,$00), ($01,$29,$00),
   ($01,$26,$00), ($01,$22,$00), ($01,$1F,$00), ($01,$1C,$00),
   ($01,$19,$00), ($01,$16,$00), ($01,$13,$00), ($01,$10,$00),
   ($36,$3F,$3F), ($2E,$3F,$3F), ($27,$3F,$3F), ($1F,$3F,$3E),
   ($17,$3F,$3F), ($10,$3F,$3F), ($08,$3F,$3F), ($00,$3F,$3F),
   ($00,$39,$39), ($00,$33,$33), ($00,$2D,$2D), ($00,$27,$27),
   ($00,$21,$21), ($00,$1C,$1C), ($00,$16,$16), ($00,$10,$10),
   ($17,$2F,$3F), ($10,$2C,$3F), ($08,$2A,$3F), ($00,$27,$3F),
   ($00,$23,$39), ($00,$1F,$33), ($00,$1B,$2D), ($00,$17,$27),
   ($36,$36,$3F), ($2E,$2F,$3F), ($27,$27,$3F), ($1F,$20,$3F),
   ($17,$18,$3F), ($10,$10,$3F), ($08,$09,$3F), ($00,$01,$3F),
   ($00,$00,$3F), ($00,$00,$3B), ($00,$00,$38), ($00,$00,$35),
   ($00,$00,$32), ($00,$00,$2F), ($00,$00,$2C), ($00,$00,$29),
   ($00,$00,$26), ($00,$00,$22), ($00,$00,$1F), ($00,$00,$1C),
   ($00,$00,$19), ($00,$00,$16), ($00,$00,$13), ($00,$00,$10),
   ($3C,$36,$3F), ($39,$2E,$3F), ($36,$27,$3F), ($34,$1F,$3F),
   ($32,$17,$3F), ($2F,$10,$3F), ($2D,$08,$3F), ($2A,$00,$3F),
   ($26,$00,$39), ($20,$00,$33), ($1D,$00,$2D), ($18,$00,$27),
   ($14,$00,$21), ($11,$00,$1C), ($0D,$00,$16), ($0A,$00,$10),
   ($3F,$36,$3F), ($3F,$2E,$3F), ($3F,$27,$3F), ($3F,$1F,$3F),
   ($3F,$17,$3F), ($3F,$10,$3F), ($3F,$08,$3F), ($3F,$00,$3F),
   ($38,$00,$39), ($32,$00,$33), ($2D,$00,$2D), ($27,$00,$27),
   ($21,$00,$21), ($1B,$00,$1C), ($16,$00,$16), ($10,$00,$10),
   ($3F,$3A,$37), ($3F,$38,$34), ($3F,$36,$31), ($3F,$35,$2F),
   ($3F,$33,$2C), ($3F,$31,$29), ($3F,$2F,$27), ($3F,$2E,$24),
   ($3F,$2C,$20), ($3F,$29,$1C), ($3F,$27,$18), ($3C,$25,$17),
   ($3A,$23,$16), ($37,$22,$15), ($34,$20,$14), ($32,$1F,$13),
   ($2F,$1E,$12), ($2D,$1C,$11), ($2A,$1A,$10), ($28,$19,$0F),
   ($27,$18,$0E), ($24,$17,$0D), ($22,$16,$0C), ($20,$14,$0B),
   ($1D,$13,$0A), ($1B,$12,$09), ($17,$10,$08), ($15,$0F,$07),
   ($12,$0E,$06), ($10,$0C,$06), ($0E,$0B,$05), ($0A,$08,$03),
   ($00,$00,$00), ($00,$00,$00), ($00,$00,$00), ($00,$00,$00),
   ($00,$00,$00), ($00,$00,$00), ($00,$00,$00), ($00,$00,$00),
   ($31,$0A,$0A), ($31,$13,$0A), ($31,$1D,$0A), ($31,$27,$0A),
   ($31,$31,$0A), ($27,$31,$0A), ($1D,$31,$0A), ($13,$31,$0A),
   ($0A,$31,$0C), ($0A,$31,$17), ($0A,$31,$22), ($0A,$31,$2D),
   ($0A,$2A,$31), ($0A,$1F,$31), ($0A,$14,$31), ($0B,$0A,$31),
   ($16,$0A,$31), ($21,$0A,$31), ($2C,$0A,$31), ($31,$0A,$2B),
   ($31,$0A,$20), ($31,$0A,$15), ($31,$0A,$0A), ($3F,$3F,$3F) );

FUNCTION  TestArrayForGray  (    RP      :  BigRGBPtr;
                                 Max     :  INTEGER) : BOOLEAN;
FUNCTION  TestForGray       (    R, G, B : BYTE) : BOOLEAN;
PROCEDURE ColorToGray       (VAR R, G, B : BYTE);
FUNCTION  GetGray_BYTE_Value(    R, G, B : BYTE) : BYTE;
FUNCTION  GetGray_REAL_Value(    R, G, B : BYTE) : REAL;
PROCEDURE SetRGBHistoArrayGray (VAR RH      : RGBHistoPtr);
PROCEDURE InitRGBHistoArray (VAR RH      : RGBHistoPtr;
                                 RGBP    : BigRGBPtr);
PROCEDURE SortRGBHistoArray (VAR RH      : RGBHistoPtr;
                                 MaxIndex: INTEGER;
                                 SStyle  : RGBSortStyle);
FUNCTION  GetUsedColors     (    RH      : RGBHistoPtr) : INTEGER;
FUNCTION  GetColorDifference(    RH      : RGBHistoPtr) : REAL;
FUNCTION  GetSmallRGBIndex  (    SR      : SmallRGBPalette;
                                 Col     : INTEGER;
                                 RH      : RGBHistoPtr) : BYTE;
FUNCTION GetSmallGrayIndex  (    SR      : SmallRGBPalette;
                                 Col     : INTEGER;
                                 RH      : RGBHistoPtr) : BYTE;

IMPLEMENTATION

VAR
  SortRGBLess : RGBLessProc;

FUNCTION TestArrayForGray(RP  : BigRGBPtr;
                          Max : INTEGER) : BOOLEAN;
VAR
  I : INTEGER;
BEGIN
  TestArrayForGray := TRUE;

  FOR I := 0 TO Max DO
  BEGIN
    IF (RP^[I, 0] <> RP^[I, 1]) OR
       (RP^[I, 0] <> RP^[I, 2]) THEN
    BEGIN
      TestArrayForGray := FALSE;
      EXIT;
    END;
  END;
END;

FUNCTION TestForGray(R, G, B : BYTE) : BOOLEAN;
BEGIN
  TestForGray := ( (R = G) AND (R = B) );
END;

FUNCTION GetGray_Real_Value( R, G, B : BYTE) : REAL;
BEGIN
  GetGray_REAL_Value := 0.30 * R + 0.59 * G + 0.11 * B;
END;

FUNCTION GetGray_BYTE_Value( R, G, B : BYTE) : BYTE;
BEGIN
  GetGray_BYTE_Value := ROUND( 0.30 * R + 0.59 * G + 0.11 * B);
END;

PROCEDURE ColorToGray (VAR R, G, B : BYTE);
BEGIN
  R := ROUND( 0.30 * R + 0.59 * G + 0.11 * B);
  G := R;
  B := R;
END;

PROCEDURE InitRGBHistoArray (VAR RH      : RGBHistoPtr;
                                 RGBP    : BigRGBPtr);
BEGIN
  FillChar(RH^, SizeOf(RGBHistoArray), 0);
  MOVE(RGBP^, RH^.RGBValues, SizeOf(BigRGBPalette));
END;

{$F+}
FUNCTION GrayLess(X, Y : INTEGER;
                  RH   : RGBHistoPtr) : BOOLEAN;
BEGIN
  GrayLess := ( RH^.GrayValues[X] > RH^.GrayValues[Y] );
END;

FUNCTION CountLess(X, Y : INTEGER;
                   RH   : RGBHistoPtr) : BOOLEAN;
BEGIN
  CountLess := ( RH^.HistoCount[X] > RH^.HistoCount[Y] );
END;
{$F-}

PROCEDURE SortRGB(VAR RH   : RGBHistoPtr;
                      L, M : INTEGER);
VAR
  I, J, X, Y       : INTEGER;
  LVal             : LongInt;
  R                : REAL;
  RVal, GVal, BVal : BYTE;
BEGIN
  I := L;
  J := M;
  X := (L + M) SHR 1;
  REPEAT
    WHILE SortRGBLess(I, X, RH) DO Inc(I);
    WHILE SortRGBLess(X, J, RH) DO Dec(J);
    IF I <= J THEN
    BEGIN
      LVal   := RH^.HistoCount[I];
      R      := RH^.GrayValues[I];
      RVal   := RH^.RGBValues[I, 0];
      GVal   := RH^.RGBValues[I, 1];
      BVal   := RH^.RGBValues[I, 2];
      RH^.HistoCount[I]   := RH^.HistoCount[J];
      RH^.GrayValues[I]   := RH^.GrayValues[J];
      RH^.RGBValues[I, 0] := RH^.RGBValues[J, 0];
      RH^.RGBValues[I, 1] := RH^.RGBValues[J, 1];
      RH^.RGBValues[I, 2] := RH^.RGBValues[J, 2];
      RH^.HistoCount[J]   := LVal;
      RH^.GrayValues[J]   := R;
      RH^.RGBValues[J, 0] := RVal;
      RH^.RGBValues[J, 1] := GVal;
      RH^.RGBValues[J, 2] := BVal;
      INC(I);
      DEC(J);
    END;
  UNTIL I > J;
  IF L < J THEN SortRGB(RH, L, J);
  IF I < M THEN SortRGB(RH, I, M);
END;

PROCEDURE SetRGBHistoArrayGray (VAR RH : RGBHistoPtr);
VAR
  I : INTEGER;
BEGIN
  FOR I := 0 TO 255 DO
    RH^.GrayValues[ I ] := GetGray_REAL_Value(RH^.RGBValues[I, 0],
                                              RH^.RGBValues[I, 1],
                                              RH^.RGBValues[I, 2]);
END;

PROCEDURE SortRGBHistoArray (VAR RH      : RGBHistoPtr;
                                 MaxIndex: INTEGER;
                                 SStyle  : RGBSortStyle);
BEGIN
  CASE SStyle OF
    SortByGray  : SortRGBLess := GrayLess;
    SortByCount : SortRGBLess := CountLess;
  END;

  SortRGB(RH, 0, MaxIndex);
END;

FUNCTION GetUsedColors(RH : RGBHistoPtr) : INTEGER;
VAR
  I, C : INTEGER;
BEGIN
  C := 0;
  FOR I := 0 TO 255 DO
    IF RH^.HistoCount[I] > 0
      THEN INC(C);
  GetUsedColors := C;
END;

FUNCTION GetColorDifference( RH : RGBHistoPtr) : REAL;
VAR
  Count      : LongInt;
  I          : INTEGER;
  diff, rVal : REAL;
BEGIN
  rVal  := 0;
  I     := 0;
  Count := 0;

  WHILE (RH^.HistoCount[ I + 1 ] > 0) DO
  BEGIN
    diff  := (RH^.GrayValues[I] - RH^.GrayValues[ I + 1 ]);
    rVal  := rVal + diff;
    Count := Count + 1;
    INC(I);
  END;
  IF Count = 0 then Count:=1;

  GetColorDifference := rVal / Count;
END;

FUNCTION GetSmallRGBIndex(SR  : SmallRGBPalette;
                          Col : INTEGER;
                          RH  : RGBHistoPtr) : BYTE;
VAR
  I, MinIndex       : INTEGER;
  TempDiff, minDiff : REAL;
BEGIN
  minDiff  := MaxLongInt;
  MinIndex := 0;
  FOR I := 0 TO 15 DO
  BEGIN
    TempDiff := ( SQR(SR[I, 0] - RH^.RGBValues[Col, 0]) +
                  SQR(SR[I, 1] - RH^.RGBValues[Col, 1]) +
                  SQR(SR[I, 2] - RH^.RGBValues[Col, 2]) );
    IF TempDiff < MinDiff THEN
    BEGIN
      MinDiff  := TempDiff;
      MinIndex := I;
    END;
  END;
  GetSmallRGBIndex := MinIndex;
END;

FUNCTION GetSmallGrayIndex (  SR : SmallRGBPalette;
                             Col : INTEGER;
                              RH : RGBHistoPtr) : BYTE;
VAR
  I, MinIndex       : INTEGER;
  TempDiff, minDiff : REAL;
BEGIN
  minDiff  := MaxLongInt;
  MinIndex := 0;
  FOR I := 0 TO 15 DO
  BEGIN
    TempDiff := ( SQR(GetGray_REAL_Value(SR[I, 0],
                                         SR[I, 1],
                                         SR[I, 2]) -
                      RH^.GrayValues[Col])       );
    IF TempDiff < MinDiff THEN
    BEGIN
      MinDiff := TempDiff;
      MinIndex := I;
    END;
  END;
  GetSmallGrayIndex := MinIndex;
END;

END.