unit FFTUnit; interface uses QuickDraw, OSIntf, PickerIntf, PrintTraps, ToolIntf, Globals, Utilities, Graphics, File1, Camera, Edit; procedure UpdateFFTMenu; procedure UpdateAutoMenu; procedure UpdatePowerSpectrum; procedure DoFFT; procedure DoInverseFFT; procedure ShowFFTValues (hloc, vloc, ivalue: LongInt); procedure ConfigureMaskNfilter; procedure ConfigureFFT; procedure DoDyadicOp; function Vignette: boolean; function DoPassOrFilter (roiRgn: RgnHandle; filter: boolean): boolean; function ThresholdZero: boolean; procedure DoFreqObject (obj: ObjectType; event: EventRecord); procedure SelectMaxFFT (visible: boolean); procedure DoBlockSwap; implementation procedure MeanZero (srcPtr: ptr; FHTBufsize: longint); external; procedure DblMem (srcPtr, destPtr: ptr; srcSize: longInt); external; procedure ClipMinMax (srcPtr: ptr; srcSize: longInt); external; procedure IntToByteF (srcPtr: ptr; destPtr: ptr; rowWords: integer); external; { Floating Point counterpart to IntToByte } procedure SwapBBlock (matPtr: ptr; rowBytes: integer); external; procedure transpose (iMatPtr: ptr; rowWords: integer); external; procedure ToRCFHT (iMatPtr: ptr; rowWords: integer); external; procedure psFHT2D (iMatPtr: ptr; destPtr: ptr; rowWords: integer; scaleType: integer); external; procedure ShiftRowsR (matPtr: ptr; rowWords: integer; maxShift: integer; ShfRowArr: ptr); external; procedure BitRevRows (matPtr: ptr; rowWords: integer; BitRevTbl: ptr); external; function FHT10 (baseAddr: ptr; rowWords: integer; TwidTbl: ptr): integer; external; procedure AddSub2BufsF (srcPtr1: ptr; srcPtr2: ptr; destPtr: ptr; srcScale1: integer; srcScale2: integer; var destScale: integer; srcSize: longint; operation: integer); external; procedure Hcdc2BufsF (srcPtr1: ptr; srcPtr2: ptr; destPtr: ptr; srcScale1: integer; srcScale2: integer; var destScale: integer; rowWords: integer; operation: integer); external; function IntRange (baseAddr: ptr; bufSize: longint): longint; external; function ByteRange (baseAddr: ptr; bufSize: longint): longint; external; function ByteAvgRect (baseAddr: ptr; pixelsPerLine: integer; roiWidth: integer; roiHeight: integer): integer; external; function RCFHT10 (x: ptr; rowWords: integer; var scale: integer): boolean; const CheckInterval = 64; type IntArr = array[0..0] of integer; IntArrPtr = ^IntArr; var BitRevH, TwidH: handle; shiftArr: IntArrPtr; maxShift, r, ShiftMag, rowBytes: integer; bufSize, offset: longint; procedure CheckAndQuit; begin if CommandPeriod then begin HUnlock(Handle(BitRevH)); HUnlock(Handle(TwidH)); Dispose(ptr(shiftArr)); exit(RCFHT10); end; end; begin RCFHT10 := false; shiftArr := IntArrPtr(NewPtr(BSL(rowWords, 1))); bufSize := longint(rowWords) * rowWords; BitRevH := GetResource('BREV', rowWords + 124); TwidH := GetResource('TWID', 129); if (TwidH = nil) or (BitRevH = nil) then begin PutMessage('NIL resource handles in RCFHT10'); exit(RCFHT10); end; Hlock(Handle(BitRevH)); BitRevRows(x, rowWords, BitRevH^); rowBytes := rowWords + rowWords; maxShift := 0; offset := 0; Hlock(Handle(TwidH)); for r := 0 to rowWords - 1 do begin ShiftArr^[r] := FHT10(ptr(ord4(x) + offset), rowWords, TwidH^); offset := offset + rowBytes; if ShiftArr^[r] > maxShift then maxShift := ShiftArr^[r]; if (r mod CheckInterval = 0) then CheckAndQuit; end; scale := maxShift; ShiftRowsR(x, rowWords, maxShift, ptr(shiftArr)); transpose(x, rowWords); BitRevRows(x, rowWords, BitRevH^); HUnlock(Handle(BitRevH)); maxShift := 0; offset := 0; for r := 0 to rowWords - 1 do begin ShiftArr^[r] := FHT10(ptr(ord4(x) + offset), rowWords, TwidH^); offset := offset + rowBytes; if ShiftArr^[r] > maxShift then maxShift := ShiftArr^[r]; if (r mod CheckInterval = 0) then CheckAndQuit; end; scale := scale + maxShift; HUnlock(Handle(TwidH)); ShiftRowsR(x, rowWords, maxShift, ptr(shiftArr)); transpose(x, rowWords); ToRCFHT(x, rowWords); Dispose(ptr(shiftArr)); RCFHT10 := true; end; { RCFHT10 } procedure UpdateFFTMenu; var roiWidth, roiHeight, numValidFFTWindows, i: integer; roiOKforFFT, roiOKforInverseFFT, roiOKforMask: boolean; windowOKforThresholdZero, roiOKforPassOrFilter: boolean; windowOKforBlockSwap, OKforDyadicOps: boolean; currentWindow: WindowRecord; currentInfo: InfoPtr; begin with FFTConfig, info^ do begin with osRoiRect do begin roiWidth := right - left; roiHeight := bottom - top; end; roiOKforMask := roiShowing and (roiType = RectRoi) and not InFrequencyDomain; roiOKforFFT := roiOKforMask and (roiWidth = roiHeight) and ((IsPowerOf2(roiWidth)) or xyScaled); roiOKforInverseFFT := InFrequencyDomain and (FHTBuf <> nil); windowOKforThresholdZero := roiOKforInverseFFT and Thresholding; roiOKforPassOrFilter := roiOKforInverseFFT and info^.roiShowing and (info^.roiType <> NoRoi); numValidFFTWindows := 0; for i := 1 to nPics do begin currentWindow := WindowPeek(PicWindow[i])^; currentInfo := InfoPtr(currentWindow.refCon); numValidFFTWindows := numValidFFTWindows + ord((currentWindow.WindowKind = FFTKind) and (currentInfo^.FHTBuf <> nil)); end; OKforDyadicOps := (numValidFFTWindows <> 0); windowOKforBlockSwap := (not InFrequencyDomain) and (pixelsPerLine = nLines) and IsPowerOf2(pixelsPerLine); SetMenuItem(FFTMenuH, FFTItem, roiOKforFFT); SetMenuItem(FFTMenuH, InverseFFTItem, roiOKforInverseFFT); SetMenuItem(FFTMenuH, DyadicOpsItem, OKforDyadicOps); SetMenuItem(FFTMenuH, FilterItem, roiOKforPassOrFilter); SetMenuItem(FFTMenuH, PassItem, roiOKforPassOrFilter); SetMenuItem(FFTMenuH, ThresholdZeroItem, windowOKforThresholdZero); SetMenuItem(FFTMenuH, MaskItem, roiOKforMask); SetMenuItem(FFTMenuH, UpdatePSItem, roiOKforInverseFFT); SetMenuItem(FFTMenuH, BlockSwapItem, windowOKforBlockSwap); end; { with FFTConfigÉ } end; procedure UpdateAutoMenu; begin with FFTConfig do begin CheckItem(AutoMenuH, AutoFilterItem, autoFilter); CheckItem(AutoMenuH, AutoPassItem, autoPass); CheckItem(AutoMenuH, AutoThreshZeroItem, autoThreshold); CheckItem(AutoMenuH, AutoMaskItem, autoMask); end; end; procedure UpdatePowerSpectrum; var tPort: GrafPtr; begin ShowWatch; with info^, FFTConfig do begin psFHT2D(FHTBuf, PicBaseAddr, pixelsPerLine, psScale); SwapBBlock(PicBaseAddr, pixelsPerLine); changes := true; if roiShowing then SetupUndo; if clipExtrema then ClipMinMax(PicBaseAddr, PicSize); GetPort(tPort); SetPort(wptr); InvalRect(wptr^.portRect); SetPort(tPort); end; end; procedure DoFFT; var ok, EnoughFFTMem: boolean; roiWidth, roiHeight, padColor, saveColor: integer; newTitle, FFTNumStr: str255; FHTBufSize: longint; sourcePort: cGrafPtr; sourceRect, tRect: rect; tempPtr: ptr; SaveInfo: InfoPtr; tPort: GrafPtr; procedure abort (SaveInfo: InfoPtr); var ignore: integer; begin SysBeep(0); info^.changes := false; ignore := CloseAWindow(info^.wptr); Info := SaveInfo; InFrequencyDomain := false; exit(DoFFT); end; begin if NotInBounds then exit(DoFFT); ShowWatch; SaveInfo := Info; with info^, FFTConfig do begin with osROIRect do begin roiWidth := right - left; roiHeight := bottom - top; end; if not IsPowerOf2(roiWidth) then begin PutMessage('Sorry, non-discrete sized FFTs not yet supported!'); exit(DoFFT); end; sourcePort := osPort; sourceRect := osROIRect; if doZeroPad or doAveragePad then begin roiWidth := BSL(roiWidth, 1); roiHeight := BSL(roiHeight, 1); end; FHTBufSize := longint(roiWidth) * roiHeight * 2; { integer matrix is twice as big } { allocate memory for FHTBuffer - react to result accordingly } if UseBigBufForFFT then begin WhatsOnClip := Nothing; tempPtr := BigBuf; EnoughFFTMem := (FHTBufSize < BigBufSize); end else begin tempPtr := NewPtr(FHTBufSize); EnoughFFTMem := (tempPtr <> nil) end; if not EnoughFFTMem then begin PutMessage('Sorry, but there''s not enough memory for the FFT buffer!'); exit(DoFFT); end; { got the memory, now find the average pad color, if padding enabled } if doAveragePad then with osRoiRect do padColor := ByteAvgRect(ptr(ord4(PicBaseAddr) + top * pixelsPerLine + left), pixelsPerLine, right - left, bottom - top) else padColor := 0; { no padding or Zero padding -> pad color is white } end; { with info^É } { open new pic window to appropriate size and name it using FFTNumber } NumToString(longint(FFTNumber), FFTNumStr); newTitle := concat('FFT ', FFTNumStr); InFrequencyDomain := true; { Tells MakeNewWindow to make FFT window } if not NewPicWindow(newTitle, roiWidth, roiHeight) then { changes Info! } begin if tempPtr <> BigBuf then Dispose(tempPtr); exit(DoFFT); end; Info^.FHTBuf := tempPtr; with info^, FFTConfig do begin { copy roi to new pic window } tRect := PicRect; if doZeroPad or doAveragePad then begin SetRect(tRect, 0, 0, PicRect.right div 2, PicRect.bottom div 2); osRoiRect := tRect; GetPort(tPort); SetPort(GrafPtr(osPort)); with osPort^ do begin saveColor := bkColor; bkColor := padColor; EraseRect(PicRect); bkColor := saveColor; end; SetPort(tPort); end; Hlock(Handle(sourcePort^.portPixMap)); Hlock(Handle(osPort^.portPixMap)); CopyBits(BitMapHandle(sourcePort^.portPixMap)^^, BitMapHandle(osPort^.portPixMap)^^, sourceRect, tRect, SrcCopy, nil); HUnlock(Handle(sourcePort^.portPixMap)); HUnlock(Handle(osPort^.portPixMap)); { if autoMask is set, then mask the new copyÉ } if autoMask then if not Vignette then abort(SaveInfo); UpdatePicWindow; { show the user what's being transformed } WhatToUndo := NothingToUndo; { can't Undo an FFT! - just close window } { DblMem to FHTBuf } DblMem(PicBaseAddr, FHTBuf, FHTBufsize div 2); { calculate mean and subtract to remove DC component if so desired } if doMeanZero then MeanZero(FHTBuf, FHTBufsize div 2); { Do the FFT } if not RCFHT10(FHTBuf, pixelsPerLine, FHTScale) then abort(SaveInfo); { Do the power Spectrum } UpdatePowerSpectrum; { Deal with ROI, undo } UndoFromClip := false; KillRoi; { reset FHTBuf if we just borrowed the memory from Undo & Clip } if UseBigBufForFFT then FHTBuf := nil; FFTNumber := FFTNumber + 1; end; end; procedure DoInverseFFT; var ok, EnoughFFTMem, wasThresholding: boolean; newTitle, InvFFTNumStr: str255; FHTBufSize: longint; sourcePort: cGrafPtr; sourceRect: rect; sourceFHTBuf, tempPtr: ptr; SaveInfo: InfoPtr; procedure abort (SaveInfo: InfoPtr); var ignore: integer; begin SysBeep(0); info^.changes := false; ignore := CloseAWindow(info^.wptr); Info := SaveInfo; InFrequencyDomain := true; exit(DoInverseFFT); end; begin ShowWatch; SaveInfo := Info; with info^, FFTConfig do begin sourcePort := osPort; sourceRect := PicRect; sourceFHTBuf := FHTBuf; FHTBufSize := PicSize * 2; { integer matrix is twice as big } { allocate memory for FHTBuffer - react to result accordingly } tempPtr := NewPtr(FHTBufSize); EnoughFFTMem := (tempPtr <> nil); if not EnoughFFTMem then begin PutMessage('Sorry, but there''s not enough memory for the FFT buffer!'); exit(DoInverseFFT); end; end; { with info^É } { open new pic window to appropriate size and name it using FFTNumber } wasThresholding := Thresholding; NumToString(longint(InverseFFTNumber), InvFFTNumStr); newTitle := concat('I FFT ', InvFFTNumStr); InFrequencyDomain := false; { Tells MakeNewWindow to make Space Domain Window } if not NewPicWindow(newTitle, info^.pixelsPerLine, info^.pixelsPerLine) then { changes Info! } begin Dispose(tempPtr); exit(DoInverseFFT); end; Info^.FHTBuf := tempPtr; with info^, FFTConfig do begin { BlockCopy from source's FHTBuf to Dest's FHTBuf: } BlockMove(sourceFHTBuf, FHTBuf, FHTBufSize); { copy ps image to new pic window } Hlock(Handle(sourcePort^.portPixMap)); Hlock(Handle(osPort^.portPixMap)); CopyBits(BitMapHandle(sourcePort^.portPixMap)^^, BitMapHandle(osPort^.portPixMap)^^, sourceRect, PicRect, SrcCopy, nil); HUnlock(Handle(sourcePort^.portPixMap)); HUnlock(Handle(osPort^.portPixMap)); { Do automatic Threshold Zeroing and/or Filtering/Passing } if autoThreshold and wasThresholding then if not ThresholdZero then abort(SaveInfo); if (autoPass or autoFilter) and (SaveInfo^.RoiType <> NoRoi) then if not DoPassOrFilter(SaveInfo^.osRoiRgn, autoFilter) then abort(SaveInfo); UpdatePicWindow; { show the user what's being transformed } WhatToUndo := NothingToUndo; { can't Undo an FFT! - just close window } { Do the FFT } if not RCFHT10(FHTBuf, pixelsPerLine, FHTScale) then abort(SaveInfo); {¥ FHTScale := FHTScale - 2 * round(log2(pixelsPerLine)); { equivalent of dividing by N^2 ¥]} { Map integers in FHTBuf into Bytes in osPort } IntToByteF(FHTBuf, PicBaseAddr, pixelsPerLine); { Deal with ROI, undo } UndoFromClip := false; KillRoi; changes := true; { Free Up unneeded memory - we're back in the space domain } Dispose(FHTBuf); FHTBuf := nil; FHTScale := 0; end; InverseFFTNumber := InverseFFTNumber + 1; end; function arctan2 (x, y: extended): extended; { returns angle in the correct quadrant } begin if x = 0 then x := 1E-30; { Could be improved } if x > 0 then if y >= 0 then arctan2 := arctan(y / x) else arctan2 := arctan(y / x) + 2 * pi else arctan2 := arctan(y / x) + pi; end; procedure ShowFFTValues (hloc, vloc, ivalue: LongInt); var tPort: GrafPtr; hstart, vstart: integer; CalibratedForLength: boolean; r, theta, center: extended; begin with info^ do begin hstart := ValuesHStart; vstart := ValuesVStart; GetPort(tPort); SetPort(ResultsWindow); TextSize(9); TextFont(Monaco); TextMode(SrcCopy); if hloc < 0 then hloc := -hloc; CalibratedForLength := SpatialScale <> 0.0; center := pixelsPerLine div 2; r := sqrt(sqr(hloc - center) + sqr(vloc - center)); theta := arctan2(hloc - center, center - vloc); theta := theta * 180 / pi; MoveTo(xValueLoc, vstart); if CalibratedForLength then begin DrawReal(pixelsPerLine / r / SpatialScale, 6, 2); DrawString(units); DrawString('/c '); DrawString('('); DrawReal(hloc - center, 4, 0); DrawString(')'); end else begin DrawReal(pixelsPerLine / r, 6, 2); DrawString('p/c '); DrawString('('); DrawReal(hloc - center, 4, 0); DrawString(')'); end; DrawString(' '); vloc := PicRect.bottom - vloc - 1; if vloc < 0 then vloc := -vloc; MoveTo(yValueLoc, vstart + 10); DrawReal(theta, 6, 2); TextMode(srcOr); DrawString('¡ '); TextMode(srcCopy); DrawString('('); DrawReal(vloc - center + 1, 4, 0); DrawString(')'); DrawString(' '); MoveTo(zValueLoc, vstart + 20); if Calibrated then begin DrawReal(value[ivalue], 6, 2); DrawString(' ('); DrawLong(ivalue); DrawString(')'); end else DrawLong(ivalue); DrawString(' '); SetPort(tPort); end; end; procedure ConfigureMaskNfilter; const DlogID = 8000; GaussianID = 3; CosineID = 4; LinearID = 5; ParabolicID = 6; PercentWidthID = 7; PixelWidthID = 8; MinLevelID = 9; MaxLevelID = 10; var myLog: DialogPtr; item: integer; saveConfig: MaskingConfiguration; begin myLog := GetNewDialog(DlogID, nil, pointer(-1)); OutlineButton(MyLog, ok, 16); saveConfig := MaskConfig; with MaskConfig do begin SetDialogItem(myLog, LinearID, ord(MaskMode = linear)); SetDialogItem(myLog, ParabolicID, ord(MaskMode = parabolic)); SetDialogItem(myLog, CosineID, ord(MaskMode = cosine)); SetDialogItem(myLog, GaussianID, ord(MaskMode = gaussian)); SetDString(myLog, percentWidthID, StringOf(percentWidth)); SetDString(myLog, pixelWidthID, StringOf(pixelWidth)); SelIText(myLog, pixelWidthID, 0, 32767); SetDString(myLog, MinLevelID, StringOf(minLevel)); SetDString(myLog, MaxLevelID, StringOf(maxLevel)); repeat repeat ModalDialog(nil, item); case item of GaussianID, CosineID, LinearID, ParabolicID: begin MaskMode := MaskingMode(item - 3); SetDialogItem(myLog, GaussianID, ord(item = GaussianID)); SetDialogItem(myLog, CosineID, ord(item = CosineID)); SetDialogItem(myLog, LinearID, ord(item = LinearID)); SetDialogItem(myLog, ParabolicID, ord(item = ParabolicID)); end; percentWidthID: begin percentWidth := GetDNum(myLog, percentWidthID); if (percentWidth < 0) or (percentWidth > 100) then begin percentWidth := saveConfig.percentWidth; SetDNum(mylog, percentWidthID, percentWidth); end; end; pixelWidthID: begin pixelWidth := GetDNum(myLog, pixelWidthID); if (pixelWidth < 0) or (pixelWidth > 1024) then begin pixelWidth := saveConfig.pixelWidth; SetDNum(mylog, pixelWidthID, pixelWidth); end; end; MinLevelID: begin minLevel := GetDNum(myLog, MinLevelID); if (minLevel < 0) or (minLevel > 100) then begin minLevel := saveConfig.minLevel; SetDNum(mylog, MinLevelID, minLevel); end; end; MaxLevelID: begin maxLevel := GetDNum(myLog, MaxLevelID); if (maxLevel < 0) or (maxLevel > 100) then begin maxLevel := saveConfig.maxLevel; SetDNum(mylog, MaxLevelID, maxLevel); end; end; otherwise end; until (item = OK) or (item = cancel); if (item = OK) and not (maxLevel > minLevel) then PutMessage('Maximum Level must be greater than Minimum Level!'); until (maxLevel > minLevel) or (item = cancel); end; { with tempConfig } DisposDialog(myLog); if (item = cancel) then MaskConfig := saveConfig; end; function lastItem: integer; begin with FFTConfig do case psScale of 0: lastItem := LinearItem; 2..9: lastItem := NthRootItem; otherwise lastItem := LogItem; end; end; procedure UpdateFFTPopUpMenu; var i: integer; begin with FFTConfig do begin CheckItem(PSScalingMenuH, LogItem, (psScale = 10)); CheckItem(PSScalingMenuH, LinearItem, (psScale = 0)); for i := 1 to 8 do CheckItem(NthRootMenuH, i, (psScale = i + 1)); end; end; procedure DrawFFTPopUp (theDialog: DialogPtr; { draw the PopUp Menu UserItem for the FFT Settings DialogÉ } item: integer); const PopUpMenuID = 10; { used by ConfigureFFT, FFTFilter and DrawFFTPopUp } var itemNo, itemType, fontHeight: integer; itemHandle: Handle; box: rect; MenuStr: str255; savePort: GrafPtr; begin GetPort(savePort); { !!!! Necessary? } SetPort(theDialog); GetDItem(theDialog, PopUpMenuID, itemtype, itemHandle, box); CalcMenuSize(PSScalingMenuH); box.right := box.left + PSScalingMenuH^^.menuWidth; { set up the box } GetItem(PSScalingMenuH, lastItem, MenuStr); { get the item string } PenNormal; with box do begin EraseRect(box); InsetRect(box, -1, -1); FrameRect(box); MoveTo(right, top + 2); LineTo(right, bottom); LineTo(left + 2, bottom); MoveTo(left + 15, bottom - 5); DrawString(MenuStr); end; SetPort(savePort); end; function FFTFilter (theDialog: DialogPtr; var theEvent: EventRecord; var ItemHit: integer): boolean; const crCode = 13; enterCode = 3; PopUpMenuID = 10; var itemNo, itemType: integer; itemHandle: Handle; PopUpBox, itemBox: rect; IDandItem: longint; theMenu, theMenuItem, WhichItem: integer; mouseLoc: point; ignoreLong: longint; begin SetPort(theDialog); FFTFilter := false; itemHit := 0; case theEvent.what of keyDown: begin if (theEvent.message mod 256) in [crCode, enterCode] then begin GetDItem(theDialog, OK, itemType, itemHandle, itemBox); HiliteControl(ControlHandle(itemHandle), 1); Delay(3, ignoreLong); FFTFilter := TRUE; itemHit := OK; { have ModalDialog return that the user hit OK } end; end; mouseDown: begin mouseLoc := theEvent.where; GlobalToLocal(mouseLoc); if (FindDItem(theDialog, mouseLoc) + 1 = PopUpMenuID) then { deal only with PopUp menu events } begin GetDItem(theDialog, PopUpMenuID, itemType, itemHandle, PopUpBox); LocalToGlobal(PopUpBox.topLeft); with PopUpBox do IDandItem := PopUpMenuSelect(PSScalingMenuH, top, left, lastItem); theMenu := HiWord(IDandItem); theMenuItem := LoWord(IDandItem); with FFTConfig do case theMenu of PSScalingMenu: case theMenuItem of LinearItem: psScale := 0; LogItem: psScale := 10; NthRootItem: ; { do nothing } end; { case theMenuItem } NthRootMenu: psScale := theMenuItem + 1; end; { case theMenu } UpdateFFTPopUpMenu; DrawFFTPopUp(theDialog, theMenuItem); FFTFilter := true; ItemHit := PopUpMenuID; end; { if FindDItemÉ; pass along all other events to ModalDialog } end; { mouseDown } end; { case theEvent.what ofÉ } end; { FFTFilter } procedure ConfigureFFT; const DlogID = 9000; DiscreteID = 3; ContinuousID = 4; NewBufID = 5; UseBigBufID = 6; doMeanZeroID = 7; doZeroPadID = 8; doAveragePadID = 9; PopUpMenuID = 10; ClipExtremaID = 11; var myLog: DialogPtr; item, itemType, tempInt: integer; itemHandle: handle; itemBox: rect; saveConfig: FFTConfiguration; begin UpdateFFTPopUpMenu; myLog := GetNewDialog(DlogID, nil, pointer(-1)); OutlineButton(MyLog, OK, 16); GetDItem(myLog, PopUpMenuID, itemType, itemHandle, itemBox); SetDItem(myLog, PopUpMenuID, itemType, @DrawFFTPopUp, itemBox); saveConfig := FFTConfig; with FFTConfig do begin SetDialogItem(myLog, ContinuousID, ord(xyScaled)); SetDialogItem(myLog, DiscreteID, ord(not xyScaled)); SetDialogItem(myLog, NewBufID, ord(not useBigBufForFFT)); SetDialogItem(myLog, UseBigBufID, ord(useBigBufForFFT)); SetDialogItem(myLog, doMeanZeroID, ord(doMeanZero)); SetDialogItem(myLog, doZeroPadID, ord(doZeroPad)); SetDialogItem(myLog, doAveragePadID, ord(doAveragePad)); SetDialogItem(myLog, ClipExtremaID, ord(clipExtrema)); repeat ModalDialog(@FFTFilter, item); case item of ContinuousID, DiscreteID: begin xyScaled := not xyScaled; SetDialogItem(myLog, ContinuousID, ord(xyScaled)); SetDialogItem(myLog, DiscreteID, ord(not xyScaled)); end; NewBufID, UseBigBufID: begin useBigBufForFFT := not useBigBufForFFT; SetDialogItem(myLog, NewBufID, ord(not useBigBufForFFT)); SetDialogItem(myLog, UseBigBufID, ord(useBigBufForFFT)); end; doMeanZeroID: begin doMeanZero := not doMeanZero; SetDialogItem(myLog, doMeanZeroID, ord(doMeanZero)); end; doZeroPadID: begin doZeroPad := not doZeroPad; doAveragePad := false; SetDialogItem(myLog, doZeroPadID, ord(doZeroPad)); SetDialogItem(myLog, doAveragePadID, ord(doAveragePad)); end; doAveragePadID: begin doAveragePad := not doAveragePad; doZeroPad := false; SetDialogItem(myLog, doAveragePadID, ord(doAveragePad)); SetDialogItem(myLog, doZeroPadID, ord(doZeroPad)); end; ClipExtremaID: begin clipExtrema := not clipExtrema; SetDialogItem(myLog, ClipExtremaID, ord(clipExtrema)); end; otherwise { PopUpMenuID taken care of in FFTFilter } end; until (item = OK) or (item = Cancel); end; { with FFTConfig } DisposDialog(myLog); if item = Cancel then FFTConfig := saveConfig; end; var ListAH, ListBH: ListHandle; { these are needed by the DyadicFilter function and ConfigureDyadicOp } procedure DrawListA (theDialog: DialogPtr; item: integer); var tRect: rect; begin PenNormal; tRect := ListAH^^.rView; InsetRect(tRect, -1, -1); FrameRect(tRect); LUpdate(theDialog^.visRgn, ListAH); end; procedure DrawListB (theDialog: DialogPtr; item: integer); var tRect: rect; begin PenNormal; tRect := ListBH^^.rView; InsetRect(tRect, -1, -1); FrameRect(tRect); LUpdate(theDialog^.visRgn, ListBH); end; function DyadicFilter (theDialog: DialogPtr; var theEvent: EventRecord; var ItemHit: integer): boolean; const crCode = 13; enterCode = 3; ListAID = 10; ListBID = 11; var itemNo, itemType, partCode: integer; ignoreLong: longint; itemHandle: Handle; itemBox, tRect: rect; mouseLoc: point; whichControl: ControlHandle; ignore: boolean; begin SetPort(theDialog); DyadicFilter := false; itemHit := 0; case theEvent.what of keyDown: begin if (theEvent.message mod 256) in [crCode, enterCode] then begin GetDItem(theDialog, OK, itemType, itemHandle, itemBox); HiliteControl(ControlHandle(itemHandle), 1); Delay(3, ignoreLong); HiliteControl(ControlHandle(itemHandle), 0); DyadicFilter := true; itemHit := OK; { have ModalDialog return that the user hit OK } end; end; mouseDown: begin mouseLoc := theEvent.where; GlobalToLocal(mouseLoc); partCode := FindControl(mouseLoc, theDialog, whichControl); if (partCode > 0) then if whichControl = ListAH^^.vScroll then begin ignore := LClick(mouseLoc, theEvent.modifiers, ListAH); DyadicFilter := true end else if whichControl = ListBH^^.vScroll then begin ignore := LClick(mouseLoc, theEvent.modifiers, ListBH); DyadicFilter := true end; if PtInRect(mouseLoc, ListAH^^.rView) then begin ignore := LClick(mouseLoc, theEvent.modifiers, ListAH); DyadicFilter := false; itemHit := ListAID; end else if PtInRect(mouseLoc, ListBH^^.rView) then begin ignore := LClick(mouseLoc, theEvent.modifiers, ListBH); DyadicFilter := false; itemHit := ListBID; end; end; { mouseDown } end; { case theEvent.what ofÉ } end; { DyadicFilter } function ConfigureDyadicOp (var srcPtr1, srcPtr2: ptr; var srcScale1, srcScale2: integer; var windowName: str255): boolean; const DlogID = 10000; AddID = 3; SubtractID = 4; MultiplyID = 5; DivideID = 6; ConjMultID = 7; AutoInverseID = 8; NewNameID = 9; ListAID = 10; ListBID = 11; type FHTrec = record Buf: ptr; scale: integer; end; BufArray = array[0..0] of FHTrec; BufArrayPtr = ^BufArray; var myLog: DialogPtr; NameChanged, MatchedFFTs: boolean; NewName: str255; item, itemType, listCount: integer; itemHandle, nameHandle: handle; itemBox, dataBounds: rect; saveConfig: FFTConfiguration; SelectedCell: cell; FHTArr: BufArrayPtr; procedure SetUpLists; var i, ignore, dataLength: integer; currentWindow: WindowRecord; currentInfo: InfoPtr; theCell, cSize: point; cellStr: str255; dataPtr: ptr; begin { SetUpLists } SetPt(cSize, 0, 0); SetRect(dataBounds, 0, 0, 1, 0); GetDItem(myLog, ListAID, itemType, itemHandle, itemBox); itemBox.right := itemBox.right - 15; { make room for scroll bar } ListAH := LNew(itemBox, dataBounds, cSize, 0, myLog, false, false, false, true); ListAH^^.selFlags := lOnlyOne + lNoNilHilite; GetDItem(myLog, ListBID, itemType, itemHandle, itemBox); itemBox.right := itemBox.right - 15; { make room for scroll bar } ListBH := LNew(itemBox, dataBounds, cSize, 0, myLog, false, false, false, true); ListBH^^.selFlags := lOnlyOne + lNoNilHilite; FHTArr := BufArrayPtr(NewPtr((nPics + 1) * sizeOf(FHTrec))); { Allocate storage for record list } listCount := 0; for i := 1 to nPics do begin currentWindow := WindowPeek(PicWindow[i])^; currentInfo := InfoPtr(currentWindow.refCon); if ((currentWindow.WindowKind = FFTKind) and (currentInfo^.FHTBuf <> nil)) then begin ignore := LAddRow(1, listCount, ListAH); ignore := LAddRow(1, listCount, ListBH); SetPt(theCell, 0, listCount); FHTArr^[listCount].Buf := currentInfo^.FHTBuf; FHTArr^[listCount].scale := currentInfo^.FHTScale; NumToString(currentInfo^.PicRect.right, cellStr); cellStr := concat(currentInfo^.title, ' ', cellStr); dataLength := Length(cellStr); dataPtr := ptr(ord4(@cellStr) + 1); LSetCell(dataPtr, dataLength, theCell, ListAH); LSetCell(dataPtr, dataLength, theCell, ListBH); listCount := listCount + 1; end; end; SetPt(theCell, 0, 0); LSetSelect(true, theCell, ListAH); LSetSelect(true, theCell, ListBH); LDoDraw(true, ListAH); LDoDraw(true, ListBH); end; { SetUpLists } function WhichCellSelected (list: listHandle): Cell; { returns the selected Cell } var i: integer; done: boolean; theCell: Cell; begin i := 0; done := false; while (i <= listCount - 1) and (not done) do begin SetPt(theCell, 0, i); done := LGetSelect(false, theCell, list); i := i + 1; end; WhichCellSelected := theCell; end; function DefaultName: str255; var i, dataLen, strIndex: integer; theCell: point; nameA, nameB, tempStr: str255; dataPtr: ptr; done: boolean; begin with FFTConfig do begin theCell := WhichCellSelected(ListAH); dataPtr := ptr(ord4(@nameA) + 1); { Odd valued pointer } dataLen := 255; LGetCell(dataPtr, dataLen, theCell, ListAH); nameA[0] := char(dataLen); strIndex := Pos(' ', nameA); Delete(nameA, strIndex, length(nameA) - strIndex + 1); theCell := WhichCellSelected(ListBH); dataPtr := ptr(ord4(@nameB) + 1); dataLen := 255; LGetCell(dataPtr, dataLen, theCell, ListBH); nameB[0] := char(dataLen); strIndex := Pos(' ', nameB); Delete(nameB, strIndex, length(nameB) - strIndex + 1); case FreqDomainOp of Add: tempStr := concat(nameA, ' + ', nameB); Subtract: tempStr := concat(nameA, ' - ', nameB); Multiply: tempStr := concat(nameA, ' x ', nameB); Divide: tempStr := concat(nameA, ' / ', nameB); ConjugateMultiply: tempStr := concat(nameA, ' x ', nameB, '*'); end; if autoInverseFFT then tempStr := concat('I (', tempStr, ')'); DefaultName := tempStr; end; end; begin { ConfigureDyadicOp } ConfigureDyadicOp := false; myLog := GetNewDialog(DlogID, nil, pointer(-1)); SetUpLists; GetDItem(myLog, ListAID, itemType, itemHandle, itemBox); SetDItem(myLog, ListAID, itemType, @DrawListA, itemBox); GetDItem(myLog, ListBID, itemType, itemHandle, itemBox); SetDItem(myLog, ListBID, itemType, @DrawListB, itemBox); with FFTConfig do begin SetDialogItem(myLog, autoInverseID, ord(autoInverseFFT)); SetDialogItem(myLog, AddID, ord(FreqDomainOp = Add)); SetDialogItem(myLog, SubtractID, ord(FreqDomainOp = Subtract)); SetDialogItem(myLog, MultiplyID, ord(FreqDomainOp = Multiply)); SetDialogItem(myLog, DivideID, ord(FreqDomainOp = Divide)); SetDialogItem(myLog, ConjMultID, ord(FreqDomainOp = ConjugateMultiply)); GetDItem(myLog, NewNameID, itemType, nameHandle, itemBox); windowName := DefaultName; SetIText(nameHandle, windowName); srcPtr1 := FHTArr^[0].Buf; srcPtr2 := FHTArr^[0].Buf; srcScale1 := FHTArr^[0].scale; srcScale2 := FHTArr^[0].scale; SelIText(myLog, NewNameID, 0, 32767); NameChanged := false; saveConfig := FFTConfig; ShowWindow(myLog); OutlineButton(myLog, OK, 16); repeat repeat ModalDialog(@DyadicFilter, item); case item of AddID, SubtractID, MultiplyID, DivideID, ConjMultID: begin FreqDomainOp := DyadicFDOp(item - 3); SetDialogItem(myLog, AddID, ord(FreqDomainOp = Add)); SetDialogItem(myLog, SubtractID, ord(FreqDomainOp = Subtract)); SetDialogItem(myLog, MultiplyID, ord(FreqDomainOp = Multiply)); SetDialogItem(myLog, DivideID, ord(FreqDomainOp = Divide)); SetDialogItem(myLog, ConjMultID, ord(FreqDomainOp = ConjugateMultiply)); if not NameChanged then begin windowName := DefaultName; SetIText(nameHandle, windowName); SelIText(myLog, NewNameID, 0, 32767); end; end; autoInverseID: with FFTConfig do begin autoInverseFFT := not autoInverseFFT; SetDialogItem(myLog, autoInverseID, ord(FFTConfig.autoInverseFFT)); if not NameChanged then begin windowName := DefaultName; SetIText(nameHandle, windowName); SelIText(myLog, NewNameID, 0, 32767); end; end; NewNameID: begin NameChanged := true; NewName := GetDString(myLog, NewNameID); end; ListAID: begin SelectedCell := WhichCellSelected(ListAH); LSetSelect(true, SelectedCell, ListAH); if not NameChanged then begin windowName := DefaultName; SetIText(nameHandle, windowName); SelIText(myLog, NewNameID, 0, 32767); end; srcPtr1 := FHTArr^[SelectedCell.v].Buf; srcScale1 := FHTArr^[SelectedCell.v].scale; end; ListBID: begin SelectedCell := WhichCellSelected(ListBH); LSetSelect(true, SelectedCell, ListBH); if not NameChanged then begin windowName := DefaultName; SetIText(nameHandle, windowName); SelIText(myLog, NewNameID, 0, 32767); end; srcPtr2 := FHTArr^[SelectedCell.v].Buf; srcScale2 := FHTArr^[SelectedCell.v].scale; end; otherwise { UserItems handled by DyadicFilter function } end; until (item = OK) or (item = Cancel); MatchedFFTs := (GetPtrSize(srcPtr1) = GetPtrSize(srcPtr2)); if not MatchedFFTs and (item = OK) then PutMessage('Dyadic operations only work on FFT pairs of equal dimensions.'); until (MatchedFFTs) or (item = Cancel); if item = OK then ConfigureDyadicOp := true else FFTConfig := saveConfig; end; { with } LDispose(ListAH); LDispose(ListBH); DisposDialog(myLog); Dispose(ptr(FHTArr)); end; { ConfigureDyadicOp } procedure DoDyadicOp; var srcPtr1, srcPtr2, destPtr: ptr; NewName: str255; bufSize: longint; rowWords, srcScale1, srcScale2, destScale: integer; SaveInfo: InfoPtr; procedure abort (SaveInfo: InfoPtr); var ignore: integer; begin SysBeep(0); info^.changes := false; ignore := CloseAWindow(info^.wptr); Info := SaveInfo; exit(DoDyadicOp); end; begin StopDigitizing; StopThresholding; SaveInfo := Info; if not ConfigureDyadicOp(srcPtr1, srcPtr2, srcScale1, srcScale2, NewName) then exit(DoDyadicOp); ShowWatch; bufSize := GetPtrSize(srcPtr1); rowWords := round(sqrt(bufSize / 2)); destPtr := NewPtr(bufSize); if destPtr = nil then begin PutMessage('Sorry, but there''s not enough memory for the FFT buffer!'); exit(DoDyadicOp); end; InFrequencyDomain := not FFTConfig.autoInverseFFT; { Tells MakeNewWindow what kind of window } if not NewPicWindow(newName, rowWords, rowWords) then { changes Info! } begin Dispose(destPtr); exit(DoDyadicOp); end; Info^.FHTBuf := destPtr; with FFTConfig, Info^ do begin case FreqDomainOp of Add: begin AddSub2BufsF(srcPtr1, srcPtr2, destPtr, srcScale1, srcScale2, destScale, bufSize div 2, 1); FHTScale := destScale; end; Subtract: begin AddSub2BufsF(srcPtr1, srcPtr2, destPtr, srcScale1, srcScale2, destScale, bufSize div 2, -1); FHTScale := destScale; end; Multiply: begin Hcdc2BufsF(srcPtr1, srcPtr2, destPtr, srcScale1, srcScale2, destScale, rowWords, -1); FHTScale := destScale; end; Divide: begin Hcdc2BufsF(srcPtr1, srcPtr2, destPtr, srcScale1, srcScale2, destScale, rowWords, 0); FHTScale := destScale; end; ConjugateMultiply: begin Hcdc2BufsF(srcPtr1, srcPtr2, destPtr, srcScale1, srcScale2, destScale, rowWords, 1); FHTScale := destScale; end; end; { Show the power spectrum } UpdatePowerSpectrum; UpdatePicWindow; if autoInverseFFT then begin if not RCFHT10(FHTBuf, pixelsPerLine, FHTScale) then { Do the FFT } abort(SaveInfo); IntToByteF(FHTBuf, PicBaseAddr, pixelsPerLine); { Map integers in FHTBuf into Bytes in osPort } Dispose(FHTBuf); { Free Up unneeded memory - we're back in the space domain } FHTBuf := nil; FHTScale := 0; end; { Deal with ROI, undo } WhatToUndo := NothingToUndo; { can't Undo an FFT! - just close window } UndoFromClip := false; KillRoi; changes := true; end; { with FFTConfig, Info^ É } end; { DoDyadicOp } function transitionColor (current, total: integer; minLevel, maxLevel: integer; MaskMode: MaskingMode): integer; var x: extended; begin x := extended(current / total); case MaskMode of gaussian: transitionColor := round((maxLevel - minLevel) * (exp(-5.7 * sqr(x))) + minLevel); cosine: transitionColor := round((maxLevel - minLevel) * ((cos(pi * x) + 1) / 2) + minLevel); linear: transitionColor := round((maxLevel - minLevel) * (1 - x) + minLevel); parabolic: transitionColor := round((maxLevel - minLevel) * (1 - sqr(x)) + minLevel); end; end; function Vignette: boolean; var i, roiWidth, roiHeight, pixWidth: integer; tPort: GrafPtr; undoPort: cGrafPtr; alertStr: str255; ovalRect, destRect: rect; selectionSize, selectionOffset: longint; MaskLinePtr, PicLinePtr: ptr; procedure CheckAndAbort; begin if CommandPeriod then begin SysBeep(0); Undo; WhatToUndo := NothingToUndo; SetPort(tPort); CloseCPort(undoPort); Dispose(undoPort); Exit(Vignette); end; end; procedure MaskLine (mask: ptr; pic: ptr; rowBytes: integer); {¥ procedure MaskLine masks the line of pixels (bytes) pointed to by pic ¥} {¥ according to the weights stored in mask. A mask byte of 255 will leave ¥} {¥ it corresponding pic pixel untouched, while a mask byte of 0 will zero ¥} {¥ out it's corresponding pic pixel. ¥} {¥ The formula used is: ¥} {¥ pic := round(mask/255 * pic) ¥} {¥ NOTE: FPU used here! ¥} inline $4E56, $0000, { LINK A6, #0 ; } $48E7, $E0C0, { MOVEM.L UsedRegs, -(SP) ; } $206E, $000A, { MOVEA.L mask(A6), A0 ; A0: mask } $226E, $0006, { MOVEA.L pic(A6), A1 ; A1: pic } $302E, $0004, { MOVE.W rowBytes(A6), D0 ; D0: rowBytes } $4241, { CLR.W D1 ; } $4242, { CLR.W D2 ; } $F23C, $5080, $00FF, { FMOVE.W #255, FP1 ; FP1: const } $5340, { SUBQ.W #1, D0 ; D0: counter } $1411, { loop MOVE.B (A1), D2 ; D2: pic Data } $1218, { MOVE.B (A0)+, D1 ; D1: mask Data } $6718, { BEQ.S ZeroOut ; } $0C01, $00FF, { CMP.B #$FF, D1 ; } $6716, { BEQ.S GoOn ; } $F201, $5000, { FMOVE.W D1, FP0 ; } $F200, $0420, { FDIV.X FP1, FP0 ; FP0: mask/255 } $F202, $5023, { FMUL.W D2, FP0 ; } $F202, $7000, { FMOVE.W FP0, D2 ; } $6008, { BRA.S StoreIt ; } $4202, { ZeroOut CLR.B D2 ; } $6004, { BRA.S StoreIt ; } $5249, { GoOn ADDQ.W #1, A1 ; } $6002, { BRA.S LoopBack ; } $12C2, { StoreIt MOVE.B D2, (A1)+ ; } $51C8, $FFD6, { LoopBack DBRA D0, loop ; } $4CDF, $0307, { exit MOVEM.L (SP)+, UsedRegs ; } $4E5E, { UNLK A6 ; } $DEFC, $000A; { ADDA.W #10, SP ; } begin { Vignette } if NotInBounds then exit(Vignette); Vignette := false; ShowWatch; StopDigitizing; with info^ do begin { first see if UndoBuf is large enough to hold mask } with osroiRect do begin roiWidth := right - left; roiHeight := bottom - top; end; selectionSize := longint(roiWidth) * roiHeight; if selectionSize > UndoBufSize then begin alertStr := concat('The selection is ', StringOf(selectionSize div 1024), 'K and the buffer'); alertStr := concat(alertStr, ' is only ', StringOf(UndoBufSize div 1024), 'K - Can''t complete operation'); PutMessage(alertStr); exit(Vignette); end; SetUpUndoFromClip; WhatToUndo := UndoMask; Changes := true; { now create a new offscreen cGrafPort with undoBuf as the base Addr } GetPort(tPort); New(undoPort); OpenCPort(undoPort); with undoPort^ do begin with portPixMap^^, destRect do begin baseAddr := undoBuf; rowBytes := roiWidth + $8000; top := 0; left := 0; right := roiWidth; bottom := roiHeight; bounds := destRect; end; PortRect := destRect; RectRgn(visRgn, destRect); SetRGBForeColor(ForegroundRGB, ForegroundIndex); SetRGBBackColor(BackgroundRGB, BackgroundIndex); end; { Erase the Rect to white } PenNormal; EraseRect(destRect); { paint pixwidth ovals within one another with correct transition color } ovalRect := destRect; with MaskConfig do begin pixWidth := round((percentWidth * (roiWidth div 2)) / 100); for i := pixWidth downto 1 do begin undoPort^.fgColor := longint(transitionColor(i, pixWidth, 0, 255, MaskMode)); FrameOval(ovalRect); InSetRect(ovalRect, 1, 1); if (i mod 64 = 0) then CheckAndAbort; end; end; { Paint interior of innermost oval black } undoPort^.fgColor := 255; { black } PaintOval(ovalRect); { for each line in osPort's roiRect and undoPort's destRect, subtract } { the undoPort line from the osPort line } MaskLinePtr := undoBuf; selectionOffset := longint(osroiRect.top) * pixelsPerLine + osroiRect.left; PicLinePtr := ptr(ord4(picBaseAddr) + selectionOffset); for i := 1 to roiHeight do begin MaskLine(MaskLinePtr, PicLinePtr, roiWidth); MaskLinePtr := ptr(ord4(MaskLinePtr) + roiWidth); PicLinePtr := ptr(ord4(PicLinePtr) + pixelsPerLine); if (i mod 64 = 0) then CheckAndAbort; end; SetupROIRect; { restore port and dispose of undoPort } SetPort(tPort); CloseCPort(undoPort); Dispose(undoPort); end; Vignette := true; end; { Vignette } function DoPassOrFilter (roiRgn: RgnHandle; filter: boolean): boolean; var row, i, BytesPerBufLine, minLevelInt, maxLevelInt, tempInt: integer; tPort: GrafPtr; undoPort: cGrafPtr; destRect: rect; BufLinePtr, MaskLinePtr: ptr; tempRgn: RgnHandle; procedure CheckAndAbort; begin if CommandPeriod then begin SysBeep(0); if tempRgn <> nil then DisposeRgn(tempRgn); SetPort(tPort); CloseCPort(undoPort); Dispose(undoPort); Exit(DoPassOrFilter); end; end; procedure PassFiltLine (mask: ptr; Buf: ptr; rowBytes: integer; filter: boolean); { procedure PassFiltLine is similar to MaskLine. If filter is false } { (pass is true) then PassFiltLine performs like MaskLine by scaling the Buf } { line (an array of integers instead of bytes as in MaskLine) according to } { the data in mask: A mask byte of 255 will leave it corresponding Buf integer } { untouched, while a mask byte of 0 will zero out it's corresponding Buf integer. } { The formula used is: } { Buf := round(mask/255 * Buf) } { If filter is true, however, exactly the opposite is done: A mask Byte of 255 } { will zero its corresponding Buf integer and a mask byte of 0 will pass its } { corresponding Buf integer. In this case the formula is } { Buf := round((255 - mask)/255 * Buf) } { NOTE: the FPU is used here. } inline $4E56, $0000, { LINK A6, #0 ; } $48E7, $F0C0, { MOVEM.L UsedRegs, -(SP) ; } $206E, $000C, { MOVEA.L mask(A6), A0 ; A0: mask } $226E, $0008, { MOVEA.L Buf(A6), A1 ; A1: Buf } $302E, $0006, { MOVE.W rowBytes(A6), D0 ; D0: rowBytes } $322E, $0004, { MOVE.W filter(A6), D1 ; D1: filter } $4242, { CLR.W D2 ; } $F23C, $5080, $00FF, { FMOVE.W #255, FP1 ; FP1: const } $5340, { SUBQ.W #1, D0 ; D0: counter } $3611, { loop MOVE.W (A1), D3 ; D3: Buf Data } $1418, { MOVE.B (A0)+, D2 ; D2: mask Data } $0801, $0008, { BTST.L #8, D1 ; } $6706, { BEQ.S pass ; } $0442, $00FF, { SUB.W #255, D2 ; } $4442, { NEG.W D2 ; } $4A42, { pass TST.W D2 ; } $6718, { BEQ.S ZeroOut ; } $0C02, $00FF, { CMP.B #$FF, D2 ; } $6716, { BEQ.S GoOn ; } $F202, $5000, { FMOVE.W D2, FP0 ; } $F200, $0420, { FDIV.X FP1, FP0 ; FP0: mask/255 } $F203, $5023, { FMUL.W D3, FP0 ; } $F203, $7000, { FMOVE.W FP0, D3 ; } $6008, { BRA.S StoreIt ; } $4243, { ZeroOut CLR.W D3 ; } $6004, { BRA.S StoreIt ; } $5449, { GoOn ADDQ.W #2, A1 ; } $6002, { BRA.S LoopBack ; } $32C3, { StoreIt MOVE.W D3, (A1)+ ; } $51C8, $FFC8, { LoopBack DBRA D0, loop ; } $4CDF, $030F, { exit MOVEM.L (SP)+, UsedRegs ; } $4E5E, { UNLK A6 ; } $DEFC, $000C; { ADDA.W #12, SP ; } begin { DoPassOrFilter } DoPassOrFilter := false; ShowWatch; StopDigitizing; with info^ do begin { create a new offscreen cGrafPort with undoBuf as the base Addr } GetPort(tPort); New(undoPort); OpenCPort(undoPort); with undoPort^ do begin with portPixMap^^ do begin baseAddr := UndoBuf; rowBytes := PixelsPerLine + $8000; bounds := PicRect; end; PortRect := PicRect; RectRgn(visRgn, PicRect); SetRGBForeColor(ForegroundRGB, ForegroundIndex); SetRGBBackColor(BackgroundRGB, BackgroundIndex); end; PenNormal; tempRgn := NewRgn; CopyRgn(roiRgn, tempRgn); with MaskConfig do begin minLevelInt := round(minLevel / 100 * 255); maxLevelInt := round(maxLevel / 100 * 255); if filter then begin tempInt := 255 - maxLevelInt; maxLevelInt := 255 - minLevelInt; minLevelInt := tempInt; end; undoPort^.fgColor := minLevelInt; PaintRect(PicRect); for i := pixelWidth downto 1 do begin undoPort^.fgColor := transitionColor(i, pixelWidth, minLevelInt, maxLevelInt, MaskMode); FrameRgn(tempRgn); InSetRgn(tempRgn, 1, 1); if (i mod 64 = 0) then CheckAndAbort; end; undoPort^.fgColor := maxLevelInt; PaintRgn(tempRgn); end; DisposeRgn(tempRgn); tempRgn := nil; { for each line in the FHTBuf and undoPort weight the FHTBuf line according to the } { value of the mask built above in the undoPort } SwapBBlock(UndoBuf, pixelsPerLine); MaskLinePtr := UndoBuf; BufLinePtr := FHTBuf; BytesPerBufLine := pixelsPerLine * 2; for i := 1 to nLines do begin PassFiltLine(MaskLinePtr, BufLinePtr, pixelsPerLine, filter); MaskLinePtr := ptr(ord4(MaskLinePtr) + pixelsPerLine); BufLinePtr := ptr(ord4(BufLinePtr) + BytesPerBufLine); if (i mod 64 = 0) then CheckAndAbort; end; { restore port and dispose of undoPort } SetPort(tPort); CloseCPort(undoPort); Dispose(undoPort); UpdatePowerSpectrum; changes := true; end; DoPassOrFilter := true; end; { DoPassOrFilter } function ThresholdZero: boolean; var row, BytesPerBufLine: integer; PicPtr, BufPtr: ptr; procedure CheckAndAbort; begin if CommandPeriod then begin SysBeep(0); Exit(ThresholdZero); end; end; procedure ThreshZeroLine (Buf: ptr; pic: ptr; TStart: integer; TEnd: integer; rowBytes: integer); { procedure ThreshZeroLine masks the line of integers in the FHTBuffer line } { pointed to by Buf according to the values TStart, TEnd and the pixel (byte) } { values pointed to by pic. If the byte pointed to by pic (+ pixel offset) } { falls between TStart and TEnd inclusive, then the corresponding word in } { Buf is zeroed; otherwise the word is left untouched. } { NOTE for this to work, the pic must be 'unswapped' with SwapBBlock to } { match the inherently 'unswapped' state of the FHTBuf } inline $4E56, $0000, { LINK A6, #0 ; } $48E7, $F0C0, { MOVEM.L UsedRegs, -(SP) ; } $206E, $000E, { MOVEA.L Buf(A6), A0 ; A0: Buf } $226E, $000A, { MOVEA.L pic(A6), A1 ; A1: pic } $302E, $0004, { MOVE.W rowBytes(A6), D0 ; D0: rowBytes } $322E, $0008, { MOVE.W TStart(A6), D1 ; D1: ThresholdStart } $342E, $0006, { MOVE.W TEnd(A6), D2 ; D2: ThresholdEnd (TEnd > TStart) } $5340, { SUBQ.W #1, D0 ; D0: count } $4243, { CLR.W D3 ; } $1619, { loop MOVE.B (A1)+, D3 ; } $B641, { CMP.W D1, D3 ; } $6D08, { BLT.S GoOn1 ; } $B642, { CMP.W D2, D3 ; } $6E04, { BGT.S GoOn1 ; } $4258, { CLR.W (A0)+ ; } $6002, { BRA.S GoOn2 ; } $5448, { GoOn1 ADDA.W #2, A0 ; } $51C8, $FFEE, { GoOn2 DBRA.W D0, loop ; } $4CDF, $030F, { exit MOVEM.L (SP)+, UsedRegs ; } $4E5E, { UNLK A6 ; } $DEFC, $000E; { ADDA.W #14, SP ; } begin { ThresholdZero } ThresholdZero := false; WhatToUndo := NothingToUndo; ShowWatch; with info^ do begin PicPtr := PicBaseAddr; BufPtr := FHTBuf; BytesPerBufLine := PixelsPerLine * 2; SwapBBlock(PicPtr, PixelsPerLine); for row := 1 to nLines do begin ThreshZeroLine(BufPtr, PicPtr, ThresholdStart, ThresholdEnd, PixelsPerLine); BufPtr := ptr(ord4(BufPtr) + BytesPerBufLine); PicPtr := ptr(ord4(PicPtr) + PixelsPerLine); if row mod 64 = 0 then CheckAndAbort; { if you quit here, you wind up with GARBAGE - not UndoAble! } end; end; UpdatePowerSpectrum; ThresholdZero := true; end; function ReflectPt (myPt, aboutPt: point): point; { reflects myPt through aboutPt } begin ReflectPt.h := BSL(aboutPt.h, 1) - myPt.h; ReflectPt.v := BSL(aboutPt.v, 1) - myPt.v; end; function ReflectRect (myRect: rect; aboutPt: point): rect; var tRect: rect; begin tRect.topLeft := ReflectPt(myRect.botRight, aboutPt); tRect.botRight := ReflectPt(myRect.topLeft, aboutPt); OffsetRect(tRect, 1, 1); ReflectRect := tRect; end; procedure CenterRect (aboutPix, corner: point; var myRect: rect); var tPoint: point; { given a corner of a rectangel and a central pixel, returns in myRect } { a rectangle centered on this pixel } begin tPoint := ReflectPt(corner, aboutPix); with tPoint do begin h := h + 1; v := v + 1; end; Pt2Rect(corner, tPoint, myRect); end; procedure DoFreqSelection (osRgn: RgnHandle); var tRect1, tRect2: rect; osCenter: point; temp: integer; TempRgn: RgnHandle; begin WhatToUndo := NothingToUndo; Info^.RoiShowing := false; if EmptyRgn(osRgn) then exit(DoFreqSelection); with info^ do begin RoiShowing := true; if SelectionMode <> NewSelection then TempRgn := NewRgn; PenNormal; OpenRgn; FrameRgn(osRgn); roiType := RgnRoi; if SelectionMode = NewSelection then CloseRgn(osroiRgn) else begin CloseRgn(TempRgn); if RgnNotTooBig(osroiRgn, TempRgn) then begin if SelectionMode = AddSelection then UnionRgn(osroiRgn, TempRgn, osroiRgn) else begin DiffRgn(osroiRgn, TempRgn, osroiRgn); UpdatePicWindow; end; end; DisposeRgn(TempRgn); if GetHandleSize(handle(osroiRgn)) = 10 then roiType := RectRoi else roiType := RgnRoi; end; osroiRect := osroiRgn^^.rgnBBox; roiRect := osroiRect; OffscreenToScreenRect(roiRect); end; measuring := false; end; procedure DoFreqObject (obj: ObjectType; event: EventRecord); var Start, Finish, Center, osCenter, ScreenStart, ScreenFinish, osStart, osFinish: point; sRect, osRect: rect; ff, DeltaX, DeltaY, switch, imag, r: integer; dummyLong: longint; Centered, Constrained: boolean; sRgn, osRgn, sClipRgn, osClipRgn, tRgn: RgnHandle; begin DrawLabels('r:', 'theta', 'Value:'); start := event.where; osStart := start; ScreenToOffscreen(osStart); finish := start; sRgn := NewRgn; osRgn := NewRgn; sClipRgn := NewRgn; osClipRgn := NewRgn; tRgn := NewRgn; sRect := info^.PicRect; RectRgn(osClipRgn, sRect); OffscreenToScreenRect(sRect); RectRgn(sClipRgn, sRect); with osCenter do begin h := info^.PicRect.right div 2; v := h; end; Center := osCenter; OffscreenToScreen(Center); with info^ do begin imag := trunc(magnification + 0.5); ff := imag div 2; end; PenMode(patXOR); PenSize(imag, imag); PenPat(pat[PatIndex]); while button do begin Constrained := ShiftKeyDown; Centered := CommandKeyDown; GetMouse(finish); osFinish := finish; ScreenToOffscreen(osFinish); with osFinish do ShowFFTValues(h, v, MyGetPixel(h, v)); if not Constrained and not Centered then begin Pt2Rect(start, finish, sRect); osRect := sRect; ScreenToOffscreenRect(osRect); end else if Constrained and not Centered then begin DeltaX := finish.h - start.h; DeltaY := finish.v - start.v; if ((DeltaX > 0) and (DeltaY < 0)) or ((DeltaX < 0) and (DeltaY > 0)) then switch := -1 else switch := 1; if abs(DeltaX) > abs(DeltaY) then finish.h := start.h + switch * DeltaY else finish.v := start.v + switch * DeltaX; Pt2Rect(start, finish, sRect); osRect := sRect; ScreenToOffscreenRect(osRect); end else if Centered then begin if Constrained then { selection size must have odd width and height - all operations done in os } begin SubPt(osCenter, osFinish); if abs(osFinish.h) > abs(osFinish.v) then osFinish.h := osFinish.v else osFinish.v := osFinish.h; AddPt(osCenter, osFinish); end; CenterRect(osCenter, osFinish, osRect); sRect := osRect; OffscreenToScreenRect(sRect); end; case obj of SelectionRect: begin OpenRgn; FrameRect(sRect); CloseRgn(sRgn); if not Centered then begin sRect := ReflectRect(sRect, center); OpenRgn; FrameRect(sRect); CloseRgn(tRgn); UnionRgn(sRgn, tRgn, sRgn); end; end; RoundedRect: begin OpenRgn; FrameRoundRect(sRect, OvalSize, OvalSize); CloseRgn(sRgn); if not Centered then begin sRect := ReflectRect(sRect, center); OpenRgn; FrameRoundRect(sRect, OvalSize, OvalSize); CloseRgn(tRgn); UnionRgn(sRgn, tRgn, sRgn); end; end; SelectionOval: begin OpenRgn; FrameOval(sRect); CloseRgn(sRgn); if not Centered then begin sRect := ReflectRect(sRect, center); OpenRgn; FrameOval(sRect); CloseRgn(tRgn); UnionRgn(sRgn, tRgn, sRgn); end; end; end; { case } SectRgn(sRgn, sClipRgn, sRgn); PatIndex := (PatIndex + 1) mod 8; PenPat(pat[PatIndex]); FrameRgn(sRgn); delay(3, dummyLong); FrameRgn(sRgn); end; { while buttonÉ } if not EqualPt(start, finish) then begin case obj of SelectionRect: begin OpenRgn; FrameRect(osRect); CloseRgn(osRgn); if not Centered then begin osRect := ReflectRect(osRect, osCenter); OpenRgn; FrameRect(osRect); CloseRgn(tRgn); UnionRgn(osRgn, tRgn, osRgn); end; end; SelectionOval: begin OpenRgn; FrameOval(osRect); CloseRgn(osRgn); if not Centered then begin osRect := ReflectRect(osRect, osCenter); OpenRgn; FrameOval(osRect); CloseRgn(tRgn); UnionRgn(osRgn, tRgn, osRgn); end; end; RoundedRect: begin OpenRgn; FrameRoundRect(osRect, OvalSize, OvalSize); CloseRgn(osRgn); if not Centered then begin osRect := ReflectRect(osRect, osCenter); OpenRgn; FrameRoundRect(osRect, OvalSize, OvalSize); CloseRgn(tRgn); UnionRgn(osRgn, tRgn, osRgn); end; end; end; { Case } SectRgn(osRgn, osClipRgn, osRgn); DoFreqSelection(osRgn); end; { if not EqualPtÉ } DisposeRgn(sRgn); DisposeRgn(sClipRgn); DisposeRgn(osClipRgn); DisposeRgn(tRgn); DisposeRgn(osRgn); end; { DoFreqObject } procedure SelectMaxFFT (visible: boolean); var loc: point; tPort: GrafPtr; begin if Info = NoInfo then begin beep; exit(SelectMaxFFT) end; KillRoi; with Info^ do begin RoiType := RectRoi; with osRoiRect do begin top := 0; left := 0; if PicRect.right < PicRect.bottom then right := PicRect.right { take minimum dimension } else right := PicRect.bottom; if not FFTConfig.xyScaled then right := pOf2(right); bottom := right; end; roiRect := osRoiRect; OffscreenToScreenRect(roiRect); MakeRegion; if visible then begin SetupUndo; WhatToUndo := NothingToUndo; RoiShowing := true; if (magnification > 1.0) and not ScaleToFitWindow then Unzoom; PreviousTool := CurrentTool; CurrentTool := SelectionTool; GetPort(tPort); SetPort(ToolWindow); EraseRect(ToolRect[PreviousTool]); EraseRect(ToolRect[CurrentTool]); InvalRect(ToolRect[PreviousTool]); InvalRect(ToolRect[CurrentTool]); SetPort(tPort); end; IsInsertionPoint := false; measuring := false; end; {with} end; { SelectMaxFFT } procedure DoBlockSwap; begin with info^ do begin changes := true; SwapBBlock(PicBaseAddr, PixelsPerLine); WhatToUndo := NothingToUndo; if roiShowing then SetupUndo; UpdatePicWindow; end; end; end. { FFTUnit }