Category : Files from Magazines
Archive   : NOV92_1.ZIP
Filename : UNDITH.ASC

 
Output of file : UNDITH.ASC contained in archive : NOV92_1.ZIP
_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.



  3 Responses to “Category : Files from Magazines
Archive   : NOV92_1.ZIP
Filename : UNDITH.ASC

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/