labraddatastructures.pas

As science advances, novel experiments are becoming more and more complex, requiring a zoo of contro

begin
  Info:=Locate(Indices, ntArray);
  move(Info.Data^, Info.Data, 4);
  setlength(Result, Info.Node.Dimensions);
  move(Info.Data^, Result[0], 4*Info.Node.Dimensions);
end;

procedure TLabRADData.SetArraySize(                           Size: integer);           begin SetArraySize([],       [Size]); end;
procedure TLabRADData.SetArraySize(Index: integer;            Size: integer);           begin SetArraySize([Index],  [Size]); end;
procedure TLabRADData.SetArraySize(Indices: array of integer; Size: integer);           begin SetArraySize( Indices, [Size]); end;
procedure TLabRADData.SetArraySize(                           Sizes: array of integer); begin SetArraySize([],        Sizes); end;
procedure TLabRADData.SetArraySize(Index: integer;            Sizes: array of integer); begin SetArraySize([Index],   Sizes); end;
procedure TLabRADData.SetArraySize(Indices: array of integer; Sizes: array of integer);
var Info:   TLRDInfo;
    P:      PByte;
    OldCnt: integer;
    NewCnt: integer;
    a:      integer;
begin
  Info:=Locate(Indices, ntArray);
  if length(Sizes)<>Info.Node.Dimensions then ; //raise Dimensionality error!
  // Check for positive indices
  move(Info.Data^, P, 4);
  OldCnt:=1;
  NewCnt:=1;
  for a:=1 to Info.Node.Dimensions do begin
    OldCnt:=OldCnt*PInteger(P)^;
    NewCnt:=NewCnt*Sizes[a-1];
    inc(P, 4);
  end;
  // Free deleted entries
  if NewCnt<OldCnt then begin
    inc(P, NewCnt*Info.Node.Down.DataSize);
    for a:=NewCnt+1 to OldCnt do begin
      LabRADFreeData(P, Info.Node.Down);
      inc(P, Info.Node.DataSize);
    end;
  end;
  move(Info.Data^, P, 4);
  move(Sizes[0], P^, 4*length(Sizes));
  if OldCnt=NewCnt then exit;
  // Initialize new entries
  ReallocMem(P, 4*Info.Node.Dimensions + NewCnt*Info.Node.Down.DataSize);
  move(P, Info.Data^, 4);
  if NewCnt>OldCnt then begin
    inc(P, 4*length(Sizes));
    inc(P, OldCnt*Info.Node.Down.DataSize);
    for a:=OldCnt+1 to NewCnt do begin
      LabRADZeroData(P, Info.Node.Down);
      inc(P, Info.Node.Down.DataSize);
    end;
  end;
end;


function TLabRADData.IsCluster:                 boolean; begin Result:=IsCluster([]     ); end;
function TLabRADData.IsCluster(Index: integer): boolean; begin Result:=IsCluster([Index]); end;
function TLabRADData.IsCluster(Indices: array of integer): boolean;
var Info: TLRDInfo;
begin
  Info:=Locate(Indices, ntAnything);
  Result:=Info.Node.NodeType=ntCluster;
end;

procedure TLabRADData.Convert(TypeTree: TLabRADTypeTree);
begin
  DoConversion(fTypeTree.Match(TypeTree));
end;

procedure TLabRADData.Convert(TypeTrees: array of TLabRADTypeTree);
begin
  if length(TypeTrees)=0 then exit;
  DoConversion(fTypeTree.Match(TypeTrees));
end;

procedure TLabRADData.DoConversion(TypeTree: TLabRADTypeTree);
begin
  fTypeTree.Free;
  fTypeTree:=TypeTree;
  fTypeTag:=fTypeTree.TypeTag;
  if fTypeTree.TopNode.NeedsAttn then LabRADConvertData(fDataBuffer, fTypeTree.TopNode);
end;



constructor TLabRADRecord.Create(Setting: TLabRADID; TypeTag: string);
begin
  inherited Create;
  fStatus:= rsDone;
  fSetting:=Setting;
  fData:=   TLabRADData.Create(TypeTag);
end;

constructor TLabRADRecord.Create(Setting: TLabRADID; Data: TLabRADData=nil);
begin
  inherited Create;
  if not assigned(Data) then Data:=TLabRADData.Create;
  fStatus:= rsDone;
  fSetting:=Setting;
  fData:=   Data;
end;

constructor TLabRADRecord.Create(Endianness: TLabRADEndianness);
begin
  inherited Create;
  fStatus:=    rsUnflattenInfo;
  fSetting:=   0;
  fData:=      TLabRADData.Create('(wsi)', Endianness);
  fEndianness:=Endianness;
end;

destructor TLabRADRecord.Destroy;
begin
  if assigned(fData) then fData.Free;
  inherited;
end;

function TLabRADRecord.Flatten(Endianness: TLabRADEndianness = enLittleEndian): string;
var d: char;
    tag: string;
    c1, c2: integer;
begin
  if not assigned(fData) then ;// Barf
  tag:=fData.TypeTag;
  c1:=length(tag);
  Result:=#0#0#0#0 + #0#0#0#0 + tag + #0#0#0#0 + fData.Flatten(Endianness);
  c2:=length(Result)-c1-12;
  move(fSetting, Result[1], 4);
  move(c1,       Result[5], 4);
  move(c2,       Result[c1+9], 4);
  if Endianness=enBigEndian then begin
    d:=Result[    1]; Result[    1]:=Result[    4]; Result[    4]:=d;
    d:=Result[    2]; Result[    2]:=Result[    3]; Result[    3]:=d;
    d:=Result[    5]; Result[    5]:=Result[    8]; Result[    8]:=d;
    d:=Result[    6]; Result[    6]:=Result[    7]; Result[    7]:=d;
    d:=Result[c1+ 9]; Result[c1+ 9]:=Result[c1+12]; Result[c1+12]:=d;
    d:=Result[c1+10]; Result[c1+10]:=Result[c1+11]; Result[c1+11]:=d;
  end;
end;

function TLabRADRecord.Unflatten(var BufferPtr: PByte; var Size: integer): Boolean;
var tag: string;
begin
  if fStatus=rsDone then ; // BARF
  dec(fDataLeft, Size);
  Result:=fData.Unflatten(BufferPtr, Size);
  inc(fDataLeft, Size);
  if Result and (fStatus=rsUnflattenInfo) then begin
    fSetting:= fData.GetWord   (0);
    tag:=      fData.GetString (1);
    fDataLeft:=fData.GetInteger(2);
    fData.Free;
    fData:=nil;
    fData:=TLabRADData.Create(tag, fEndianness);
    fStatus:=rsUnflattenData;
    dec(fDataLeft, Size);
    Result:=fData.Unflatten(BufferPtr, Size);
    inc(fDataLeft, Size);
  end;
  if Result and (fStatus=rsUnflattenData) then begin
    if fDataLeft<>0 then ; //BARF
    fStatus:=rsDone;
   end else begin
    if fDataLeft<0 then ; //BARF
  end;
end;

function TLabRADRecord.Pretty(ShowTypes: Boolean=False): string;
begin
  if not assigned(fData) then ;// Barf
  if ShowTypes then begin
    Result:='record: (setting: '+inttostr(int64(fSetting))+', type: '''+fData.TypeTag+''', data: '+fData.Pretty(ShowTypes)+')';
   end else begin
    Result:='('+inttostr(int64(fSetting))+', '''+fData.TypeTag+''', '+fData.Pretty(ShowTypes)+')';
  end;
end;




constructor TLabRADPacket.Create(Context: TLabRADContext; Request: TLabRADRequestID; SourceTarget: TLabRADID);
begin
  inherited Create;
  fStatus:=  psDone;
  fContext:= Context;
  fRequest:= Request;
  fSrcTgt:=  SourceTarget;
  fData:=    nil;
  fRefCount:=1;
  setlength(fRecords, 0);
end;

constructor TLabRADPacket.Create(ContextHigh, ContextLow: TLabRADID; Request: TLabRADRequestID; SourceTarget: TLabRADID);
begin
  inherited Create;
  fStatus:=      psDone;
  fContext.High:=ContextHigh;
  fContext.Low:= ContextLow;
  fRequest:=     Request;
  fSrcTgt:=      SourceTarget;
  fData:=        nil;
  fRefCount:=    1;
  setlength(fRecords, 0);
end;

constructor TLabRADPacket.Create(Endianness: TLabRADEndianness);
begin
  inherited Create;
  fStatus:=      psUnflattenInfo;
  fContext.High:=0;
  fContext.Low:= 0;
  fRequest:=     0;
  fSrcTgt:=      0;
  fData:=        TLabRADData.Create('(wwiwi)', Endianness);
  fEndianness:=  Endianness;
  fRefCount:=    1;
  setlength(fRecords, 0);
end;

destructor TLabRADPacket.Destroy;
var a: integer;
begin
  if assigned(fData) then fData.Free;
  for a:=1 to length(fRecords) do
    fRecords[a-1].Free;
  inherited;
end;

procedure TLabRADPacket.Free;
begin
  if not assigned(self) then exit;
  dec(fRefCount);
  if fRefCount>0 then exit;
  inherited;
end;

procedure TLabRADPacket.Keep;
begin
  inc(fRefCount);
end;

function TLabRADPacket.GetRecord(Index: integer): TLabRADRecord;
begin
  if (Index<0) or (Index>=length(fRecords)) then ; // BARF
  Result:=fRecords[Index];
end;

function TLabRADPacket.Flatten(Endianness: TLabRADEndianness = enLittleEndian): string;
var a: integer;
    d: char;
begin
  setlength(Result, 20);
  move(fContext, Result[ 1], 8);
  move(fRequest, Result[ 9], 4);
  move(fSrcTgt,  Result[13], 4);
  for a:=1 to length(fRecords) do
    Result:=Result+fRecords[a-1].Flatten(Endianness);
  a:=length(Result)-20;
  move(a, Result[17], 4);
  if Endianness=enBigEndian then begin
    d:=Result[ 1]; Result[ 1]:=Result[ 4]; Result[ 4]:=d;
    d:=Result[ 2]; Result[ 2]:=Result[ 3]; Result[ 3]:=d;
    d:=Result[ 5]; Result[ 5]:=Result[ 8]; Result[ 8]:=d;
    d:=Result[ 6]; Result[ 6]:=Result[ 7]; Result[ 7]:=d;
    d:=Result[ 9]; Result[ 9]:=Result[12]; Result[12]:=d;
    d:=Result[10]; Result[10]:=Result[11]; Result[11]:=d;
    d:=Result[13]; Result[13]:=Result[16]; Result[16]:=d;
    d:=Result[14]; Result[14]:=Result[15]; Result[15]:=d;
    d:=Result[17]; Result[17]:=Result[20]; Result[20]:=d;
    d:=Result[18]; Result[18]:=Result[19]; Result[19]:=d;
  end;
end;

function TLabRADPacket.Unflatten(var BufferPtr: PByte; var Size: integer): Boolean;
begin
  if fStatus=psDone then ; // BARF
  if fStatus=psUnflattenInfo then begin
    Result:=fData.Unflatten(BufferPtr, Size);
    if not Result then exit;
    fContext.High:=fData.GetWord   (0);
    fContext.Low:= fData.GetWord   (1);
    fRequest:=     fData.GetInteger(2);
    fSrcTgt:=      fData.GetWord   (3);
    fDataLeft:=    fData.GetInteger(4);
    fData.Free;
    fData:=nil;
    fStatus:=psUnflattenData;
   end else begin
    dec(fDataLeft, Size);
    Result:=fRecords[high(fRecords)].Unflatten(BufferPtr, Size);
    inc(fDataLeft, Size);
  end;
  while Result do begin
    if fDataLeft>0 then begin
      setlength(fRecords, length(fRecords)+1);
      fRecords[high(fRecords)]:=TLabRADRecord.Create(fEndianness);
      dec(fDataLeft, Size);
      Result:=fRecords[high(fRecords)].Unflatten(BufferPtr, Size);
      inc(fDataLeft, Size);
     end else begin
      if fDataLeft<0 then ; //BARF
      fStatus:=psDone;
      exit;
    end;
  end;
  if fDataLeft<0 then ; //BARF
end;

function TLabRADPacket.Pretty(ShowTypes: Boolean=False): string;
var a: integer;
begin
  Result:='';
  for a:=1 to length(fRecords) do begin
    if Result<>'' then Result:=Result+', ';
    Result:=Result+fRecords[a-1].Pretty(ShowTypes);
  end;
  if ShowTypes then begin
    Result:='packet: (context: ('+inttostr(int64(fContext.High))+', '+inttostr(int64(fContext.Low))+
                  '), request: '+inttostr(fRequest)+
                   ', source/target: '+inttostr(fSrcTgt)+
                   ', payload: ['+Result+'])';
   end else begin
    Result:='(('+inttostr(int64(fContext.High))+', '+inttostr(int64(fContext.Low))+'), '+
                 inttostr(fRequest)+', '+inttostr(fSrcTgt)+', ['+Result+'])';
  end;
end;

function TLabRADPacket.AddRecord(Setting: TLabRADID; TypeTag: string): TLabRADRecord;
begin
  Result:=TLabRADRecord.Create(Setting, TypeTag);
  setlength(fRecords, length(fRecords)+1);
  fRecords[high(fRecords)]:=Result;
end;

function TLabRADPacket.AddRecord(Setting: TLabRADID; Data: TLabRADData=nil): TLabRADRecord;
begin
  Result:=TLabRADRecord.Create(Setting, Data);
  setlength(fRecords, length(fRecords)+1);
  fRecords[high(fRecords)]:=Result;
end;

function TLabRADPacket.AddRecord(Setting: TLabRADID; Code: integer; Error: string): TLabRADRecord;
begin
  Result:=TLabRADRecord.Create(Setting, 'E');
  Result.Data.SetInteger(0, Code);
  Result.Data.SetString (1, Error);
  setlength(fRecords, length(fRecords)+1);
  fRecords[high(fRecords)]:=Result;
end;

function TLabRADPacket.Count: integer;
begin
  Result:=length(fRecords);
end;

procedure TLabRADPacket.SetContextHigh(Value: TLabRADID);
begin
  fContext.High:=Value;
end;

end.