_CONVERTING DITHERED IMAGES BACK TO GRAY SCALE_
by Allen Stenger

[LISTING ONE]

unit User;
{ This is an addition to, and incorporates parts of, the NIH Image program.  }
{ NIH Image is written by Wayne Rasband at the National Institutes of Health }
{ and is in the public domain. This addition was written by Allen Stenger,   }
{ March 1992. Written in THINK Pascal version 4.0.1.                 }
{ Replace the User.p supplied with Image with this one. Be sure to uncomment }
{ the call to InitUser in Image.p. If you have a small display you may need  }
{ to use ResEdit to shorten the names of the other menu items in Image.rsrc  }
{ so the User menu (which comes last) won't be pushed off the end. Use       }
{ ResEdit to modify the User Menu in Image.rsrc to make the items Lee Local  }
{ Statistics, Ordered Dither, Floyd-Steinberg Dither.                        }
{ Algorithm references:                          }
{ Ordered dither: C.N. Judice, J.F. Jarvis, and W.H.Ninke, "Using    }
{ Ordered Dither to Display Continuous Tone Pictures on an AC Plasma }
{ Panel." Proceeding of the Society for Information Display v. 15    }
{ no. 4 (Fourth Quarter 1974), not paged. Reprinted in: John C.      }
{ Beatty and Kellogg S. Booth (editors), Tutorial: Computer      }
{ Graphics, 2nd edition. Silver Spring, MD: IEEE Computer Society    }
{ Press, 1982,  pp. 220-228.}
{ Lee local statistics: Jong-Sen Lee, "Digital Image Enhancement and }
{ Noise Filtering by Use of Local Statistics." IEEE Transactions on  }
{ Pattern Analysis and Machine Intelligence, v. PAMI-2, no. 2 (March }
{ 1980),  pp. 165-168. Reprinted in: Rama Chellapa and Alexander A.  }
{ Sawchuk (eds.),Digital Image Processing and Analysis v. 1. Silver  }
{ Spring, MD: IEEE Computer Society Press, 1985, pp. 440-443.        }

interface
  uses
    QuickDraw, Palettes, PrintTraps, globals, Utilities, Graphics, Analysis,
    Camera, Functions;
  procedure InitUser;
  procedure DoUserMenuEvent (MenuItem: integer);
implementation
  type
    UserFilterType = (LeeLocalStats, OrderedDither, FloydSteinbergDither);
  procedure InitUser;
  begin
    UserMenuH := GetMenu(UserMenu);
    InsertMenu(UserMenuH, 0);
    DrawMenuBar;
  end;
{ Most of UserFilter is copied with minor modifications from Image (procedure }
{ Filter in Functions.p). The new parts are the Lee local statistics and      }
{ ordered dither code. Floyd-Steinberg dither is copied from Filter. }
  procedure UserFilter (filterType: UserFilterType);
    const
      PixelsPerUpdate = 5000;  { controls screen updating }
{ constants for Lee local statistics method }
      NoiseVariance = 150;    { empirical value for Lee method }
{ constants for ordered dither }
      DitherSize = 8;        { dimensions of ordered dither matrix }
      DitherSizeMinus1 = 7;  { ditto minus 1 }
    type
     DitherPattern = array[0..DitherSizeMinus1, 0..DitherSizeMinus1] of 0..255;
    var
{ general variables for this procedure }
      row, width, r1, r2, r3, c, value, error, sum, tmp, center: integer;
      mark, NewMark, LinesPerUpdate, LineCount: integer;
      MaskRect, frame: rect;
      L1, L2, L3, result: LineType;
      pt: point;
      AutoSelectAll, UseMask: boolean;
      StartTicks: LongInt;
{ variables for Lee local statistics method }
      localVariance: longint;
      localMean: longint;
      gain: real;
      i: integer;      { loop control }
{ variables for ordered dither }
      thePattern: DitherPattern;
    procedure PutLineUsingMask (h, v, count: integer;
            var line: LineType);
      var
    aLine, MaskLine: LineType;
    i: integer;
    SaveInfo: InfoPtr;
    begin
      if count > MaxPixelsPerLine then
    count := MaxPixelsPerLine;
      GetLine(h, v, count, aline);
      SaveInfo := Info;
      Info := UndoInfo;
      GetLine(h, v, count, MaskLine);
      for i := 0 to count - 1 do
    if MaskLine[i] = BlackIndex then
      aLine[i] := line[i];
      info := SaveInfo;
      PutLine(h, v, count, aLine);
    end;
    procedure MakeDitherPattern (var p: DitherPattern);
      var
    row: 0..DitherSizeMinus1;
    column: 0..DitherSizeMinus1;
    halfsize: 1..DitherSize;
    scaleFactor: 1..256;
    begin
      { The pattern is defined recursively; we implement the recursion }
      { as an iteration. }
      p[0, 0] := 0;
      halfsize := 1;
      while halfsize < DitherSize do begin
      for row := 0 to halfsize - 1 do
        for column := 0 to halfsize - 1 do begin
        p[row, column] := 4 * p[row, column];
        p[row, column + halfsize] := p[row, column] + 2;
        p[row + halfsize, column] := p[row, column] + 3;
        p[row + halfsize, column + halfsize] := p[row, column] + 1;
          end;
      halfsize := halfsize * 2;
    end;
      { adjust scaling for pixel ranges 0..255 }
      scaleFactor := 256 div SQR(DitherSize);
      for row := 0 to DitherSizeMinus1 do
    for column := 0 to DitherSizeMinus1 do
      p[row, column] := scaleFactor * p[row, column] + scaleFactor div 2;
    end;  {MakeDitherPattern}
  begin
    if NotinBounds then
      exit(UserFilter);
    StopDigitizing;
    AutoSelectAll := not Info^.RoiShowing;
    if AutoSelectAll then
      with info^ do begin
      SelectAll(false);
      SetPort(wptr);
      PenNormal;
      PenPat(pat[PatIndex]);
      FrameRect(wrect);
    end;
    if TooWide then
      exit(UserFilter);
    ShowWatch;
    if info^.RoiType <> RectRoi then
      UseMask := SetupMask
    else
      UseMask := false;
    WhatToUndo := UndoFilter;
    SetupUndoFromClip;
    ShowMessage(CmdPeriodToStop);
    frame := info^.RoiRect;
    StartTicks := TickCount;
    {Set up for ordered dither }
    if filterType = OrderedDither then
      MakeDitherPattern(thePattern);
    with frame, Info^ do begin
    changes := true;
    RoiShowing := false;
    if left > 0 then
      left := left - 1;
    if right < PicRect.right then
      right := right + 1;
    width := right - left;
    LinesPerUpdate := PixelsPerUpdate div width;
    GetLine(left, top, width, L2);
    GetLine(left, top + 1, width, L3);
    Mark := RoiRect.top;
    LineCount := 0;
    for row := top + 1 to bottom - 1 do begin
       {Move Convolution Window Down}
        BlockMove(@L2, @L1, width);
        BlockMove(@L3, @L2, width);
        GetLine(left, row + 1, width, L3);
       {Process One Row}
        if CommandPeriod then
          exit(UserFilter);
        case filterType of
          LeeLocalStats: 
        for c := 1 to width - 2 do begin
            localMean := (L1[c] + L1[c + 1] + L1[c + 2] 
               + L2[c] + L2[c + 1] + L2[c + 2] 
               + L3[c] + L3[c + 1] + L3[c + 2]) div 9;
            localVariance := 0;
            for i := 0 to 2 do begin
              localVariance := localVariance + SQR(L1[c + i] 
                               - localMean);
              localVariance := localVariance + SQR(L2[c + i]
                               - localMean);
              localVariance := localVariance + SQR(L3[c + i] 
                               - localMean);
              end;
            localVariance := localVariance div (3 * 3);
            if OptionKeyWasDown then { do extra smoothing }
              gain := localVariance / 
                (localVariance + NoiseVariance * 16.0)
            else
              gain := localVariance / (localVariance + NoiseVariance);
            result[c - 1] := 
                round(localMean + gain * (L2[c + 1] - localMean));
            if result[c - 1] > 255 then
              result[c - 1] := 255;
            if result[c - 1] < 0 then
              result[c - 1] := 0;
          end; {LeeLocalStats}
          OrderedDither: 
        for c := 1 to width - 2 do begin
            if L2[c + 1] >= 
              thePattern[row mod DitherSize, c mod DitherSize] then
              result[c - 1] := 255  { dither to black pixel }
            else
              result[c - 1] := 0;    { dither to white pixel }
          end; {OrderedDither}
          FloydSteinbergDither: 
        for c := 1 to width - 2 do begin
            value := L2[c + 1];
            if value < 128 then begin
            result[c - 1] := 0;
            error := -value;
              end
            else begin
            result[c - 1] := 255;
            error := 255 - value
              end;
            tmp := L2[c + 2];          {A}
            tmp := tmp - (7 * error) div 16;
            if tmp < 0 then
              tmp := 0;
            if tmp > 255 then
              tmp := 255;
            L2[c + 2] := tmp;
            tmp := L3[c + 2];          {B}
            tmp := tmp - error div 16;
            if tmp < 0 then
              tmp := 0;
            if tmp > 255 then
              tmp := 255;
            L3[c + 2] := tmp;
            tmp := L3[c + 1];          {C}
            tmp := tmp - (5 * error) div 16;
            if tmp < 0 then
              tmp := 0;
            if tmp > 255 then
              tmp := 255;
            L3[c + 1] := tmp;
            tmp := L3[c];        {D}
            tmp := tmp - (3 * error) div 16;
            if tmp < 0 then
              tmp := 0;
            if tmp > 255 then
              tmp := 255;
            L3[c] := tmp;
          end; {FloydSteinbergDither}
        end; {case filterType}
        if UseMask then
          PutLineUsingMask(left + 2, row, width - 3, result)
        else
          PutLine(left + 2, row, width - 3, result);
        LineCount := LineCount + 1;
        if LineCount = LinesPerUpdate then begin
        pt.h := RoiRect.left;
        pt.v := row + 1;
        NewMark := pt.v;
        with RoiRect do
          SetRect(MaskRect, left, mark, right, NewMark);
        UpdateScreen(MaskRect);
        LineCount := 0;
        Mark := NewMark;
        if magnification > 1.0 then
          Mark := Mark - 1;
        if CommandPeriod then begin
            UpdatePicWindow;
            beep;
            if AutoSelectAll then
              KillRoi;
            exit(UserFilter)
          end;
          end;
      end; {for row:=...}
    trect := frame;
    InsetRect(trect, 1, 1);
    ShowTime(StartTicks, trect, '');
      end; {with}
    if LineCount > 0 then begin
    with frame do
      SetRect(MaskRect, left, mark, right, bottom);
    UpdateScreen(MaskRect)
      end;
    SetupRoiRect;
    if AutoSelectAll then
      KillRoi;
  end;
  procedure DoUserMenuEvent (MenuItem: integer);
  begin
    case MenuItem of  { User menu must be set up in this order }
      1: 
    UserFilter(LeeLocalStats);
      2: 
    UserFilter(OrderedDither);
      3: 
    UserFilter(FloydSteinbergDither);
    end;
  end;
end.