const
   CommonDlgsLib = 'VppCommonDlgs.dll' ; 
   BUFFERSIZE = 255;
   DRIVE = 'D:';
   Path = 'D:\DATA\';
   uDIR = 'D:\DATA\Utilities\';

var Channel1 ;   
   
function OpenDialog( FileName,Title,Filter,DefaultExt:pointer ) : integer ; external CommonDlgsLib ;

function GetOpenFileName( Title,Filter,DefaultExt ) ;
var
  FileName ;
begin
  FileName := StringOfChar( ' ',BUFFERSIZE ) ;
  if OpenDialog( FileName,Title,Filter,DefaultExt ) <> 0 then
    GetOpenFileName := Trim( FileName )
  else
    GetOpenFileName := '' ;	
end;  { GetOpenFileName }

procedure SetShutter(State) ;
begin
	 Channel1 := DdeInitiate( 'USB6501DDE', 'DIO' ) ;
	 // WriteInfo ( Channel1 ) ;
	 DdePoke( Channel1, 'txtSource', State ) ;
	 DdeTerminate( Channel1 ) ;
end;

procedure sSave(var Image; Name);
begin
// WriteInfo('Saving ',Name);
   Save(Image,Name);
   WriteStatus('Saved as ',Name);
end;

var
   Available,Controller,Unit;
   Zero,Scale,NDelays,dp,iu;
   StartPosition,EndPosition,StepSize,NSteps; {motion stage}
   cDIR; 									  {current working directory}
   xSize,ySize,SaveCCD,SaveImage;						  {CCD size}
//   Left,Top,Right,Bottom;					  {Region size}
   CLeft,CTop,CRight,CBottom;				  {Region size}
   RLeft,RTop,RRight,RBottom;				  {Region size}
   Bin; 									  {Binning parameter}
   ET,ST;										  {Exposure time in milliseconds}
   NF,NL, NFIRST, NLAST;					  {number of subframes, number of loops}
   FName,BGFName, BName; 					  {name of base, and background}
   Background;								  {background image or value}
   bg;										  {decision maker}
   IR_on,IR_off;							  {IR Laser shutter on and off positions}

{This function retrieves string from DDE server}
function ReceiveString(service,topic,item);
var channel;
begin		
// Delay(100);	
   channel := DdeInitiate(service,topic) ;
   if channel = 0 then halt( 'Could not connect to Receive Data ' ) ;
   ReceiveString := DdeRequest(channel,item, fmt_Text) ;
   DdeTerminate(channel) ; 
end;		  

{This function pokes string to DDE server}
procedure SendString(service,topic,item,string);
var channel;
begin
// Delay(100);	
   channel := DdeInitiate(service,topic) ;
   if channel = 0 then halt( 'Could not connect to Receive Data ' ) ;			 
   DdePoke(channel,item,string,fmt_Text); 
   DdeTerminate(channel) ;				 	  		  
end;

function CurrentUnit(topic);
var s,t;
begin
   s:=ReceiveString('MotionStageServer',topic,'Unit');
   t:=ParseStr(s,' ,:=');
   CurrentUnit:=t;
end;

function CurrentPosition(topic);
var s,t;
begin
   s:=ReceiveString('MotionStageServer',topic,'Position');
   t:=ParseStr(s,' ,:=');
   CurrentPosition:=Val(t);
end;

function CurrentStatus(topic);
var s,t;
begin
   s:=ReceiveString('MotionStageServer',topic,'Status');
   t:=ParseStr(s,' ,:=');
// WriteInfo('s= ',s,chr(13),'t= ',t);
   if CompareStr(t,'1')=0 then begin CurrentStatus:=True; {WriteStatus('in position');} end
   else begin CurrentStatus:=False; {WriteStatus('in motion');} end;
end;

function GetUnit(topic);
var s,t;
begin
   if CompareStr(topic,'Manual') = 0 then
      GetUnit:='Step'
   else
      GetUnit:=CurrentUnit(topic);
end;

function GetPosition(topic);
var s,t;
begin
   if CompareStr(topic,'Manual') = 0 then
      GetPosition:=0
   else
      GetPosition:=CurrentPosition(topic);
end;

procedure SetTarget(topic,target);
var s;
begin
   if IsFloat(target) then s:=Str(target:0:3)
   else s:=Str(target);
   if CompareStr(topic,'Manual') = 0 then
   begin
      WriteInfo('Move to '+s);
   end
   else
   begin
      SendString('MotionStageServer',topic,'Target',s);
      WriteStatus('moving '+topic+' to '+s);
   end;
end;

procedure WaitTarget(topic);
var p,s;
begin
   if CompareStr(topic,'Manual') = 0 then
   begin
     WriteStatus(topic+'= '+Str(p)+', status= '+Str(s));
   end
   else
   begin
      s:=False;
      repeat
         Delay(100);
         s:=CurrentStatus(topic);
         p:=CurrentPosition(topic);
         WriteStatus(topic+'= '+Str(p)+', status= '+Str(s));
      until (s=True);
   end;
end;

{ Format file name with number of frames }
function FieldedFileName(Name,index);
begin
   FieldedFileName:= Name+'_'+ReplaceStr(Str(index:4),' ','0',rs_ReplaceAll);
end;

{ Define the working Directory }
Procedure FileDirectory;
var 
   YY, MM,DD;	  
begin
   SetDir(DRIVE);
   GetDate( YY, MM, DD ) ;
   cDIR:= Path+Str(YY:4)
      +ReplaceStr(Str(MM:2),' ','0',rs_ReplaceAll)
      +ReplaceStr(Str(DD:2),' ','0',rs_ReplaceAll)+'\';
   if StrLen(FindFirstFile( cDIR+'*.*', fa_AnyFile)) = 0 then				 		 
   begin
      CreateDir(cDIR); //create subdirectory for output
      WriteInfo(cDIR);
   end;
   SetDir(cDIR);
end;		   

Procedure SetRegion(var L,T,R,B;Left,Top,Right,Bottom);
begin
   L:=Left;
   T:=Top;
   R:=Right;
   B:=Bottom;
end;

procedure OpenDelays(ini);
var delaystring,stringcopy,token,i,FileName,iu;
begin
   delaystring:='0';
   Zero:=Val(ReadPrivateINIString(ini,Controller,'zero'));
   Scale:=Val(ReadPrivateINIString(ini,Controller,'scale'));
   delaystring:=ReadPrivateINIString(ini,Controller,'delays');

   stringcopy:=delaystring;	  
   NDelays:=0;
   repeat
      token:=ParseStr(stringcopy,' ,'+Chr(9));
      if Length(token) > 0 then NDelays:=NDelays+1;
   until StrLen(stringcopy) = 0 ;

   dp:=CreateArray(typ_Double,NDelays,1);
   i:=0;
   repeat
      token:=ParseStr(delaystring,' ,'+Chr(9));
      if Length( token ) > 0 then
      begin
         dp[i]:=Val(token);
		 iu:=Zero+Scale*dp[i];
         WriteLn('DELAY : dt['+Str(i)+']= '+Str(dp[i])+', iu['+Str(i)+']= '+Str(iu));
         //WriteInfo('dt['+Str(i)+']= '+Str(dp[i])+', iu['+Str(i)+']= '+Str(iu[i]));
         i:=i+1;
      end;
   until StrLen(delaystring) = 0 ;
   NSteps:=NDelays-1;
end;

procedure SetDelays;
var i;
begin
   //StartPosition:=3000;
   //EndPosition:=1000;
   //StepSize:=100;
   //NSteps:=50;
   if GetNumber('Enter the Reference position',Zero) = id_Cancel then halt;
   if GetNumber('Enter the Scale/direction',Scale) = id_Cancel then halt;
   StartPosition:=GetPosition(Controller);
   EndPosition:=StartPosition;
   StepSize:=1;
   NSteps:=0;
   if GetNumber('Enter the START position',StartPosition) = id_Cancel then halt;
   if GetNumber('Enter the END position, or press Canel to use single point',EndPosition) = id_Ok then
   begin
      if GetNumber('Enter the STEP size, or press Cancel to use the number of steps',StepSize) = id_Cancel then StepSize:=0;
      if (StepSize=0) then
      begin
         if GetNumber('Enter the number of steps instead of stepsize',NSteps) = id_Cancel then halt;
	     StepSize:=(EndPosition-StartPosition)/NSteps;
	     if StepSize = 0 then StepSize:=Double(EndPosition-StartPosition)/NSteps;
      end
      else
      begin
         if ((EndPosition-StartPosition)*StepSize<0) then StepSize:=-StepSize;
         NSteps:=Integer((EndPosition-StartPosition)/StepSize);
         EndPosition:=StartPosition+StepSize*NSteps;
      end;
   end
   else
   begin
      EndPosition:=StartPosition;
      StepSize:=1;
      NSteps:=0;
   end;
   NDelays:=NSteps+1;
   if IsFloat(StartPosition) OR IsFloat(StepSize) then
      dp:=CreateArray(typ_Double,NDelays,1)
   else
      dp:=CreateArray(typ_LongInt,NDelays,1);
   for i:=0 to NSteps do
   begin
      dp[i]:=StartPosition+i*StepSize;
      iu:=Zero+Scale*dp[i];
      WriteLn('DELAY : dt['+Str(i)+']= '+Str(dp[i])+', iu['+Str(i)+']= '+Str(iu));
   end;
   if Query('Number of steps = '+Str(NSteps)+Chr(13)+'EndPosition = '+Str(EndPosition:0:3)+Chr(13)+'Proceed ?') <> id_Yes then halt('Canceled');
{
   if IsFloat(EndPosition) then 
      WriteInfo('Number of steps = '+Str(NSteps)+Chr(13)+'EndPosition = '+Str(EndPosition))
   else
      WriteInfo('Number of steps = '+Str(NSteps)+Chr(13)+'EndPosition = '+Str(EndPosition:0:3))
}
end;

{ Acquire experimental parameters }
procedure GetParameters;
var ROI,xyCoor,ini,iq;
begin
   SaveImage:=TRUE;
   SaveCCD:=FALSE;
   pvcGetCCDSize( xSize,ySize ) ;
   Bin:=1;
   ET:=3000;		 {default exposure time}
   NF:=1;			 {default number of subframes}
   NL:=1;			 {default number of loops}
   NFIRST:=1;			 {default first frame}
   NLAST:=1;			 {default last frame}
   ST:=0;
   
   BName:='B_av.tif';
   BName:=GetOpenFileName( 'Open background image','Image File (*.tif)|*.tif','' )  ;
   if FileExists(BName) then
   begin
      if Open( BName, Background ) = file_Ok then
         Show( Background, 'Background')
      else
         Halt( 'Problem reading file!' ) ;
   end
   else
      Background:=0;

//   if GetString('Enter the background file name', BName) = id_Cancel then
//      Background:=0
//   else
//      if Open( cDIR+BName, Background ) = file_Ok then
//         Show( Background, 'Background')
//      else
//         Halt( 'Problem reading file!' ) ;
   
   FName:='S1';
   if GetString('Enter the file name',FName) = id_Cancel then halt;	  
   if FileExists( cDIR+FieldedFileName(FName,1)+'.tif') then
      if Query( 'Overwrite existing file?' ) = id_No then
         GetString('Enter the file name again',FName);
 
   bg:=Query( 'Is shutter controller on? Do you want to collect the background immediately after each frame?' );
   if bg = id_Yes then
   	  begin
	  IR_on:=1;
	  IR_off:=0;
	  
	  //Open and close shutter a few times to ensure the shutter is working properly
	  SetShutter(IR_on);
	  Delay(100);
	  SetShutter(IR_off);
  	  Delay(100);
	  SetShutter(IR_on);
	  Delay(100);
	  SetShutter(IR_off);
  	  Delay(100);
	  SetShutter(IR_on);
	  Delay(100);
	  SetShutter(IR_off);
  	  Delay(100);
	  SetShutter(IR_on);
	  //End testing shutter
	  BGFName:='BG_'+FName;		 
   	  if GetString('Enter the Background file name',BGFName) = id_Cancel then halt;	 
	  end;
	  
   //GetNumber('Enter the Binning parameter',Bin);
   if GetNumber('Enter the Exposure time in milliseconds',ET) = id_Cancel then halt;
   if GetNumber('Enter the SLEEP time in milliseconds',ST) = id_Cancel then halt;
   if GetNumber('Enter the number of SUBFrames',NF) = id_Cancel then halt;
   //if GetNumber('Enter the number of LOOPS',NL) = id_Cancel then halt;
   if GetNumber('Enter the number of the FIRST frame',NFIRST) = id_Cancel then halt;
   if GetNumber('Enter the number of the LAST frame',NLAST) = id_Cancel then halt;

   SaveCCD:=FALSE;
   SetRegion(CLeft,CTop,CRight,CBottom,0,0,xSize-1,ySize-1);
   SetRegion(RLeft,RTop,RRight,RBottom,0,0,xSize-1,ySize-1);
   if SelectImage( 'Select Image for ROI defenition, or cancel to use entire CCD',ROI ) = id_Ok then
   begin
      xyCoor:= GetROI(ROI);
      if IsNull( xyCoor ) then
      begin
         WriteStatus('ROI not found. Entire CCD will be used')
      end
      else
      begin
         iq:=Query( 'Save Entire CCD as well ?',Chr(13),'cancel will not save image at all');
         if iq = id_Cancel then SaveImage:=FALSE else SaveImage:=TRUE;
         if iq = id_Yes then
         begin 
            SaveCCD:=TRUE;
            SetRegion(CLeft,CTop,CRight,CBottom,0,0,xSize-1,ySize-1);
            SetRegion(RLeft,RTop,RRight,RBottom,xyCoor[0,..],xyCoor[1,..],xyCoor[2,..],xyCoor[3,..]);
         end
         else
         begin 
            SaveCCD:=FALSE;
            SetRegion(CLeft,CTop,CRight,CBottom,xyCoor[0,..],xyCoor[1,..],xyCoor[2,..],xyCoor[3,..]);
            SetRegion(RLeft,RTop,RRight,RBottom,0,0,CRight-CLeft,CBottom-CTop);
         end;
      end;
   end;
   Free(xyCoor);
   Free(ROI);

   Available:=ReceiveString('MotionStageServer','System','Topics');
   WriteInfo(Available);
   Available := 'U100;DG535;BNC575;C862;CTC283;MCDC;Manual' ;
   Controller:= 'NoScan';
   if SelectString('Choose which controller to scan, or Cancel to just loop',Available,Controller ) >= 0 then
   begin
      Unit:=GetUnit(Controller);
      WriteInfo( 'will scan ',Controller,' in unit of ',Unit) ;
      //SetDir(uDIR);
      ini:=GetOpenFileName( 'Open delay.ini or cancel to enter range','ini Files (*.ini)|*.ini','' )  ;
      if FileExists(ini) then
         OpenDelays(ini)
      else
         SetDelays;
      //SetDir(cDIR);
   end
   else
   begin
      Controller:='NoScan';
      WriteInfo(Controller);
	  Zero:=0;
      StartPosition:=0;
      EndPosition:=0;
      StepSize:=1;
      NSteps:=0;
      dp:=CreateArray(typ_LongInt,1,1);
	  dp[0]:=0;
   end;
end;

Procedure CheckPause;
var key,modify;
begin
   key:=ReadKey(Modify);
   if (key=vk_Escape) then
   begin
//      WriteInfo('Paused');
      If Query('Continue ?') = id_No then halt('HALT');
   end;
end;

Procedure AcquireRegion(DT; var Average);
var
   find;	{loop index}
// iName;	{Image name}
   Img ;	{Image variable }
   Sum ;
begin
   pvcSetGain( 1 ) ;   
   pvcSetExpMode( pvc_ExpTimed ) ;
   pvcSetExpTime( ET ) ;
   Img := CreateImage( typ_Word, Integer((CRight-CLeft+1)/Bin), Integer((CBottom-CTop+1)/Bin)) ;
   Sum := CreateImage( typ_Longint , Integer((CRight-CLeft+1)/Bin), Integer((CBottom-CTop+1)/Bin)) ;
   Sum :=0;
   for find := 1 to NF do
   begin
      WriteStatus('Acquiring at '+Str(DT)+', subframe = '+Str(find)+'/'+Str(NF));		  
      Img := pvcCapture( CLeft, CTop, CRight, CBottom, Bin, Bin) ;
//    iName:= FieldedFileName(FName+'_'+Str(DT),find);	  
      Sum:=Sum+Img;	  
      Free(Img)  ;
//    Delete(Img)  ;
//    Update(Average,FName+'_'+Str(DT));
   end ;
   Average:=Word((Sum/NF)-Background);
// Show(Average, FName+'_'+Str(DT)); {this generates all the images on desktop}										
// Delete(Average);
   Delete(Sum);
   Delete(Img);
   if (ET >= 10000) then PlaySound( 'D:\DATA\SOUNDS\Musica Close.wav' ) ;
   if KeyPressed then CheckPause;
   ClearKeys;
end;

{ MAIN PROGRAM }
var TD,i,j,Image,ROI,sd,sz,mean,SaveName,BGSaveName;
begin
   Zero:=0;
   Scale:=1;
   FileDirectory;  {set a working directory}										  
   GetParameters;  {set image acquisition parameters}
//   WriteInfo(RRight,' ',RLeft,' ',RTop,' ',RBottom);
   WriteLn('#FILE= ',FName);	
   if bg = id_Yes then WriteLn('#Background FILE= ',BGFName);	   		
   Image := CreateImage( typ_Word, Integer((CRight-CLeft+1)/Bin), Integer((CBottom-CTop+1)/Bin)) ;
   ROI   := CreateImage( typ_Word, Integer((RRight-RLeft+1)/Bin), Integer((RBottom-RTop+1)/Bin)) ;
   Show(Image,FName);
   if SaveCCD then SetWindowSize(Image,xSize/2,ySize/2);
   for j:=NFIRST to NLAST do
   begin
      for i:=0 to NSteps do
      begin
         TD:=dp[i];
         iu:=Zero+Scale*TD;
         sd:=Str(TD:0:3); // if IsFloat(TD) then sd:=Str(TD:0:3) else sd:=Str(TD:0:3);
         sz:=Str(Zero:0:3); // if IsFloat(Zero) then sz:=Str(Zero:0:3) else sz:=Str(Zero);
         if CompareStr(Controller,'NoScan') <> 0 then
         begin
            SaveName:=FieldedFileName(FName+'_'+Controller+'_'+sd,j);
			if bg = id_Yes then BGSaveName:=FieldedFileName(BGFName+'_'+Controller+'_'+sd,j);
            SetTarget(Controller,iu); 
            WaitTarget(Controller);
         end
         else
         begin
            SaveName:=FieldedFileName(FName,j);
			if bg = id_Yes then BGSaveName:=FieldedFileName(BGFName,j);
         end;
         
		 AcquireRegion(TD,Image);
         mean:=MeanOf(Image);
         if SaveCCD then
         begin
            SetROI(Image,RLeft,RTop,RRight,RBottom);
            ROI[0..(RRight-RLeft),0..(RBottom-RTop)]:=Image[RLeft..RRight,RTop..RBottom];
            mean:=MeanOf(ROI);
         end;
         //Show(Image, SaveName);
         Show(Image,ReplaceStr(SaveName,'.',',',rs_ReplaceAll));
         if SaveImage then sSave(Image, cDIR+SaveName+'.tif');
         WriteLn('Frame= ',SaveName,', loop= '+Str(j)+'/'+Str(NLAST)+', i= '+Str(i)+'/'+Str(NSteps)+', d= '+sd+', zero= '+sz,', MEAN= ',mean);			
         WaitForKey(ST);
		 
		 if bg = id_Yes then
		 	begin
//				 SetTarget('MCDC',IR_off); 
//            	 WaitTarget('MCDC');
				 SetShutter(IR_off);
				 AcquireRegion(TD,Image);
         		 mean:=MeanOf(Image);
         		 if SaveCCD then
         		 begin
          		   	  SetROI(Image,RLeft,RTop,RRight,RBottom);
          		      ROI[0..(RRight-RLeft),0..(RBottom-RTop)]:=Image[RLeft..RRight,RTop..RBottom];
            		  mean:=MeanOf(ROI);
         		 end;
         		 //Show(Image, SaveName);
         		 Show(Image,ReplaceStr(BGSaveName,'.',',',rs_ReplaceAll));
         		 if SaveImage then sSave(Image, cDIR+BGSaveName+'.tif');
         		 WriteLn('Frame= ',BGSaveName,', loop= '+Str(j)+'/'+Str(NLAST)+', i= '+Str(i)+'/'+Str(NSteps)+', d= '+sd+', zero= '+sz,', MEAN= ',mean);			
				 SetShutter(IR_on);
//         		 SetTarget('MCDC',IR_on); 
//            	 WaitTarget('MCDC');
				 WaitForKey(ST);
			end;
      end;
   end;
   WriteLn('');			
   Delete(Image);
   Delete(Background);
   WriteStatus('Acquisition completed');
   PlaySound( 'D:\DATA\SOUNDS\Mac.wav' ) ;
end
