UNIT PCMD1; {Blend two images}
INTERFACE
{$R-} { range checking off}
{$SC+} { short circuit AND & OR statements in IF's}
USES memtypes, OSIntf, ToolIntf, Sane, PackIntf;
CONST
MaxPixelsPerLine = 2048;
WhiteC = 0;
BlackC = 255;
{returnCodes}
No_Change = 0;
CMDperiod = -10000;
Changed = -20000;
CMDperiod_and_changed = -30000;
TYPE
PCmdBlock = RECORD
Primary : ptr; {all changes are made to primary}
Secondary : ptr; {NIL if it couldn't load, or didn't exist}
OptionKeyDownCall : boolean;
ShiftKeyDownCall : boolean;
NLines : integer;
PixelsPerLine : integer;
BytesPerRow : integer;
sPixelsPerLine : integer;
sBytesPerRow : integer;
sNLines : integer;
RoiRect : rect;
Rectangular : boolean; {T/F}
mask : ptr;
ReturnCode : OSErr; {0=okay, <0 = changed,CommandPeriod, or both}
FgColor : integer;
iScale:extended; {extended - # of pixels per unit}
iunits:string[2]; {2 characters - calibration units}
MyOSPort : GrafPtr;
END;
PCmdBlockPtr = ^PcmdBlock;
UnsignedByte=0..255;
LineType=PACKED ARRAY[0..MaxPixelsperLine] OF UnsignedByte;
SArray=Array[1..21] of integer;{25 minus 4 corner pixels}
{ MAIN entry point}
PROCEDURE DoPCommand (pData1:PCmdBlockptr);
IMPLEMENTATION
PROCEDURE DoPCommand (pData1:PCmdBlockptr);
VAR
pData : PCMDBlock;
PROCEDURE dumbBeep;
BEGIN
sysbeep(1);
END;
FUNCTION blankLine : linetype;
VAR i:integer;
jl : linetype;
BEGIN
for i:=0 to MaxPixelsPerLine-1 do
jl[i]:=whiteC;
blankline:=jl;
END; {blankline}
PROCEDURE GetLine(h,v,count:integer; VAR line:LineType);
VAR
offset:LongInt;
p:ptr;
BEGIN
IF pdata.primary=NIL then
BEGIN
line:=BlankLine;
exit(GetLine);
END;
IF (h<0) OR (v<0) OR
((h+count)>pdata.PixelsPerLine)
OR (v>=pdata.nlines) THEN
BEGIN
line:=BlankLine;
exit(GetLine);
END;
offset:=LongInt(v)*pdata.BytesPerRow+h;
p:=ptr(ord4(pdata.Primary)+offset);
BlocKMove(p,@line,count);
END; {getline}
PROCEDURE GetBGLine(h,v,count:integer; VAR line:LineType);
VAR
offset:LongInt;
p:ptr;
BEGIN
IF pdata.secondary=NIL then
BEGIN
line:=BlankLine;
exit(GetBGLine);
END;
IF (h<0) OR (v<0) OR
((h+count)>pdata.sPixelsPerLine)
OR (v>=pdata.snlines) THEN
BEGIN
line:=BlankLine;
exit(GetBGLine);
END;
offset:=LongInt(v)*pdata.sBytesPerRow+h;
p:=ptr(ord4(pdata.secondary)+offset);
BlocKMove(p,@line,count);
END; {getBGline}
PROCEDURE GetMaskLine(h,v,count:integer; VAR line:LineType);
VAR
offset:LongInt;
p:ptr;
BEGIN
IF pdata.mask=NIL then
BEGIN
line:=BlankLine;
exit(GetMaskLine);
END;
IF (h<0) OR (v<0) OR
((h+count)>pdata.PixelsPerLine)
OR (v>=pdata.nlines) THEN
BEGIN
line:=BlankLine;
exit(GetMaskLine);
END;
offset:=LongInt(v)*pdata.BytesPerRow+h;
p:=ptr(ord4(pdata.mask)+offset);
BlocKMove(p,@line,count);
END; {getMaskline}
PROCEDURE PutLine(h,v,count:integer; VAR line:LineType);
VAR
offset:LongInt;
p:ptr;
BEGIN
if pdata.primary=NIL then exit(putLine);
IF (h<0) OR (v<0) OR (v>=pdata.nlines) THEN exit(PutLine);
IF (h+count)>pdata.PixelsPerLine THEN count:=pdata.PixelsPerLine-h;
offset:=LongInt(v)*pdata.BytesPerRow+h;
p:=ptr(ord4(pdata.primary)+offset);
BlocKMove(@line,p,count);
END;{PutLine}
PROCEDURE GetLineUsingMask(h,v,count:integer; var line:linetype; padcolor:integer);
VAR {only needed when eroding/dilating & the boundaries are
assumed to be a special color}
line2 : linetype;
i: integer;
BEGIN
getline (h,v,count,line);
getline(h,v,count,line2);
FOR i:=0 to count-1 DO
if line2[i]<>pdata.fgcolor THEN line[i]:=padcolor;
END;{GetLineUsingMask}
PROCEDURE PutLineUsingMask(h,v,count:integer; VAR line:LineType);
VAR
aLine,MaskLine:LineType;
i:integer;
BEGIN
GetLine(h,v,count,aline);
GetMaskLine(h,v,count,MaskLine);
FOR i:=0 TO count-1 DO
IF MaskLine[i]=pdata.fgcolor THEN aLine[i]:=line[i];
PutLine(h,v,count,aLine);
END;
FUNCTION CommandPeriod:boolean;
TYPE
KeyPtrType=^KeyMap;
VAR
KeyPtr:KeyPtrType;
keys:ARRAY[0..3] OF LongInt;
event : eventrecord;
BEGIN
systemtask;
KeyPtr:=KeyPtrType(@keys);
GetKeys(KeyPtr^);
CommandPeriod:=(BAND(keys[1],$808000))=$808000;
END;
PROCEDURE SetDialogItem(TheDialog:DialogPtr; item,value:integer);
VAR
ItemType:integer;
ItemBox:rect;
ItemHdl:handle;
BEGIN
GetDItem (TheDialog,item,ItemType,ItemHdl,ItemBox);
SetCtlValue(ControlHandle(ItemHdl),value)
END;{SetDialogItem}
PROCEDURE ShowWatch;
VAR
watch:CursHandle;
BEGIN
watch := GetCursor(WatchCursor);
SetCursor(watch^^);
END;
PROCEDURE OutlineButton(theDialog: DialogPtr; itemNo, CornerRad: integer);
{ Draws a border around a button. 16 is the normal
cornerRad for small buttons }
VAR
itemType: Integer;
itemBox: Rect;
itemHdl: Handle;
tempPort: GrafPtr;
BEGIN
GetPort(tempPort);
SetPort(theDialog);
GetDItem(theDialog, itemNo, itemType, itemHdl, itemBox);
PenSize(3, 3);
InSetRect(itemBox, -4, -4);
FrameRoundRect(itemBox, cornerRad, cornerRad);
PenSize(1,1);
SetPort(tempPort);
END;{OutlineButton}
FUNCTION GetDNum(TheDialog:DialogPtr; item:integer):LongInt;
VAR
ItemType:integer;
ItemBox:rect;
ItemHdl:handle;
str:str255;
n:LongInt;
BEGIN
GetDItem (TheDialog,item,ItemType,ItemHdl,ItemBox);
GetIText(ItemHdl,str);
{look for '.' and use everything before that character...}
StringToNum(str,n);
GetDNum:=n;
END;
VAR
i,j,h,k : integer; {i,j=coordinates for scanning entire area}
irect : rect;
L1,L2 : linetype; {space for incoming lines}
Result : linetype; {result from processing}
ptr1,ptr2 : ^linetype;
width,height : integer;
mylog : dialogptr;
t:longint;
BEGIN {blend}
pdata:=pdata1^;
irect:=pdata.roirect; {bottom is not inclusive in process area}
with irect,pdata DO
BEGIN
if (top>sNLines) OR (left>sPixelsperLine) THEN
Begin
sysbeep(1);
exit(DoPcommand);
END;
if right>sPixelsPerLine THEN right:=sPixelsperline;
if bottom>sNLines then bottom:=sNLines;
width:=right-left;
height:=bottom-top;
END;
k:=50;
initcursor;
mylog:=GetNewDialog(2000,nil,pointer(-1));
OutlineButton(MyLog,ok,16);
SelIText(mylog,3,0,32000);
Repeat {until OK or cancel}
ModalDialog(Nil,i);
IF (i=3) THEN
k:=GetDNum(mylog,3);
Until (i=OK) or (i=cancel);
DisposDialog(mylog);
IF (i=cancel) THEN
BEGIN
pdata.ReturnCode:=pdata.ReturnCode+CMDperiod;
pdata1^:=pdata;
Exit(DoPCommand);
END;
if k<0 then k:=0;
if k>100 then k:=100;
showwatch;
pdata.ReturnCode:=changed;
h:=100-k;
FOR i:=irect.top to irect.bottom-1 DO
BEGIN
GetLine(irect.left,i,width,L1);
GetBGLine(irect.left,i,width,L2);
for j:=1 to width DO
BEGIN
t:=(k*L2[j]+h*L1[j]) Div 100;
L1[j]:=t;
END;
if pdata.rectangular THEN
PutLine(irect.left,i,width,L1)
ELSE
PutLineUsingMask(irect.left,i,width,L1);
IF commandperiod then
BEGIN
sysbeep(1);
pdata.ReturnCode:=pdata.ReturnCode+CMDperiod;
pdata1^:=pdata;
Exit(DoPCommand);
END;
END; {for i}
pData1^:=pdata;
END; {DoPCommand}
END. {UNIT}