home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / UNDITH.ZIP / UNDITH.ASC
Encoding:
Text File  |  1993-03-26  |  10.6 KB  |  299 lines
  1. _CONVERTING DITHERED IMAGES BACK TO GRAY SCALE_
  2. by Allen Stenger
  3.  
  4. [LISTING ONE]
  5.  
  6. unit User;
  7. { This is an addition to, and incorporates parts of, the NIH Image program.  }
  8. { NIH Image is written by Wayne Rasband at the National Institutes of Health }
  9. { and is in the public domain. This addition was written by Allen Stenger,   }
  10. { March 1992. Written in THINK Pascal version 4.0.1.                 }
  11. { Replace the User.p supplied with Image with this one. Be sure to uncomment }
  12. { the call to InitUser in Image.p. If you have a small display you may need  }
  13. { to use ResEdit to shorten the names of the other menu items in Image.rsrc  }
  14. { so the User menu (which comes last) won't be pushed off the end. Use       }
  15. { ResEdit to modify the User Menu in Image.rsrc to make the items Lee Local  }
  16. { Statistics, Ordered Dither, Floyd-Steinberg Dither.                        }
  17. { Algorithm references:                          }
  18. { Ordered dither: C.N. Judice, J.F. Jarvis, and W.H.Ninke, "Using    }
  19. { Ordered Dither to Display Continuous Tone Pictures on an AC Plasma }
  20. { Panel." Proceeding of the Society for Information Display v. 15    }
  21. { no. 4 (Fourth Quarter 1974), not paged. Reprinted in: John C.      }
  22. { Beatty and Kellogg S. Booth (editors), Tutorial: Computer      }
  23. { Graphics, 2nd edition. Silver Spring, MD: IEEE Computer Society    }
  24. { Press, 1982,  pp. 220-228.}
  25. { Lee local statistics: Jong-Sen Lee, "Digital Image Enhancement and }
  26. { Noise Filtering by Use of Local Statistics." IEEE Transactions on  }
  27. { Pattern Analysis and Machine Intelligence, v. PAMI-2, no. 2 (March }
  28. { 1980),  pp. 165-168. Reprinted in: Rama Chellapa and Alexander A.  }
  29. { Sawchuk (eds.),Digital Image Processing and Analysis v. 1. Silver  }
  30. { Spring, MD: IEEE Computer Society Press, 1985, pp. 440-443.        }
  31.  
  32. interface
  33.   uses
  34.     QuickDraw, Palettes, PrintTraps, globals, Utilities, Graphics, Analysis,
  35.     Camera, Functions;
  36.   procedure InitUser;
  37.   procedure DoUserMenuEvent (MenuItem: integer);
  38. implementation
  39.   type
  40.     UserFilterType = (LeeLocalStats, OrderedDither, FloydSteinbergDither);
  41.   procedure InitUser;
  42.   begin
  43.     UserMenuH := GetMenu(UserMenu);
  44.     InsertMenu(UserMenuH, 0);
  45.     DrawMenuBar;
  46.   end;
  47. { Most of UserFilter is copied with minor modifications from Image (procedure }
  48. { Filter in Functions.p). The new parts are the Lee local statistics and      }
  49. { ordered dither code. Floyd-Steinberg dither is copied from Filter. }
  50.   procedure UserFilter (filterType: UserFilterType);
  51.     const
  52.       PixelsPerUpdate = 5000;  { controls screen updating }
  53. { constants for Lee local statistics method }
  54.       NoiseVariance = 150;    { empirical value for Lee method }
  55. { constants for ordered dither }
  56.       DitherSize = 8;        { dimensions of ordered dither matrix }
  57.       DitherSizeMinus1 = 7;  { ditto minus 1 }
  58.     type
  59.      DitherPattern = array[0..DitherSizeMinus1, 0..DitherSizeMinus1] of 0..255;
  60.     var
  61. { general variables for this procedure }
  62.       row, width, r1, r2, r3, c, value, error, sum, tmp, center: integer;
  63.       mark, NewMark, LinesPerUpdate, LineCount: integer;
  64.       MaskRect, frame: rect;
  65.       L1, L2, L3, result: LineType;
  66.       pt: point;
  67.       AutoSelectAll, UseMask: boolean;
  68.       StartTicks: LongInt;
  69. { variables for Lee local statistics method }
  70.       localVariance: longint;
  71.       localMean: longint;
  72.       gain: real;
  73.       i: integer;      { loop control }
  74. { variables for ordered dither }
  75.       thePattern: DitherPattern;
  76.     procedure PutLineUsingMask (h, v, count: integer;
  77.             var line: LineType);
  78.       var
  79.     aLine, MaskLine: LineType;
  80.     i: integer;
  81.     SaveInfo: InfoPtr;
  82.     begin
  83.       if count > MaxPixelsPerLine then
  84.     count := MaxPixelsPerLine;
  85.       GetLine(h, v, count, aline);
  86.       SaveInfo := Info;
  87.       Info := UndoInfo;
  88.       GetLine(h, v, count, MaskLine);
  89.       for i := 0 to count - 1 do
  90.     if MaskLine[i] = BlackIndex then
  91.       aLine[i] := line[i];
  92.       info := SaveInfo;
  93.       PutLine(h, v, count, aLine);
  94.     end;
  95.     procedure MakeDitherPattern (var p: DitherPattern);
  96.       var
  97.     row: 0..DitherSizeMinus1;
  98.     column: 0..DitherSizeMinus1;
  99.     halfsize: 1..DitherSize;
  100.     scaleFactor: 1..256;
  101.     begin
  102.       { The pattern is defined recursively; we implement the recursion }
  103.       { as an iteration. }
  104.       p[0, 0] := 0;
  105.       halfsize := 1;
  106.       while halfsize < DitherSize do begin
  107.       for row := 0 to halfsize - 1 do
  108.         for column := 0 to halfsize - 1 do begin
  109.         p[row, column] := 4 * p[row, column];
  110.         p[row, column + halfsize] := p[row, column] + 2;
  111.         p[row + halfsize, column] := p[row, column] + 3;
  112.         p[row + halfsize, column + halfsize] := p[row, column] + 1;
  113.           end;
  114.       halfsize := halfsize * 2;
  115.     end;
  116.       { adjust scaling for pixel ranges 0..255 }
  117.       scaleFactor := 256 div SQR(DitherSize);
  118.       for row := 0 to DitherSizeMinus1 do
  119.     for column := 0 to DitherSizeMinus1 do
  120.       p[row, column] := scaleFactor * p[row, column] + scaleFactor div 2;
  121.     end;  {MakeDitherPattern}
  122.   begin
  123.     if NotinBounds then
  124.       exit(UserFilter);
  125.     StopDigitizing;
  126.     AutoSelectAll := not Info^.RoiShowing;
  127.     if AutoSelectAll then
  128.       with info^ do begin
  129.       SelectAll(false);
  130.       SetPort(wptr);
  131.       PenNormal;
  132.       PenPat(pat[PatIndex]);
  133.       FrameRect(wrect);
  134.     end;
  135.     if TooWide then
  136.       exit(UserFilter);
  137.     ShowWatch;
  138.     if info^.RoiType <> RectRoi then
  139.       UseMask := SetupMask
  140.     else
  141.       UseMask := false;
  142.     WhatToUndo := UndoFilter;
  143.     SetupUndoFromClip;
  144.     ShowMessage(CmdPeriodToStop);
  145.     frame := info^.RoiRect;
  146.     StartTicks := TickCount;
  147.     {Set up for ordered dither }
  148.     if filterType = OrderedDither then
  149.       MakeDitherPattern(thePattern);
  150.     with frame, Info^ do begin
  151.     changes := true;
  152.     RoiShowing := false;
  153.     if left > 0 then
  154.       left := left - 1;
  155.     if right < PicRect.right then
  156.       right := right + 1;
  157.     width := right - left;
  158.     LinesPerUpdate := PixelsPerUpdate div width;
  159.     GetLine(left, top, width, L2);
  160.     GetLine(left, top + 1, width, L3);
  161.     Mark := RoiRect.top;
  162.     LineCount := 0;
  163.     for row := top + 1 to bottom - 1 do begin
  164.        {Move Convolution Window Down}
  165.         BlockMove(@L2, @L1, width);
  166.         BlockMove(@L3, @L2, width);
  167.         GetLine(left, row + 1, width, L3);
  168.        {Process One Row}
  169.         if CommandPeriod then
  170.           exit(UserFilter);
  171.         case filterType of
  172.           LeeLocalStats: 
  173.         for c := 1 to width - 2 do begin
  174.             localMean := (L1[c] + L1[c + 1] + L1[c + 2] 
  175.                + L2[c] + L2[c + 1] + L2[c + 2] 
  176.                + L3[c] + L3[c + 1] + L3[c + 2]) div 9;
  177.             localVariance := 0;
  178.             for i := 0 to 2 do begin
  179.               localVariance := localVariance + SQR(L1[c + i] 
  180.                                - localMean);
  181.               localVariance := localVariance + SQR(L2[c + i]
  182.                                - localMean);
  183.               localVariance := localVariance + SQR(L3[c + i] 
  184.                                - localMean);
  185.               end;
  186.             localVariance := localVariance div (3 * 3);
  187.             if OptionKeyWasDown then { do extra smoothing }
  188.               gain := localVariance / 
  189.                 (localVariance + NoiseVariance * 16.0)
  190.             else
  191.               gain := localVariance / (localVariance + NoiseVariance);
  192.             result[c - 1] := 
  193.                 round(localMean + gain * (L2[c + 1] - localMean));
  194.             if result[c - 1] > 255 then
  195.               result[c - 1] := 255;
  196.             if result[c - 1] < 0 then
  197.               result[c - 1] := 0;
  198.           end; {LeeLocalStats}
  199.           OrderedDither: 
  200.         for c := 1 to width - 2 do begin
  201.             if L2[c + 1] >= 
  202.               thePattern[row mod DitherSize, c mod DitherSize] then
  203.               result[c - 1] := 255  { dither to black pixel }
  204.             else
  205.               result[c - 1] := 0;    { dither to white pixel }
  206.           end; {OrderedDither}
  207.           FloydSteinbergDither: 
  208.         for c := 1 to width - 2 do begin
  209.             value := L2[c + 1];
  210.             if value < 128 then begin
  211.             result[c - 1] := 0;
  212.             error := -value;
  213.               end
  214.             else begin
  215.             result[c - 1] := 255;
  216.             error := 255 - value
  217.               end;
  218.             tmp := L2[c + 2];          {A}
  219.             tmp := tmp - (7 * error) div 16;
  220.             if tmp < 0 then
  221.               tmp := 0;
  222.             if tmp > 255 then
  223.               tmp := 255;
  224.             L2[c + 2] := tmp;
  225.             tmp := L3[c + 2];          {B}
  226.             tmp := tmp - error div 16;
  227.             if tmp < 0 then
  228.               tmp := 0;
  229.             if tmp > 255 then
  230.               tmp := 255;
  231.             L3[c + 2] := tmp;
  232.             tmp := L3[c + 1];          {C}
  233.             tmp := tmp - (5 * error) div 16;
  234.             if tmp < 0 then
  235.               tmp := 0;
  236.             if tmp > 255 then
  237.               tmp := 255;
  238.             L3[c + 1] := tmp;
  239.             tmp := L3[c];        {D}
  240.             tmp := tmp - (3 * error) div 16;
  241.             if tmp < 0 then
  242.               tmp := 0;
  243.             if tmp > 255 then
  244.               tmp := 255;
  245.             L3[c] := tmp;
  246.           end; {FloydSteinbergDither}
  247.         end; {case filterType}
  248.         if UseMask then
  249.           PutLineUsingMask(left + 2, row, width - 3, result)
  250.         else
  251.           PutLine(left + 2, row, width - 3, result);
  252.         LineCount := LineCount + 1;
  253.         if LineCount = LinesPerUpdate then begin
  254.         pt.h := RoiRect.left;
  255.         pt.v := row + 1;
  256.         NewMark := pt.v;
  257.         with RoiRect do
  258.           SetRect(MaskRect, left, mark, right, NewMark);
  259.         UpdateScreen(MaskRect);
  260.         LineCount := 0;
  261.         Mark := NewMark;
  262.         if magnification > 1.0 then
  263.           Mark := Mark - 1;
  264.         if CommandPeriod then begin
  265.             UpdatePicWindow;
  266.             beep;
  267.             if AutoSelectAll then
  268.               KillRoi;
  269.             exit(UserFilter)
  270.           end;
  271.           end;
  272.       end; {for row:=...}
  273.     trect := frame;
  274.     InsetRect(trect, 1, 1);
  275.     ShowTime(StartTicks, trect, '');
  276.       end; {with}
  277.     if LineCount > 0 then begin
  278.     with frame do
  279.       SetRect(MaskRect, left, mark, right, bottom);
  280.     UpdateScreen(MaskRect)
  281.       end;
  282.     SetupRoiRect;
  283.     if AutoSelectAll then
  284.       KillRoi;
  285.   end;
  286.   procedure DoUserMenuEvent (MenuItem: integer);
  287.   begin
  288.     case MenuItem of  { User menu must be set up in this order }
  289.       1: 
  290.     UserFilter(LeeLocalStats);
  291.       2: 
  292.     UserFilter(OrderedDither);
  293.       3: 
  294.     UserFilter(FloydSteinbergDither);
  295.     end;
  296.   end;
  297. end.
  298.  
  299.