home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / source / image144.sit / Camera.p < prev    next >
Encoding:
Text File  |  1992-03-20  |  26.6 KB  |  981 lines

  1. unit Camera;
  2.  
  3. {Routines used by the Image program for supporting the Data Translation}
  4. {QuickCapture card and the Scion Image Capture 2.}
  5.  
  6. interface
  7.  
  8.  
  9.     uses
  10.         QuickDraw, Palettes, PrintTraps, globals, Utilities, Graphics, File1;
  11.  
  12.  
  13.     procedure AverageFrames;
  14.     procedure CaptureAndDisplayQCFrame;
  15.     procedure HighlightPixels;
  16.     procedure ShowTriggerMessage;
  17.     procedure StartDigitizing;
  18.     procedure StopDigitizing;
  19.     procedure SetVideoChannel;
  20.     function GetQCPixel (h, v: integer): integer;
  21.     procedure CopyOffscreen (src, dst: PixMapHandle; sRect, dRect: rect);
  22.     procedure GetQuickCaptureFrame;
  23.     procedure GetScionFrame (DisplayPoint: point);
  24.     procedure WaitForTrigger;
  25.     procedure DoVideoOptions;
  26.  
  27.  
  28.  
  29. implementation
  30.  
  31.     type
  32.         IntPtr = ^integer;
  33.  
  34.     var
  35.         SavePicBaseAddr: ptr;
  36.         StopFlagLoc: IntPtr;
  37.  
  38.  
  39.     procedure CorrectShadingOfLine (PicPtr, BFPtr: ptr; width, BFMean: integer);
  40. {}
  41. {VAR}
  42. {  PicLine,BFLine:LinePtr;}
  43. {  i,value:integer;}
  44. {BEGIN}
  45. {  PicLine:=LinePtr(PicPtr);}
  46. {  BFLine:=LinePtr(BFPtr);}
  47. {  FOR i:=0 TO width-1 DO BEGIN}
  48. {    value:=PicLine^[i];}
  49. {    value:=255-value;}
  50. {    value:=(LongInt(value)*BFMean+(BFLine^[i] DIV 2)) DIV BFLine^[i];}
  51. {    IF value>254 THEN value:=254;}
  52. {    IF value<1 THEN value:=1;}
  53. {    PicLine^[i]:=255-value;}
  54. {  END;}
  55. {  }
  56.   {a0=data pointer}
  57.   {a1=blank field data pointer}
  58.   {d0=count}
  59.   {d1=pixel value}
  60.   {d2=blank field pixel value}
  61.   {d3=blank field mean}
  62.   {d4=temp}
  63.   {d5=max pixel value(245)}
  64.   {d6=min pixel value(1)}
  65.     inline
  66.         $4E56, $0000, {   link    a6,#0}
  67.         $48E7, $FEC0, {   movem.l    a0-a1/d0-d6,-(sp)}
  68.         $206E, $000C, {   move.l    12(a6),a0}
  69.         $226E, $0008, {   move.l    8(a6),a1}
  70.         $4280,       {   clr.l    d0}
  71.         $302E, $0006, {   move.w    6(a6),d0}
  72.         $362E, $0004, {   move.w    4(a6),d3}
  73.         $2A3C, $0000, $00FE, {   move.l    #254,d5}
  74.         $2C3C, $0000, $0001, {   move.l    #1,d6}
  75.         $5380,       {   subq.l    #1,d0}
  76.         $4281,       {   clr.l    d1}
  77.         $4282,       {   clr.l    d2}
  78.         $1210,       {L1    move.b    (a0),d1}
  79.         $1419,       {   move.b    (a1)+,d2}
  80.         $4601,       {   not.b    d1}
  81.         $C2C3,       {   mulu.w    d3,d1}
  82.         $2802,       {   move.l    d2,d4}
  83.         $E244,       {   asr.w    #1,d4}
  84.         $D284,       {   add.l    d4,d1}
  85.         $82C2,       {   divu.w    d2,d1}
  86.         $B245,       {   cmp.w    d5,d1}
  87.         $6F02,       {   ble.s    L2}
  88.         $3205,       {   move.w    d5,d1}
  89.         $B246,       {L2    cmp.w    d6,d1}
  90.         $6C02,       {   bge.s    L3}
  91.         $3206,       {   move.w    d6,d1}
  92.         $4601,       {L3    not.b    d1}
  93.         $10C1,       {   move.b    d1,(a0)+}
  94.         $51C8, $FFDE, {   dbra    d0,L1}
  95.         $4CDF, $037F, {   movem.l    (sp)+,a0-a1/d0-d6}
  96.         $4E5E,       {   unlk    a6}
  97.         $DEFC, $000C; {   add.w    #12,sp}
  98. {END;}
  99.  
  100.  
  101.     procedure CorrectShading;
  102.         var
  103.             i: integer;
  104.             offset: LongInt;
  105.             p1, p2: ptr;
  106.             str: str255;
  107.     begin
  108.         with info^ do begin
  109.                 if ImageSize <> BlankFieldInfo^.ImageSize then begin
  110.                         beep;
  111.                         exit(CorrectShading);
  112.                     end;
  113.                 ShowWatch;
  114.                 p1 := PicBaseAddr;
  115.                 p2 := BlankFieldInfo^.PicBaseAddr;
  116.                 for i := 1 to nLines do begin
  117.                         CorrectShadingOfLine(p1, p2, PixelsPerLine, BlankFieldMean);
  118.                         p1 := ptr(ord4(p1) + info^.BytesPerRow);
  119.                         p2 := ptr(ord4(p2) + BlankFieldInfo^.BytesPerRow);
  120.                         if i mod 96 = 0 then
  121.                             UpdatePicWindow;
  122.                     end;
  123.                 UpdatePicWindow;
  124.                 str := title;
  125.                 if SpatiallyCalibrated then
  126.                     str := concat(str, chr($13)); {Black Diamond}
  127.                 if DensityCalibrated then
  128.                     str := concat(str, '');
  129.                 if wptr <> nil then
  130.                     SetWTitle(wptr, concat(str, '(Corrected)'));
  131.             end;
  132.     end;
  133.  
  134.  
  135.     procedure CopyOffscreen (src, dst: PixMapHandle; sRect, dRect: rect);
  136.     begin
  137.         hlock(handle(src));
  138.         hlock(handle(dst));
  139.         CopyBits(BitMapHandle(src)^^, BitMapHandle(dst)^^, sRect, dRect, SrcCopy, nil);
  140.         hunlock(handle(src));
  141.         hunlock(handle(dst));
  142.     end;
  143.  
  144.  
  145.     procedure StopDigitizing;
  146.     begin
  147.         if digitizing then
  148.             with info^ do begin
  149.                     ShowFrameRate('', DTStartTicks, DTFrameCount);
  150.                     CopyOffscreen(qcPort^.portPixMap, osPort^.portPixMap, PicRect, PicRect);
  151.                     SetItem(SpecialMenuH, StartItem, 'Start Capturing');
  152.                     Digitizing := false;
  153.                     ContinuousHistogram := false;
  154.                     with info^ do
  155.                         if PictureType = QuickCaptureType then begin
  156.                                 title := 'Camera';
  157.                                 UpdateTitleBar;
  158.                                 if HighlightSaturatedPixels then
  159.                                     LoadLUT(ctable);
  160.                             end;
  161.                     if (BlankFieldInfo <> nil) and not OptionKeyDown then
  162.                         CorrectShading;
  163.                 end;
  164.     end;
  165.  
  166.  
  167.     procedure GetQuickCaptureFrame;
  168.         var
  169.             ticks, timeout: LongInt;
  170.     begin
  171.         if ExternalTrigger then begin {Wait for external trigger}
  172.                 ControlReg^ := BitAnd($82, 255);
  173.                 repeat
  174.                     if button then
  175.                         ExternalTrigger := false;
  176.                 until (ControlReg^ >= 0) or not ExternalTrigger;
  177.                 if Digitizing then
  178.                     StopDigitizing;
  179.             end
  180.         else begin
  181.                 TimeOut := TickCount + 30;  {1/2sec. timeout}
  182.                 ControlReg^ := BitAnd($80, 255); {Start frame capture}
  183.                 while ControlReg^ < 0 do begin    {Wait for it to complete}
  184.                         if TickCount > TimeOut then
  185.                             leave
  186.                     end;
  187.                 DTFrameCount := DTFrameCount + 1;
  188.             end;
  189.     end;
  190.  
  191.  
  192.     procedure CaptureAndDisplayQCFrame;
  193.         var
  194.             tPort: GrafPtr;
  195.     begin
  196.         with info^ do begin
  197.                 if (PictureType <> QuickCaptureType) or (PixelsPerLine <> qcWidth) or (nlines <> qcHeight) then begin
  198.                         Digitizing := false;
  199.                         exit(CaptureAndDisplayQCFrame);
  200.                     end;
  201.                 GetQuickCaptureFrame;
  202.                 getPort(tPort);
  203.                 SetPort(wptr);
  204.                 hlock(handle(qcPort^.portPixMap));
  205.                 hlock(handle(CGrafPort(wptr^).PortPixMap));
  206.                 CopyBits(BitMapHandle(qcPort^.portPixMap)^^, BitMapHandle(CGrafPort(wptr^).PortPixMap)^^, SrcRect, wrect, SrcCopy, nil);
  207.                 hunlock(handle(qcPort^.portPixMap));
  208.                 hunlock(handle(CGrafPort(wptr^).PortPixMap));
  209.                 SetPort(tPort);
  210.             end;
  211.     end;
  212.  
  213.  
  214.     procedure SetReg (index, value: integer);
  215.         const
  216.             RegOffset = $f5fe0;
  217.         var
  218.             reg: ptr;
  219.     begin
  220.         reg := ptr(ScionSlotBase + RegOffset + index * 4);
  221.         reg^ := value;
  222.     end;
  223.  
  224.  
  225.     procedure ResetScion (GrabRect: rect; DisplayPoint: point);
  226.         const
  227.             ilutOffset = $f0000;
  228.             LineStartsRamOffset = $f4000;
  229.         type
  230.             LineStartsArray = packed array[0..8191] of UnsignedByte;
  231.             LineStartsType = ^LineStartsArray;
  232.         var
  233.             ScreenRowBytesx2: LongInt;
  234.             LutPtr: ptr;
  235.             LineStarts: LineStartsType;
  236.             EvenStart, OddStart: LongInt;
  237.             width, height, IndexOdd, IndexEven, index, i: integer;
  238.             hstart, vstart: integer;
  239.     begin
  240.         ScreenRowBytesx2 := ScreenRowBytes * 2;
  241.         LoadInputLookupTable(Ptr(ScionSlotBase + ilutOffset));
  242.         with GrabRect, DisplayPoint do begin
  243.                 hstart := BitAnd(left, $fffc);
  244.                 vstart := BitAnd(top, $fffe);
  245.                 width := right - left;
  246.                 height := bottom - top;
  247.                 StopFlagLoc := IntPtr(LongInt(ScreenBase) + h + ScreenRowBytes * (v + height - 2) + 4);
  248.                 EvenStart := LongInt(ScreenBase) + h + ScreenRowBytes * v;
  249.                 OddStart := EvenStart + ScreenRowBytes;
  250.                 IndexOdd := 0;
  251.                 IndexEven := (height div 2) * 16;
  252.             end;
  253.         LineStarts := LineStartsType(ScionSlotBase + LineStartsRamOffset);
  254.         for i := 1 to height div 2 do begin
  255.                 LineStarts^[IndexOdd] := BSR(BitAnd(OddStart, $ff000000), 24);
  256.                 LineStarts^[IndexOdd + 4] := BSR(BitAnd(OddStart, $ff0000), 16);
  257.                 LineStarts^[IndexOdd + 8] := BSR(BitAnd(OddStart, $ff00), 8);
  258.                 LineStarts^[IndexOdd + 12] := BitAnd(OddStart, $fc);
  259.                 LineStarts^[IndexEven] := BSR(BitAnd(EvenStart, $ff000000), 24);
  260.                 LineStarts^[IndexEven + 4] := BSR(BitAnd(EvenStart, $ff0000), 16);
  261.                 LineStarts^[IndexEven + 8] := BSR(BitAnd(EvenStart, $ff00), 8);
  262.                 LineStarts^[IndexEven + 12] := BitAnd(EvenStart, $fc);
  263.                 IndexOdd := IndexOdd + 16;
  264.                 IndexEven := IndexEven + 16;
  265.                 OddStart := OddStart + ScreenRowBytesx2;
  266.                 EvenStart := EvenStart + ScreenRowBytesx2;
  267.             end;
  268.         Index := height * 16;
  269.         LineStarts^[Index] := 0;
  270.         LineStarts^[Index + 4] := 0;
  271.         LineStarts^[Index + 8] := 0;
  272.         LineStarts^[Index + 12] := 1;
  273.         SetReg(1, 0);
  274.         SetReg(2, 162 - (width div 4));
  275.         SetReg(3, 0);
  276.         SetReg(4, 225 - (hstart div 4));
  277.         SetReg(5, 255 - (width div 4));
  278.         SetReg(6, 241 - (vstart div 2));
  279.         SetReg(7, 255 - (height div 2));
  280.     end;
  281.  
  282.  
  283.     procedure GetScionFrame (DisplayPoint: point);
  284.   {Captures a single Scion frame to screen memory.}
  285.         type
  286.             IntPtr = ^integer;
  287.         var
  288.             FlagLoc: IntPtr;
  289.             StartTime: LongInt;
  290.             myMMUMode: signedbyte;
  291.     begin
  292.         with DisplayPoint do
  293.             FlagLoc := IntPtr(LongInt(ScreenBase) + h + ScreenRowBytes * v + 4);
  294.         StartTime := TickCount;
  295.         myMMUMode := 1;
  296.         SwapMMUMode(myMMUMode);
  297.         FlagLoc^ := $00ff;
  298.         SetReg(1, BitOr(128, VideoChannel * 4)); {Grab Enable}
  299.         while FlagLoc^ = $00ff do
  300.             if TickCount > (StartTime + 5) then begin
  301.                     SetReg(1, 0); {Stop Grabbing}
  302.                     SwapMMUMode(myMMUMode);
  303.                     exit(GetScionFrame)
  304.                 end;
  305.         StopFlagLoc^ := $00ff;
  306.         while StopFlagLoc^ = $00ff do begin
  307.             end;
  308.         SetReg(1, 0); {Stop Grabbing}
  309.         SwapMMUMode(myMMUMode);
  310.     end;
  311.  
  312.  
  313.     function GetScreenPixel (h, v: integer): integer;
  314.         var
  315.             offset: LongInt;
  316.             p: ptr;
  317.     begin
  318.         offset := LongInt(v) * ScreenRowBytes + h;
  319.         p := ptr(ord4(ScreenBase) + offset);
  320.         GetScreenPixel := BAND(p^, 255);
  321.     end;
  322.  
  323.  
  324.     procedure CopyScionFrameOffscreen (DisplayPoint: point; wwidth, wheight: integer);
  325.         var
  326.             src, dst: ptr;
  327.             line: integer;
  328.     begin
  329.         with Info^ do begin
  330.                 with DisplayPoint do
  331.                     src := ptr(LongInt(ScreenBase) + h + ScreenRowBytes * v);
  332.                 dst := ptr(LongInt(PicBaseAddr));
  333.                 for line := 1 to wheight do begin
  334.                         BlockMove(src, dst, wwidth);
  335.                         src := ptr(ord4(src) + ScreenRowBytes);
  336.                         dst := ptr(ord4(dst) + BytesPerRow);
  337.                     end;
  338.             end;
  339.     end;
  340.  
  341.  
  342.     procedure DoMiniEventLoop (FullScreenMode: boolean);
  343.         var
  344.             loc: point;
  345.             event: EventRecord;
  346.     begin
  347.         FlushEvents(EveryEvent, 0);
  348.         if not FullScreenMode then
  349.             DrawLabels('X:', 'Y:', 'Value:');
  350.         repeat
  351.             GetMouse(loc);
  352.             LocalToGlobal(loc);
  353.             if not FullScreenMode then
  354.                 with loc do
  355.                     Show3Values(h, v, GetScreenPixel(h, v));
  356.         until WaitNextEvent(mDownMask + KeyDownMask, Event, 0, nil);
  357.     end;
  358.  
  359.  
  360.     procedure CaptureUsingScion;
  361.         var
  362.             GrabRect, ScreenSrcRect: rect;
  363.             DisplayPoint: point;
  364.             FullScreenMode: boolean;
  365.             wwidth, wheight: integer;
  366.             tPort: GrafPtr;
  367.             SaveBackgroundColor, hstart, vstart: integer;
  368.             ignore: integer;
  369.             mloc: point;
  370.             MainDevice: GDHandle;
  371.             SrcPixMap: PixMapHandle;
  372.             myMMUMode: signedbyte;
  373.             FlagLoc: IntPtr;
  374.             StartTime: LongInt;
  375.             grabbing: boolean;
  376.     begin
  377.         FullScreenMode := OptionKeyDown and (ScreenWidth = 640);
  378.         if FullScreenMode or (ScreenWidth > 640) then begin
  379.                 wwidth := MaxScionWidth;
  380.                 wheight := 480
  381.             end
  382.         else begin
  383.                 wwidth := 552;
  384.                 if wwidth > MaxScionWidth then
  385.                     wwidth := MaxScionWidth;
  386.                 wheight := 436;
  387.             end;
  388.         if ScionInfo <> nil then
  389.             with ScionInfo^.wrect, ScionInfo^ do
  390.                 if (wwidth <> right) or (wheight <> bottom) then begin
  391.                         changes := false;
  392.                         ignore := CloseAWindow(wptr);
  393.                     end;
  394.         if (ScionInfo <> nil) and (info^.PictureType <> ScionType) then begin
  395.                 SelectWindow(ScionInfo^.wptr);
  396.                 info := ScionInfo;
  397.             end;
  398.         if ScionInfo <> nil then
  399.             BringToFront(ScionInfo^.wptr);
  400.         with info^ do
  401.             if PictureType <> ScionType then begin
  402.                     if not NewPicWindow('Camera(Scion)', wwidth, wheight) then begin
  403.                             beep;
  404.                             exit(CaptureUsingScion)
  405.                         end;
  406.                     ScionInfo := info;
  407.                 end;
  408.         KillRoi;
  409.         with info^ do begin
  410.                 PictureType := ScionType;
  411.                 changes := true;
  412.                 UpdateTitleBar;
  413.             end;
  414.         hstart := (640 - wwidth) div 2;
  415.         vstart := (480 - wheight) div 2;
  416.         SetRect(GrabRect, hstart, vstart, hstart + wwidth, vstart + wheight);
  417.         if FullScreenMode then
  418.             with DisplayPoint do begin
  419.                     h := BitAnd((640 - wwidth) div 2, $fffc);
  420.                     v := 0;
  421.                 end
  422.         else
  423.             with DisplayPoint do begin
  424.                     h := PicLeftBase;
  425.                     v := PicTopBase;
  426.                 end;
  427.         ResetScion(GrabRect, DisplayPoint);
  428.         if FullScreenMode then begin
  429.                 GetPort(tPort);
  430.                 SaveBackgroundColor := BackgroundIndex;
  431.                 SetBackgroundColor(BlackIndex);
  432.                 EraseScreen;
  433.             end;
  434.         if info^.magnification <> 1.0 then
  435.             Unzoom;
  436.         with DisplayPoint do
  437.             FlagLoc := IntPtr(LongInt(ScreenBase) + h + ScreenRowBytes * v + 4);
  438.         StartTime := TickCount;
  439.         grabbing := true;
  440.         myMMUMode := 1;
  441.         SwapMMUMode(myMMUMode);
  442.         FlagLoc^ := $00ff;
  443.         SetReg(1, BitOr(128, VideoChannel * 4)); {Grab Enable}
  444.         while FlagLoc^ = $00ff do
  445.             if TickCount > (StartTime + 5) then begin
  446.                     SetReg(1, 0); {Stop Grabbing}
  447.                     FlagLoc^ := $0000;
  448.                     SwapMMUMode(myMMUMode);
  449.                     grabbing := false;
  450.                 end;
  451.         if grabbing then begin
  452.                 SwapMMUMode(myMMUMode);
  453.                 DoMiniEventLoop(FullScreenMode);
  454.                 myMMUMode := 1;
  455.                 SwapMMUMode(myMMUMode);
  456.                 StopFlagLoc^ := $00ff;
  457.                 while StopFlagLoc^ = $00ff do begin
  458.                     end;
  459.                 SetReg(1, 0);   {Stop Grabbing}
  460.                 SwapMMUMode(myMMUMode);
  461.                 HideCursor;
  462.                 GetScionFrame(DisplayPoint);
  463.             end;
  464.         MainDevice := GetMainDevice;
  465.         SrcPixMap := MainDevice^^.gdPMap;
  466.         with DisplayPoint, ScreenSrcRect do begin
  467.                 left := h;
  468.                 top := v;
  469.                 right := left + wwidth;
  470.                 bottom := top + wheight;
  471.             end;
  472.         with info^ do begin
  473.                 CopyOffscreen(SrcPixMap, osPort^.portPixMap, ScreenSrcRect, PicRect);
  474.                 ShowCursor;
  475.                 if FullScreenMode then begin
  476.                         RestoreScreen;
  477.                         SetBackgroundColor(SaveBackgroundColor);
  478.                         SetPort(tPort);
  479.                     end;
  480.                 title := 'Camera';
  481.                 UpdateTitleBar;
  482.             end; {with}
  483.         if (BlankFieldInfo <> nil) and not OptionKeyDown then
  484.             CorrectShading;
  485.         FlushEvents(EveryEvent, 0);
  486.     end;
  487.  
  488.  
  489.     procedure HighlightPixels;
  490.         var
  491.             lut: MyCSpecArray;
  492.     begin
  493.         with info^ do begin
  494.                 lut := ctable;
  495.                 with lut[1].rgb do begin
  496.                         red := 0;
  497.                         green := -1;
  498.                         blue := 0;
  499.                     end;
  500.                 with lut[254].rgb do begin
  501.                         red := -1;
  502.                         green := 0;
  503.                         blue := 0;
  504.                     end;
  505.                 LoadLUT(lut);
  506.             end;
  507.     end;
  508.  
  509.  
  510.     procedure ShowTriggerMessage;
  511.     begin
  512.         if ExternalTrigger and (FrameGrabber = QuickCapture) then
  513.             ShowMessage(concat('EXTERNAL TRIGGER MODE', cr, '(Press mouse button to exit)'));
  514.     end;
  515.  
  516.  
  517.     procedure StartDigitizing;
  518.         var
  519.             i, width, height: integer;
  520.             trect: rect;
  521.             NewWindow: boolean;
  522.     begin
  523.         if FrameGrabber = Scion then begin
  524.                 if HighlightSaturatedPixels then
  525.                     HighlightPixels;
  526.                 CaptureUsingScion;
  527.                 if HighlightSaturatedPixels then
  528.                     LoadLUT(info^.ctable);
  529.                 exit(StartDigitizing)
  530.             end;
  531.         if Digitizing then begin
  532.                 StopDigitizing;
  533.                 if BlankFieldInfo <> nil then
  534.                     wait(15);
  535.                 FlushEvents(EveryEvent, 0); {In case user holds key down too long}
  536.                 exit(StartDigitizing)
  537.             end;
  538.         if FrameGrabber = NoFrameGrabber then begin
  539.                 PutMessage('Capturing requires a Data Translation or SCION frame grabber card.');
  540.                 exit(StartDigitizing)
  541.             end;
  542.         if (QuickCaptureInfo <> nil) and (info^.PictureType <> QuickCaptureType) then begin
  543.                 SelectWindow(QuickCaptureInfo^.wptr);
  544.                 info := QuickCaptureInfo;
  545.             end;
  546.         NewWindow := false;
  547.         with info^ do
  548.             if (PictureType <> QuickCaptureType) or (PixelsPerLine <> qcWidth) or (nlines <> qcHeight) then begin
  549.                     if not NewPicWindow('Camera', qcWidth, qcHeight) then
  550.                         exit(StartDigitizing);
  551.                     NewWindow := true;
  552.                 end;
  553.         with info^ do begin
  554.                 PictureType := QuickCaptureType;
  555.                 QuickCaptureInfo := info;
  556.                 if NewWindow and (not EqualRect(SrcRect, PicRect)) then {Center Frame}
  557.                     with SrcRect do begin
  558.                             width := right - left;
  559.                             height := bottom - top;
  560.                             left := (PicRect.right - width) div 2;
  561.                             right := left + width;
  562.                             top := (PicRect.bottom - height) div 2;
  563.                             bottom := top + height;
  564.                         end;
  565.                 KillRoi;
  566.                 if ScaleToFitWindow then
  567.                     ScaleToFit;
  568.                 with SrcRect do begin
  569.                         width := right - left;
  570.                         left := band(left, $fffc);
  571.                         right := left + width;
  572.                     end;
  573.                 GetWindowRect(wptr, trect);
  574.                 with trect do
  575.                     if band(left, 3) <> 0 then
  576.                         MoveWindow(wptr, band(left, $fffc), top, true); {Forces window to be word aligned}
  577.                 with SrcRect do {Prevents bus errors when Camera window moved.}
  578.                     if (top = 0) and (bottom < PicRect.bottom) then begin
  579.                             top := top + 1;
  580.                             bottom := bottom + 1;
  581.                         end;
  582.                 ResetQuickCapture;
  583.                 Digitizing := true;
  584.                 SetItem(SpecialMenuH, StartItem, 'Stop Capturing');
  585.                 changes := true;
  586.                 BinaryPic := false;
  587.                 UpdateTitleBar;
  588.                 if HighlightSaturatedPixels then
  589.                     HighlightPixels;
  590.             end; {with info}
  591.         DTFrameCount := 0;
  592.         DTStartTicks := TickCount;
  593.         ContinuousHistogram := false;
  594.         ShowTriggerMessage;
  595.     end;
  596.  
  597.  
  598.     procedure AddLineToSum (src, dst: ptr; width: LongInt);
  599. {$IFC false}
  600.         type
  601.             SumLineType = array[0..2047] of integer;
  602.             fptr = ^SumLineType;
  603.         var
  604.             FrameLine: LinePtr;
  605.             SumLine: fptr;
  606.             i: integer;
  607.     begin
  608.         FrameLine := LinePtr(src);
  609.         SumLine := fptr(dst);
  610.         for i := 0 to width - 1 do
  611.             SumLine^[i] := SumLine^[i] + FrameLine^[i];
  612.     end;
  613. {$ENDC}
  614. inline
  615. {a0=data pointer}
  616. {a1=sum buffer pointer}
  617. {d0=count}
  618. {d1=pixel value}
  619. {d2=temp}
  620.     $4E56, $0000, {link    a6,#0}
  621.     $48E7, $E0C0, {movem.l    a0-a1/d0-d2,-(sp)}
  622.     $206E, $000C, {move.l    12(a6),a0}
  623.     $226E, $0008, {move.l    8(a6),a1}
  624.     $202E, $0004, {move.l    4(a6),d0}
  625.     $5380,              {subq.l    #1,d0}
  626.     $4281,              {clr.l    d1}
  627.     $4282,              {clr.l    d2}
  628.     $1218,              {L1    move.b    (a0)+,d1}
  629.     $3411,              {move.w    (a1),d2}
  630.     $D441,              {add.w      d1,d2}
  631.     $32C2,              {move.w    d2,(a1)+}
  632.     $51C8, $FFF6, {dbra    d0,L1}
  633.     $4CDF, $0307, {movem.l    (sp)+,a0-a1/d0-d2}
  634.     $4E5E,               {unlk    a6}
  635.     $DEFC, $000C; {add.w    #12,sp}
  636.  
  637.  
  638.  
  639. function DoAveragingOptions: boolean;
  640.     const
  641.         FramesID = 4;
  642.         SumID = 5;
  643.     var
  644.         mylog: DialogPtr;
  645.         item, i: integer;
  646. begin
  647.     InitCursor;
  648.     mylog := GetNewDialog(140, nil, pointer(-1));
  649.     SetDNum(MyLog, FramesID, FramesToAverage);
  650.     SetDialogItem(mylog, SumID, ord(SumFrames));
  651.     SelIText(MyLog, FramesID, 0, 32767);
  652.     OutlineButton(MyLog, ok, 16);
  653.     repeat
  654.         ModalDialog(nil, item);
  655.         if item = FramesID then
  656.             FramesToAverage := GetDNum(MyLog, FramesID);
  657.         if item = SumID then begin
  658.                 SumFrames := not SumFrames;
  659.                 SetDialogItem(mylog, SumID, ord(SumFrames));
  660.             end;
  661.     until (item = ok) or (item = cancel);
  662.     DisposDialog(mylog);
  663.     if FramesToAverage < 2 then
  664.         FramesToAverage := 2;
  665.     DoAveragingOptions := item <> cancel;
  666. end;
  667.  
  668.  
  669. procedure AverageFrames;
  670.     type
  671.         IntPtr = ^integer;
  672.         SumLineType = array[0..2047] of integer;
  673.         sptr = ^SumLineType;
  674.     var
  675.         AutoSelectAll: boolean;
  676.         SelectionSize, FrameBufferSize, offset, StartTicks: LongInt;
  677.         SumBase, src, srcbase, dst, OffscreenBase: ptr;
  678.         str1, str2: str255;
  679.         xLines, xPixelsPerLine, xPixelsPerLine2, frame, line, pixel: integer;
  680.         aline: LineType;
  681.         GrabRect: rect;
  682.         DisplayPoint: point;
  683.         hstart, vstart, wwidth, wheight, MinV, MaxV, value: integer;
  684.         j, range, FramesAveraged: integer;
  685.         SrcRowBytes, DstRowBytes, i: LongInt;
  686.         iptr: IntPtr;
  687.         FrameLine: LinePtr;
  688.         SumLine: sptr;
  689.         SaveBlankFieldInfo: InfoPtr;
  690.         myMMUMode: signedbyte;
  691. begin
  692.     if (info <> QuickCaptureInfo) and (info <> ScionInfo) then begin
  693.             PutMessage('You must have an active Camera window(created using Start Capturing) in order to average frames.');
  694.             exit(AverageFrames)
  695.         end;
  696.     if NotRectangular or NotinBounds then
  697.         exit(AverageFrames);
  698.     if not OptionKeyWasDown then begin
  699.             if not DoAveragingOptions then
  700.                 exit(AverageFrames);
  701.         end;
  702.     SaveBlankFieldInfo := BlankFieldInfo;
  703.     BlankFieldInfo := nil; {We don't want to do shading correction now}
  704.     StopDigitizing;
  705.     BlankFieldInfo := SaveBlankFieldInfo;
  706.     OptionKeyWasDown := false;
  707.     DrawLabels('Frame:', 'Total:', '');
  708.     ShowTriggerMessage;
  709.     ShowWatch;
  710.     AutoSelectAll := not Info^.RoiShowing;
  711.     if AutoSelectAll then
  712.         SelectAll(false);
  713.     with info^.RoiRect do
  714.         SelectionSize := (LongInt(right) - left) * (bottom - top);
  715.     FrameBufferSize := SelectionSize * 2;
  716.     if FrameBufferSize > BigBufSize then begin
  717.             NumToString(FrameBufferSize div 1024, str1);
  718.             NumToString(BigBufSize div 1024, str2);
  719.             str2 := concat(str1, 'K bytes are required, but only ', str2, 'K bytes are available.');
  720.             PutMessage(concat('There is not enough memory to do the requested frame averaging. ', str2));
  721.             if AutoSelectAll or (BlankFieldInfo <> nil) then
  722.                 KillRoi
  723.             else
  724.                 ShowRoi;
  725.             exit(AverageFrames)
  726.         end;
  727.     WhatToUndo := NothingToUndo;
  728.     WhatsOnClip := Nothing;
  729.     SumBase := BigBuf;
  730.     if FrameGrabber = QuickCapture then begin
  731.             ContinuousHistogram := false;
  732.             ResetQuickCapture
  733.         end
  734.     else begin
  735.             with info^.wrect do begin
  736.                     wwidth := right;
  737.                     wheight := bottom;
  738.                 end;
  739.             hstart := (640 - wwidth) div 2;
  740.             vstart := (480 - wheight) div 2;
  741.             SetRect(GrabRect, hstart, vstart, hstart + wwidth, vstart + wheight);
  742.             with DisplayPoint do begin
  743.                     h := PicLeftBase;
  744.                     v := PicTopBase;
  745.                 end;
  746.             ResetScion(GrabRect, DisplayPoint);
  747.             HideCursor;
  748.         end;
  749.     with info^, info^.RoiRect do begin
  750.             offset := left + LongInt(top) * BytesPerRow;
  751.             OffscreenBase := ptr(ord4(PicBaseAddr) + offset);
  752.             if FrameGrabber = QuickCapture then begin
  753.                     offset := left + LongInt(top) * qcRowBytes;
  754.                     srcbase := ptr(ord4(ptr(DTSlotBase)) + offset);
  755.                     SrcRowBytes := qcRowBytes;
  756.                 end
  757.             else
  758.                 with DisplayPoint do begin
  759.                         BringToFront(wptr);
  760.                         offset := left + h + (v + top) * ScreenRowBytes;
  761.                         srcbase := ptr(ord4(ScreenBase) + offset);
  762.                         SrcRowBytes := ScreenRowBytes;
  763.                     end;
  764.             xLines := bottom - top;
  765.             xPixelsPerLine := right - left;
  766.             xPixelsPerLine2 := xPixelsPerLine * 2;
  767.         end;
  768.     dst := SumBase;
  769.     for line := 1 to xLines do begin {zero buffer}
  770.             BlockMove(ptr(BlankLine), dst, xPixelsPerLine2);
  771.             dst := ptr(ord4(dst) + xPixelsPerLine2);
  772.         end;
  773.     info^.title := 'Camera';
  774.     UpdateTitleBar;
  775.     StartTicks := TickCount;
  776.     for frame := 0 to FramesToAverage - 1 do begin
  777.             Show2Values(frame + 1, FramesToAverage);
  778.             if FrameGrabber = QuickCapture then
  779.                 GetQuickCaptureFrame
  780.             else
  781.                 GetScionFrame(DisplayPoint);
  782.             src := srcbase;
  783.             dst := SumBase;
  784.             myMMUMode := 1;
  785.             SwapMMUMode(myMMUMode);
  786.             for line := 1 to xLines do begin
  787.                     AddLineToSum(src, dst, xPixelsPerLine);
  788.                     src := ptr(ord4(src) + SrcRowBytes);
  789.                     dst := ptr(ord4(dst) + xPixelsPerLine2);
  790.                 end;
  791.             SwapMMUMode(myMMUMode);
  792.             if FrameGrabber = QuickCapture then
  793.                 UpdateScreen(info^.RoiRect);
  794.             if CommandPeriod then begin
  795.                     beep;
  796.                     if AutoSelectAll then
  797.                         KillRoi
  798.                     else
  799.                         ShowRoi;
  800.                     exit(AverageFrames);
  801.                 end;
  802.         end; {for}
  803.     src := SumBase;
  804.     dst := OffscreenBase;
  805.     DstRowBytes := info^.BytesPerRow;
  806.     if SumFrames then begin
  807.             MinV := 32767;
  808.             MaxV := 0;
  809.             iptr := IntPtr(src);
  810.             for i := 1 to SelectionSize do begin
  811.                     value := iptr^;
  812.                     if value > MaxV then
  813.                         MaxV := value;
  814.                     if value < MinV then
  815.                         MinV := value;
  816.                     iptr := IntPtr(ord4(iptr) + 2);
  817.                 end;
  818.             range := MaxV - MinV;
  819.             if range <> 0 then
  820.                 for line := 1 to xLines do begin
  821.                         SumLine := sptr(src);
  822.                         FrameLine := LinePtr(dst);
  823.                         for j := 0 to xPixelsPerLine - 1 do begin
  824.                                 value := SumLine^[j] - MinV + 1;
  825.                                 value := LongInt(value) * 254 div range;
  826.                                 FrameLine^[j] := value;
  827.                             end;
  828.                         src := ptr(ord4(src) + xPixelsPerLine2);
  829.                         dst := ptr(ord4(dst) + DstRowBytes);
  830.                     end
  831.             else
  832.                 beep;
  833.         end
  834.     else
  835.         for line := 1 to xLines do begin
  836.                 SumLine := sptr(src);
  837.                 FrameLine := LinePtr(dst);
  838.                 for j := 0 to xPixelsPerLine - 1 do
  839.                     FrameLine^[j] := SumLine^[j] div FramesToAverage;
  840.                 src := ptr(ord4(src) + xPixelsPerLine2);
  841.                 dst := ptr(ord4(dst) + DstRowBytes);
  842.             end;
  843.     RealToString((TickCount - StartTicks) / 60.0, 1, 2, str1);
  844.     ShowFrameRate(concat(Long2str(FramesToAverage), ' frames', cr, str1, ' seconds', cr), StartTicks, FramesToAverage);
  845.     UpdatePicWindow;
  846.     if AutoSelectAll then
  847.         KillRoi
  848.     else
  849.         ShowRoi;
  850.     if BlankFieldInfo <> nil then
  851.         CorrectShading;
  852. end;
  853.  
  854.  
  855.  
  856. function GetQCPixel (h, v: integer): integer;
  857.     var
  858.         offset: LongInt;
  859.         p: ptr;
  860. begin
  861.     with Info^ do begin
  862.             if (h < 0) or (v < 0) or (h >= qcWidth) or (v >= qcHeight) then begin
  863.                     GetQCPixel := WhiteIndex;
  864.                     exit(GetQCPixel);
  865.                 end;
  866.             offset := LongInt(v) * qcRowBytes + h;
  867.             if offset >= LongInt(qcHeight) * qcRowBytes then begin
  868.                     GetQCPixel := WhiteIndex;
  869.                     exit(GetQCPixel);
  870.                 end;
  871.             p := ptr(ord4(ptr(DTSlotBase)) + offset);
  872.             GetQCPixel := BAND(p^, 255);
  873.         end;
  874. end;
  875.  
  876.  
  877. procedure WaitForTrigger;
  878. begin
  879.     StopDigitizing;
  880.     ShowWatch;
  881.     if FrameGrabber = QuickCapture then begin
  882.             ControlReg^ := BitAnd($82, 255);  {Wait for external trigger and capture one frame}
  883.             repeat
  884.             until (ControlReg^ >= 0) or Button;  {Wait for it to complete}
  885.         end
  886.     else
  887.         repeat
  888.         until Button;
  889. end;
  890.  
  891.  
  892. procedure DoVideoOptions;
  893.     const
  894.         InvertID = 3;
  895.         HighLightID = 4;
  896.         OscillatingID = 5;
  897.         TriggerID = 6;
  898.         ChannelID = 7;
  899.         MaxScionWidthID = 8;
  900.         BlindID = 11;
  901.     var
  902.         mylog: DialogPtr;
  903.         item, i: integer;
  904.         SaveInvert, SaveOscillating, SaveHighLight, WasDigitizing: boolean;
  905.         SaveMaxWidth, SaveChannel: integer;
  906. begin
  907.     InitCursor;
  908.     SaveInvert := InvertVideo;
  909.     SaveMaxWidth := MaxScionWidth;
  910.     SaveOscillating := OscillatingMovies;
  911.     SaveChannel := VideoChannel;
  912.     SaveHighlight := HighlightSaturatedPixels;
  913.     mylog := GetNewDialog(130, nil, pointer(-1));
  914.     SetDNum(MyLog, MaxScionWidthID, MaxScionWidth);
  915.     SetDNum(MyLog, ChannelID, VideoChannel);
  916.     SetDialogItem(mylog, InvertID, ord(InvertVideo));
  917.     SetDialogItem(mylog, HighlightID, ord(HighlightSaturatedPixels));
  918.     SetDialogItem(mylog, OscillatingID, ord(OscillatingMovies));
  919.     SetDialogItem(mylog, TriggerID, ord(ExternalTrigger));
  920.     SetDialogItem(mylog, BlindID, ord(BlindMovieCapture));
  921.     OutlineButton(MyLog, ok, 16);
  922.     WasDigitizing := Digitizing;
  923.     StopDigitizing;
  924.     repeat
  925.         ModalDialog(nil, item);
  926.         if item = ChannelID then begin
  927.                 VideoChannel := GetDNum(MyLog, ChannelID);
  928.                 if (VideoChannel < 0) or (VideoChannel > 3) then begin
  929.                         VideoChannel := SaveChannel;
  930.                         SetDNum(MyLog, ChannelID, VideoChannel);
  931.                     end;
  932.             end;
  933.         if item = MaxScionWidthID then begin
  934.                 MaxScionWidth := BitAnd(GetDNum(MyLog, MaxScionWidthID), $fffc);
  935.                 if (MaxScionWidth < 0) or (MaxScionWidth > 640) then begin
  936.                         beep;
  937.                         MaxScionWidth := SaveMaxWidth;
  938.                         SetDNum(MyLog, MaxScionWidthID, MaxScionWidth);
  939.                     end;
  940.             end;
  941.         if item = InvertID then begin
  942.                 InvertVideo := not InvertVideo;
  943.                 SetDialogItem(mylog, InvertID, ord(InvertVideo));
  944.             end;
  945.         if item = HighlightID then begin
  946.                 HighlightSaturatedPixels := not HighlightSaturatedPixels;
  947.                 SetDialogItem(mylog, HighlightID, ord(HighlightSaturatedPixels));
  948.             end;
  949.         if item = OscillatingID then begin
  950.                 OscillatingMovies := not OscillatingMovies;
  951.                 SetDialogItem(mylog, OscillatingID, ord(OscillatingMovies));
  952.             end;
  953.         if item = TriggerID then begin
  954.                 ExternalTrigger := not ExternalTrigger;
  955.                 SetDialogItem(mylog, TriggerID, ord(ExternalTrigger));
  956.             end;
  957.         if item = BlindID then begin
  958.                 BlindMovieCapture := not BlindMovieCapture;
  959.                 SetDialogItem(mylog, BlindID, ord(BlindMovieCapture));
  960.             end;
  961.     until (item = ok) or (item = cancel);
  962.     DisposDialog(mylog);
  963.     if FramesToAverage < 2 then
  964.         FramesToAverage := 2;
  965.     if item = cancel then begin
  966.             MaxScionWidth := SaveMaxWidth;
  967.             OscillatingMovies := SaveOscillating;
  968.             InvertVideo := SaveInvert;
  969.             VideoChannel := SaveChannel;
  970.             HighlightSaturatedPixels := SaveHighlight;
  971.         end;
  972.     if (FrameGrabber = Scion) and (ExternalTrigger or BlindMovieCapture) then begin
  973.             PutMessage('External triggering and blind movie capture are not supported with the SCION frame grabber card.');
  974.             ExternalTrigger := false;
  975.             BlindMovieCapture := false;
  976.         end;
  977.     if WasDigitizing and (not ExternalTrigger) then
  978.         StartDigitizing;
  979. end;
  980.  
  981. end.