 //////////////////////////////////////////////////////////////////////////////
 // Example of console application to be connected to CRW-DAQ pipe.
 // This console application make data acquisition for spectrometry.
 // CRW-DAQ program written on Daq Pascal takes this data via pipe,
 // draw in spectrometry window and controls start/stop/parameters.
 // Note that:
 // 1) Spectrometry data acquisition executes as separate low priority thread.
 // 2) Data acquisition works in polling mode, uses PKK4 CAMAC controller.
 //    In Simulation mode, generate random data.
 // 3) Commands and data transfer via stdin/out redirected to anonimouse pipe.
 // 4) Buffer access syncronized via critical section, class TLatch.
 // 5) Uses try..except..end, try..finally..end sections for safety.
 //////////////////////////////////////////////////////////////////////////////
program Pkk4_Server;
{$APPTYPE CONSOLE} // ! Declare application type as CONSOLE.
{$I _sysdef}       // ! By CRW conventions, include _SYSDEF,
uses               // ! ShareMem must to be FIRST USES UNIT,
 ShareMem,         // ! borlndmm.dll should present in path.
 SysUtils,Windows,Math,Classes,
 _alloc,_str,_mime,_rtc,_fio,_fifo,_ascio,_az,_polling,_task,
 _pio,_pkk4;
 //
 // General variables and constants
 //
const
 Terminated  : Boolean    = false;   // Program should be terminated
 Pkk         : TPkk4      = nil;     // PKK4 CAMAC controller
 BuffLatch   : TLatch     = nil;     // Buffer access synchronizer
 PkkThread   : TThread    = nil;     // Data acquisition thread
 Started     : LongBool   = false;   // Measurements started
 Simulation  : LongBool   = true;    //------ Simulation mode ----
 Portion     : Cardinal   = 0;       // Portion size for single transfer
 BuffSize    : Cardinal   = 0;       // Current buffer size
 Crate       : Cardinal   = 0;       // CAMAC crate number
 Station     : Cardinal   = 0;       // CAMAC station number
 StationLAM  : Cardinal   = 0;       // LAM mask for this station
 MaxBuffSize              = 1024*16; // Max. size of spectrum buffer
var
 HardwareBuff,TransferBuff : packed array[0..MaxBuffSize-1] of Cardinal;
 //
 // Thread safety, syncronized operations with spectrum buffers.
 // What is 0=Clear, 1=CopyAndClear, 2=Accumulate.
 //
 procedure OperateBuff(What:Cardinal;Chan:Cardinal=0;Data:Cardinal=0);
 begin
  BuffLatch.Lock;
  try
   case What of
    0: begin // Clear both buffers
        ZeroMemory(@HardwareBuff,sizeof(HardwareBuff));
        ZeroMemory(@TransferBuff,sizeof(TransferBuff));
       end;
    1: begin // Copy and clear hardware buffer
        TransferBuff:=HardwareBuff;
        ZeroMemory(@HardwareBuff,sizeof(HardwareBuff));
       end;
    2: begin // Accumulate data to hardware buffer
        if Chan < MaxBuffSize then Inc(HardwareBuff[Chan],Data);
       end;
   end;
  finally
   BuffLatch.Unlock;
  end;
 end;
 //
 // Abastract CAMAC ADC device, similar to Canberra ADC, for example only.
 //
 function adcIsLam:Boolean;             // Check ADC requested LAM
 begin
  Pkk.CNAF[Crate,Station,0,8];
  Result:=Pkk.XQ[Crate];
  //Result:=Pkk.LamWord[Crate] and StationLAM<>0; // Just another way to check LAM.
 end;
 procedure adcEnableLam;                // Enable ADC LAM requests
 begin
  Pkk.CNAF[Crate,Station,0,26];
 end;
 procedure adcDisableLam;               // Disable ADC LAM requests
 begin
  Pkk.CNAF[Crate,Station,0,24];
 end;
 procedure adcClearLam;                 // Clear LAM request
 begin
  Pkk.CNAF16[Crate,Station,0,2];
 end;
 function adcGetDataClear:Cardinal;     // Read data and clear LAM request
 begin
  Result:=Pkk.CNAF16[Crate,Station,0,2];
 end;
 //
 // Data acquisition thread.
 //
type
 TPkkThread = class(TThread)
 public
  procedure   Execute; override;
 end;
 //
 // General data acquisition routine.
 //
 procedure TPkkThread.Execute;
 var Chan:Cardinal; t0,t1:Double;
 begin
  t0:=0;
  while not Terminated do
  try
   if Started then begin      // If data acquisition enabled then:
    if Simulation then begin  // In simulation mode:
     t1:=mksecnow;            // Get pricise time 
     if t1-t0>1000 then begin // Simulate LAM each 1000 mks
      Chan:=random(BuffSize); // generate random channel
      OperateBuff(2,Chan,1);  // increment this channel
      t0:=t1;                 // save time for LAM
     end;
     //Sleep(1);              // and sleep
    end else begin            // In real CAMAC mode:
     if adcIsLam then begin   //  if ADC reguested LAM,
      Chan:=adcGetDataClear;  //  readout ADC channel
      OperateBuff(2,Chan,1);  //  increment this channel
     end;
    end;
   end else Sleep(1);         // else wait for start...
  except
   on E:Exception do StdOut.Put:=E.Message;
  end;
 end;
 //
 // Request: @help
 // Reply:   help info
 // Comment: Show help.
 //
 procedure DoHelp(const cmnd,args:LongString);
 begin
  StdOut.Put:=Format('%s',[cmnd]);
  StdOut.Put:='>> Command list:';
  StdOut.Put:='>> @help              This help.';
  StdOut.Put:='>> @exit=n            Exit program with code n.';
  StdOut.Put:='>> @errors            Return error counter.';
  StdOut.Put:='>> @memory            Return memory status.';
  StdOut.Put:='>> @processpriority=n Set process priority:Idle/Low/Normal/High/RealTime.';
  StdOut.Put:='>> @threadpriority=n  Set thread priority:tpIdle/tpLow/tpNormal/tpHigh/tpTimeCritical.';
  StdOut.Put:='>> @runcount=data     Demo data processing.';
  StdOut.Put:='>> @Clear             Clear spectrometry buffers.';
  StdOut.Put:='>> @Start             Start data acquisition.';
  StdOut.Put:='>> @Stop              Stop data acquisition.';
  StdOut.Put:='>> @Crate=1           Set CAMAC crate number.';
  StdOut.Put:='>> @Station=8         Set CAMAC station number.';
  StdOut.Put:='>> @Portion=32        Set portion size for single transfer.';
  StdOut.Put:='>> @BuffSize=1024     Set spectrometry buffer size, channels.';
  StdOut.Put:='>> @Transfer          Transfer spectrometry buffer to host.';
  StdOut.Put:='>> @BaseAddr=$100     Set PKK4 CAMAC controller base I/O address.';
  StdOut.Put:='>> @IrqNumber=9       Set PKK4 CAMAC controller IRQ number.';
 end;
 //
 // Request: @exit
 // Request: @exit=n
 // Reply:   @exit=n
 // Comment: Terminate program with exit code n.
 //
 procedure DoExit(const cmnd,args:LongString);
 begin
  Sound(2000,100);
  Terminated:=true;
  System.ExitCode:=StrToIntDef(args,0);
  StdOut.Put:=Format('%s=%d',[cmnd,System.ExitCode]);
 end;
 //
 // Request: @errors
 // Request: @errors=n
 // Reply:   @errors=n
 // Comment: Return value n of error counter.
 //
 procedure DoErrors(const cmnd,args:LongString);
 var
  n : LongInt;
 begin
  if Str2Long(args,n)
  then n:=LockedExchange(StdIoErrorCount,n)
  else n:=StdIoErrorCount;
  StdOut.Put:=Format('%s=%d',[cmnd,n]);
 end;
 //
 // Request: @memory
 // Request: @memory=n
 // Comment: Return AllocMemSize.
 //
 procedure DoMemory(const cmnd,args:LongString);
 begin
  StdOut.Put:=Format('%s=%d',[cmnd,GetAllocMemSize]);
 end;
 //
 // Request: @ProcessPriority
 // Request: @ProcessPriority=n
 // Reply:   @ProcessPriority=n
 // Comment: Set process priority class.
 //
 procedure DoProcessPriority(const cmnd,args:LongString);
 var p:DWORD;
 begin
  if not IsEmptyStr(args) then begin
   p:=GetPriorityClassByName(args);
   if p>0 then SetPriorityClass(GetCurrentProcess,p);
  end;
  StdOut.Put:=Format('%s=%s',[cmnd,GetPriorityClassName(GetPriorityClass(GetCurrentProcess))]);
 end;
 //
 // Request: @ThreadPriority
 // Request: @ThreadPriority=n
 // Reply:   @ThreadPriority=n
 // Comment: Set thread priority class.
 //
 procedure DoThreadPriority(const cmnd,args:LongString);
 var p:TThreadPriority;
 begin
  if not IsEmptyStr(args) then begin
   p:=GetPriorityByName(args);
   StdIn.Priority:=p;
   StdOut.Priority:=p;
   case p of
    tpIdle         : SetThreadPriority(GetCurrentThread,THREAD_PRIORITY_IDLE);
    tpLowest       : SetThreadPriority(GetCurrentThread,THREAD_PRIORITY_LOWEST);
    tpLower        : SetThreadPriority(GetCurrentThread,THREAD_PRIORITY_BELOW_NORMAL);
    tpNormal       : SetThreadPriority(GetCurrentThread,THREAD_PRIORITY_NORMAL);
    tpHigher       : SetThreadPriority(GetCurrentThread,THREAD_PRIORITY_ABOVE_NORMAL);
    tpHighest      : SetThreadPriority(GetCurrentThread,THREAD_PRIORITY_HIGHEST);
    tpTimeCritical : SetThreadPriority(GetCurrentThread,THREAD_PRIORITY_TIME_CRITICAL);
   end;
  end;
  StdOut.Put:=Format('%s=%s',[cmnd,GetPriorityName(StdIn.Priority)]);
 end;
 //
 // Request: @Clear
 // Reply:   @Clear
 // Comment: Clear spectrometry buffer.
 //
 procedure DoClear(const cmnd,args:LongString);
 begin
  OperateBuff(0);
  StdOut.Put:=Format('%s',[cmnd]);
 end;
 //
 // Request: @Start
 // Reply:   @Start=0/1
 // Comment: Start data acquisition.
 //
 procedure DoStart(const cmnd,args:LongString);
 begin
  if (Crate=0) or (Station=0) or (Portion=0) or (BuffSize=0) then begin
   StdOut.Put:='CAMAC parameters is not specified.';
   StdOut.Put:='Type @Help to get help.';
  end else begin
   if Simulation then begin
    // Nothing to do...
    Started:=true;
   end else begin
    if Pkk[Crate] then begin         // Check if crate operable
     Pkk.IrqMask[Crate]:=0;          // Disable PKK4 interrupts
     Pkk.LamMask[Crate]:=StationLAM; // Enable  PKK4 LAM requests
     adcEnableLam;                   // Enable  ADC  LAM requests
     adcClearLam;                    // Clear ADC LAM
     Pkk.Z[Crate]:=true;             // CAMAC Zero  signal
     Pkk.C[Crate]:=true;             // CAMAC Clear signal
     Started:=true;                  // Now we can measure...
    end else StdOut.Put:='Could not declare CAMAC crate!';
   end;
  end;
  if Started then Sound(2000,100);
  StdOut.Put:=Format('%s=%d',[cmnd,ord(Started)]);
 end;
 //
 // Request: @Stop
 // Reply:   @Stop=0/1
 // Comment: Stop data acquisition.
 //
 procedure DoStop(const cmnd,args:LongString);
 begin
  if Simulation then begin
    // Nothing to do...
  end else begin
   if Started then begin
    adcDisableLam;         // Disable ADC  LAM requests
    Pkk.LamMask[Crate]:=0; // Disable PKK4 LAM requests
    Pkk.IrqMask[Crate]:=0; // Disable PKK4 interrupts
   end;
  end;
  Started:=false;
  Sound(2000,100);
  StdOut.Put:=Format('%s=%d',[cmnd,ord(not Started)]);
 end;
 //
 // Request: @Crate=n
 // Reply:   @Crate=Crate
 // Comment: Set CAMAC crate number n=1..4.
 //
 procedure DoCrate(const cmnd,args:LongString);
 var n:Integer;
 begin
  n:=StrToIntDef(args,0);
  if n in [1..4] then Crate:=n;
  StdOut.Put:=Format('%s=%d',[cmnd,Crate]);
 end;
 //
 // Request: @Station=n
 // Reply:   @Station=Station
 // Comment: Set CAMAC station number n=1..25.
 //
 procedure DoStation(const cmnd,args:LongString);
 var n:Integer;
 begin
  n:=StrToIntDef(args,0);
  if n in [1..25] then Station:=n;
  StdOut.Put:=Format('%s=%d',[cmnd,Station]);
  StationLAM:=1 shl (Station-1);
 end;
 //
 // Request: @Portion=n
 // Reply:   @Portion=Portion
 // Comment: Set data transfer portion n=1..32.
 //
 procedure DoPortion(const cmnd,args:LongString);
 var n:Integer;
 begin
  n:=StrToIntDef(args,0);
  if n in [1..32] then Portion:=n;
  StdOut.Put:=Format('%s=%d',[cmnd,Portion]);
 end;
 //
 // Request: @Transfer
 // Reply:   @Transfer=Offset,BlockSize,mime_encode(BlockData)
 // Comment: Transfer data, portion by portion.
 //
 procedure DoTransfer(const cmnd,args:LongString);
 var Offset,BlockSize:Cardinal; BlockData:LongString;
 begin
  Offset:=0;
  OperateBuff(1);
  while Offset<BuffSize do begin
   BlockSize:=Portion;
   if Offset+BlockSize>BuffSize then BlockSize:=BuffSize-Offset;
   SetString(BlockData,PChar(@TransferBuff[Offset]),BlockSize*SizeOf(Cardinal));
   StdOut.Put:=Format('%s=%d,%d,%s',[cmnd,Offset,BlockSize,mime_encode(BlockData)]);
   inc(Offset,BlockSize);
  end;
 end;
 //
 // Request: @BuffSize=n
 // Reply:   @BuffSize=BuffSize
 // Comment: Set spectrometry buffer size (depends on ADC range).
 //
 procedure DoBuffSize(const cmnd,args:LongString);
 var n:Integer;
 begin
  n:=StrToIntDef(args,0);
  if n<=MaxBuffSize then BuffSize:=n else BuffSize:=MaxBuffSize;
  StdOut.Put:=Format('%s=%d',[cmnd,BuffSize]);
 end;
 //
 // Request: @BaseAddr=n
 // Reply:   @BaseAddr=$BaseAddr
 // Comment: Set base address of PKK4.
 //
 procedure DoBaseAddr(const cmnd,args:LongString);
 var n:Integer;
 begin
  n:=StrToIntDef(args,0);
  if n>0 then Pkk.BaseAddr:=n;
  StdOut.Put:=Format('%s=$%x',[cmnd,Pkk.BaseAddr]);
 end;
 //
 // Request: @IrqNumber=n
 // Reply:   @IrqNumber=IrqNumber
 // Comment: Set IRQ number of PKK4.
 //
 procedure DoIrqNumber(const cmnd,args:LongString);
 var n:Integer;
 begin
  n:=StrToIntDef(args,0);
  if n>0 then Pkk.IrqNumber:=n;
  StdOut.Put:=Format('%s=%d',[cmnd,Pkk.IrqNumber]);
 end;
 //
 // This callback handles unrecognized commands.
 //
 procedure DoSpecificCommands(const args:LongString);
 begin
  if Length(args)>0 then
  StdOut.Put:=Format('Could not recognize "%s"',[args]);
 end;
 //
 // Application specific initialization.
 //
 procedure SpecificInitialization;
 begin
  if not iopm_open('giveio.sys') then RAISE Exception.Create('IOPM failure!');
  Sound(2000,100);                       // Play sound to check IOPM
  Pkk:=NewPkk4($100,9);                  // Create PKK4 controller                                     
  BuffLatch:=NewLatch;                   // Create buffer access syncronizer
  PkkThread:=TPkkThread.Create(true);    // Create data acquizition thread
  PkkThread.Priority:=tpIdle;            // Low priority to work in background
  PkkThread.Resume;                      // Enable thread execution
  OperateBuff(0);                        // Clear buffers
  StdOut.Put:='Spectrometry DAQ demo.';  // Greeting message
  StdOut.Put:='Type @Help to get help.'; // Greeting message
  // 
  // Register user commands coming from StdIn.
  //
  SystemEchoProcedure:=StdOutEcho;
  StdIn.SpecHandler:=DoSpecificCommands;
  StdIn.AddCommand('@Help',            DoHelp);
  StdIn.AddCommand('@Exit',            DoExit);
  StdIn.AddCommand('@Errors',          DoErrors);
  StdIn.AddCommand('@Memory',          DoMemory);
  StdIn.AddCommand('@ProcessPriority', DoProcessPriority);
  StdIn.AddCommand('@ThreadPriority',  DoThreadPriority);
  StdIn.AddCommand('@Stop',            DoStop);
  StdIn.AddCommand('@Start',           DoStart);
  StdIn.AddCommand('@Clear',           DoClear);
  StdIn.AddCommand('@Crate',           DoCrate);
  StdIn.AddCommand('@Station',         DoStation);
  StdIn.AddCommand('@Portion',         DoPortion);
  StdIn.AddCommand('@Transfer',        DoTransfer);
  StdIn.AddCommand('@BuffSize',        DoBuffSize);
  StdIn.AddCommand('@BaseAddr',        DoBaseAddr);
  StdIn.AddCommand('@IrqNumber',       DoIrqNumber);
 end;
 //
 // Application specific finalization.
 //
 procedure SpecificFinalization;
 begin
  Kill(TObject(PkkThread));              // Destroy data acquisition thread
  Kill(BuffLatch);                       // Destroy buffer access synchronizer
  Kill(Pkk);                             // Destroy PKK CAMAC controller
 end;
 //
 // Application specific polling.
 //
 procedure SpecificPolling;
 begin
  if BecameZombie(FILE_TYPE_PIPE,1000) then StdIn.Put:='@Exit';
 end;
 //
 // Main program
 //
begin
 try
  try
   SpecificInitialization;
   while not Terminated do begin
    while StdIn.Count>0 do StdIn.Process(StdIn.Get);
    SpecificPolling;
    Sleep(1);
   end;
  finally
   SpecificFinalization;
  end;
 except
  on E:Exception do StdOut.Put:=E.Message;
 end;
 Sleep(100);
 if BecameZombie(FILE_TYPE_PIPE) then ExitProcess(1);
end.
