unit ExpImpu;
  { Export/Import unit }
interface
uses
  SysUtils, Classes, UlanGlob, WinUtl,
  UlanType, ULEType, ULEObju{v0.18}, ULObju, ULFObju, Fileu{,
  MS2IEEE}{/v0.18};

type

  EConvert = class(Exception);

procedure ULConvertFrom(E: TULEObj; Src, Dest: TStream);
  { Convert data from Src stream to Dest stream (both opened) using
    info in E object. Src is in format specified in E, Dest is
    in new standard raw data format, i.e. array of TExpPoint. }

procedure ULConvertTo(E: TULEObj; Src, Dest: TStream);
  { Convert data from Src stream to Dest stream (both opened) using
    info in E object. Src is in standard raw data format (array of TExpPoint),
    Dest is in format specified by E. }

procedure FillDatExpImp(E: TULEObj);
  { Fill the E object with information needed for export/import of
    .DAT files }

procedure FillTxtExpImp(E: TULEObj);
procedure FillULDExpImp(E: TULEObj);
procedure FillBExpImp(E: TULEObj);

{v0.18}
procedure FillTomExpImp(E: TULEObj);

function ConvertDataFile(const InFileName: string; const InFileFormat: string;
  const OutFileName: string; const OutFileFormat: string): integer;

function TryConvertFromFile(const AFileName: string; Dest: TStream): boolean;
  { try to convert from AFileName (check if extension registered),
    returns false if unknown format. Raises exception upon some other
    kind of error }

procedure ULEFInit(var ef:TULFObj);
procedure ULEFDone(var ef:TULFObj);
{/v0.18}

implementation

{v0.18}

Type

  MKS = Array [0..3] of Byte;

Function MS2IEEE(Var MS) : Real;
{ Converts a 4 Byte Microsoft format single precision Real Variable as
  used in earlier versions of QuickBASIC and GW-BASIC to IEEE 6 Byte Real }
Var
  m    : MKS Absolute MS;
  r    : Real;
  ieee : Array [0..5] of Byte Absolute r;
begin
  FillChar(r, sizeof(r), 0);
  ieee[0] := m[3];
  ieee[3] := m[0];
  ieee[4] := m[1];
  ieee[5] := m[2];
  MS2ieee := r;
end;  { MStoIEEE }


Function IEEE2MS(ie : Real) : LongInt;
{ LongInt Type used only For convenience of Typecasting. Note that this will
  only be effective where the accuracy required can be obtained in the 23
  bits that are available With the MKS Type. }
Var
  ms    : MKS;
  ieee  : Array [0..5] of Byte Absolute ie;
begin
  ms[3] := ieee[0];
  ms[0] := ieee[3];
  ms[1] := ieee[4];
  ms[2] := ieee[5];
  IEEE2MS := LongInt(ms);
end; { IEEEtoMS }


(*
float IEEE4tofloat(void *p)
{
 uchar *up=p;
 long mantisa;
 int exponent;

 mantisa=up[0]|((unsigned)up[1]<<8)|
         ((unsigned long)up[2]<<16)|0x800000;
 if(up[3]&0x80) mantisa=-mantisa;
 exponent=(up[2]>>7)|(((int)up[3]&0x7f)<<1);
 return ldexp((float)mantisa,exponent-0x7f-23);
};


function  IEEE4ToFloat(s:single; var f:mks):boolean;
var
  up:array[0..3]of byte;
  mantisa:longint;
  exponent:longint;
begin
  mantisa :=
     longint(up[0]) or
    (longint(up[1]) shl 8) or
    (longint(up[2]) shl 16) or
    $800000;

  if (up[3] and $80) <> 0 then
    mantisa := -mantisa;

  exponent :=
    ( up[2] shr 7 ) or
    (( (int)up[3]&0x7f) << 1 );
 return ldexp((float)mantisa,exponent-0x7f-23);

end;
*)

{/v0.18}


procedure ULConvertFrom(E: TULEObj; Src, Dest: TStream);
var
  B: Byte;
  W: Word;
  DW: LongWord;
  I8: ShortInt;
  I16: SmallInt;
  I32: Longint;
  S: Single;
  {v0.18}
  msf4: mks{bfloat4};
  {/v0.18}
  P: TExpPoint;
  ok: boolean;
  line: shortstring;
  X: TXValue;
begin
  if (E = nil) or (Src = nil) or (Dest = nil) then
    raise EInvalidParams.Create('ULConvertFrom nil params');
  if not E.TextFile then begin
    Src.Position := E.HeadLen;
    Dest.Size := 0;
    X := 0;
    repeat
      ok := true;
      case E.XValueType of
        xtNone: begin p.X := X; X := X + e.XInterval; end;
        xtByte: begin ok := src.Read(B, sizeof(B)) = sizeof(B); p.X := B; end;
        xtWord: begin ok := src.Read(W, sizeof(W)) = sizeof(W); p.X := W; end;
        xtDWord: begin ok := src.Read(DW, sizeof(DW)) = sizeof(DW); p.X := DW; end;
        xtInt8: begin ok := src.Read(I8, sizeof(I8)) = sizeof(I8); p.X := I8; end;
        xtInt16: begin ok := src.Read(I16, sizeof(I16)) = sizeof(I16); p.X := I16; end;
        xtInt32: begin ok := src.Read(I32, sizeof(I32)) = sizeof(I32); p.X := I32; end;
        xtSingle: begin ok := src.Read(S, sizeof(S)) = sizeof(S); p.X := S; end;
        xtMSFloat4: begin ok := src.Read(msf4, sizeof(msf4)) = sizeof(msf4);
          p.X := ms2ieee{Bfloat4toExtended}(msf4); end;
      else
        raise ERangeError.Create('ULConvertFrom E.XValueType');
      end;
      if ok then begin
        case E.YValueType of
          ytNone: raise EInvalidParams.Create('ULConvertFrom E.YValueType');
          ytByte: begin ok := src.Read(B, sizeof(B)) = sizeof(B); p.Y := B; end;
          ytWord: begin ok := src.Read(W, sizeof(W)) = sizeof(W); p.Y := W; end;
          ytDWord: begin ok := src.Read(DW, sizeof(DW)) = sizeof(DW); p.Y := DW; end;
          ytInt8: begin ok := src.Read(I8, sizeof(I8)) = sizeof(I8); p.Y := I8; end;
          ytInt16: begin ok := src.Read(I16, sizeof(I16)) = sizeof(I16); p.Y := I16 end;
          ytInt32: begin ok := src.Read(I32, sizeof(I32)) = sizeof(I32); p.Y := I32 end;
          ytSingle: begin ok := src.Read(S, sizeof(S)) = sizeof(S); p.Y := S end;
          ytMSFloat4: begin
            ok := src.Read(msf4, sizeof(msf4)) = sizeof(msf4);
            p.y := ms2ieee{Bfloat4toExtended}(msf4)
          end;
        else
          raise ERangeError.Create('ULConvertFrom E.YValueType');
        end;
        if ok then begin
          if E.XCoef <> 0 then begin
            p.X := p.X * E.XCoef;
          end;
          if E.YCoef <> 0 then begin
            p.Y := p.Y * E.YCoef;
          end;
          Dest.WriteBuffer(p, sizeof(p));
        end;
      end;
    until not ok;
  end else begin
    Src.Position := E.HeadLen;
    Dest.Size := 0;
    while StreamReadln(Src, line) do begin

    end;
  end;
end;

procedure ULConvertTo(E: TULEObj; Src, Dest: TStream);
var
  p: TExpPoint;
  i: integer;
  xs, ys: shortstring;
  {v0.18}
  msf4:mks;
  msfl:longint absolute msf4;
  {/v0.18}

  B: Byte;
  W: Word;
  DW: LongWord;
  I8: ShortInt;
  I16: SmallInt;
  I32: Longint;

begin
  if (E = nil) or (Src = nil) or (Dest = nil) then
    raise EInvalidParams.Create('ULConverTo nil params');
  if E.TextFile then begin
    Src.Position := 0;
    Dest.Size := 0;
    repeat
      i := Src.Read(p, sizeof(p));
      if i <> sizeof(p) then
        break;
      if E.XCoef <> 0 then
        p.X := p.X / E.XCoef;
      if E.YCoef <> 0 then
        p.Y := p.Y / E.YCoef;
      str(p.x, xs);
      str(p.y, ys);
      StreamWriteln(Dest, xs + ',' + ys);
    until false;
  end else begin
    Src.Position := 0;{E.HeadLen;}
    Dest.Size := 0;
    b := 0;
    i := 0;
    while i < E.HeadLen do begin
      Dest.WriteBuffer(b, sizeof(b));
      inc(i);
    end;
    repeat
      i := Src.Read(p, sizeof(p));
      if i <> sizeof(p) then
        break;
      if E.XCoef <> 0 then
        p.X := p.X / E.XCoef;
      if E.YCoef <> 0 then
        p.Y := p.Y / E.YCoef;
      case E.XValueType of
        xtNone:;
        xtByte: begin B := byte(round(p.X)); Dest.WriteBuffer(B, sizeof(B)); end;
        xtWord: begin W := word(round(p.X)); Dest.WriteBuffer(W, sizeof(W)); end;
        xtDWord: begin DW := LongWord(round(p.X)); Dest.WriteBuffer(DW, sizeof(DW)); end;
        xtInt8: begin I8 := shortint(round(p.X)); Dest.WriteBuffer(I8, sizeof(I8)); end;
        xtInt16: begin I16 := smallint(round(p.X)); Dest.WriteBuffer(I16, sizeof(I16)); end;
        xtInt32: begin I32 := longint(round(p.X)); Dest.WriteBuffer(I32, sizeof(I32)); end;
        xtSingle: begin Dest.WriteBuffer(p.X, sizeof(p.X)); end;
        xtMSFloat4: begin msfl := ieee2ms(p.x); Dest.WriteBuffer(msf4, sizeof(msf4)); end;
      else
        raise ERangeError.Create('ULConvertTo E.XValueType');
      end;

      case E.YValueType of
        ytNone: raise EInvalidParams.Create('ULConvertTo E.YValueType');
        ytByte: begin B := byte(round(p.Y)); Dest.WriteBuffer(B, sizeof(B)); end;
        ytWord: begin W := word(round(p.Y)); Dest.WriteBuffer(W, sizeof(W)); end;
        ytDWord: begin DW := LongWord(round(p.Y)); Dest.WriteBuffer(DW, sizeof(DW)); end;
        ytInt8: begin I8 := shortint(round(p.Y)); Dest.WriteBuffer(I8, sizeof(I8)); end;
        ytInt16: begin I16 := smallint(round(p.Y)); Dest.WriteBuffer(I16, sizeof(I16)); end;
        ytInt32: begin I32 := longint(round(p.Y)); Dest.WriteBuffer(I32, sizeof(I32)); end;
        ytSingle: begin Dest.WriteBuffer(p.Y, sizeof(p.Y)); end;
        ytMSFloat4: begin
          msfl{msf4 }:= ieee2ms(p.x);{RealtoBFloat4(p.X, msf4);}
          Dest.WriteBuffer(msf4, sizeof(msf4));
        end;
      else
        raise ERangeError.Create('ULConvertTo E.YValueType');
      end;
    until false;
  end;
end;

procedure FillDatExpImp(E: TULEObj);
  { Fill the E object with information needed for export/import of
    .DAT files }
begin
  e.TextFile := false;
  e.XValueType := xtInt32;
  e.YValueType := ytSingle;
  e.XCoef := 0.001;
  e.HeadLen := 0;
  e.DefName := DatExt;
  e.YCoef := 0;
  {v0.18}
  e.ExtName := DatExt;
  {/v0.18}
end;

procedure FillTxtExpImp(E: TULEObj);
begin
  e.TextFile := true;
  {
  e.XValueType := xtInt32;
  e.YValueType := ytSingle;
  e.XCoef := 0.001;
  e.HeadLen := 0;
  e.DefName := DatExt;
  e.YCoef := 0;
  }
  {v0.18}
  e.ExtName := TxtExt;
  {/v0.18}
end;

procedure FillULDExpImp(E: TULEObj);
begin
  e.TextFile := false;
  e.XValueType := xtInt32;
  e.YValueType := ytSingle;
  e.XCoef := 0.001;
  e.YCoef := 0;
  e.HeadLen := $2C4;
  e.DefName := ULDExt;
  {v0.18}
  e.ExtName := ULDExt;
  {/v0.18}
end;

procedure FillBExpImp(E: TULEObj);
begin
  e.TextFile := false;
  e.DefName := BExt;
  e.XValueType := xtNone;
  e.YValueType := ytInt16;
  e.XCoef := 0;
  e.YCoef := 0.0001;
  e.HeadLen := 0;
  e.XInterval := 1;
  {v0.18}
  e.ExtName := '';{BExt;}
  { /v0.18}
end;

{v0.18}
procedure ULEFInit(var ef:TULFObj);
var
  efn, efna:string;
begin
  ef := TULFObj.Create(nil);
  efn := ExtractFilePath(paramstr(0)) + 'ULE.ULE';
  efna := ExtractFilePath(paramstr(0)) + 'ULE.ASC';
  if FileExists(efna) then
    ef.LoadFromFile(efna)
  else if FileExists(efn) then
    ef.LoadFromFile(efn)
  CheckKnownDefs(ef);
end;

procedure ULEFDone(var ef:TULFObj);
var
  efn, efna: string;
begin
  if ef <> nil then begin
    efn := ExtractFilePath(paramstr(0)) + 'ULE.ULE');
    efna := ExtractFilePath(paramstr(0)) + 'ULE.ASC');
    if ef.Modified then begin
      ef.SaveToFile(efn);
      ef.SaveToFile(efna);
    end;
    ef.Free;
    ef := nil;
  end;
end;


procedure FillTomExpImp(E: TULEObj);
begin
  e.TextFile := false;
  e.DefName := TomExt;
  e.XValueType := xtNone;
  e.YValueType := ytInt32;
  e.XCoef := 0;
  e.YCoef := 0;
  e.HeadLen := 116;
  e.XInterval := 0.02;
  e.ExtName := TomExt;
end;

procedure CheckKnownDefs(ef: TULFObj);
var
  e: TULEObj;
begin
  if not ef.HasChildWithFieldUsrValue(fnExtName, ULDExt, TULObj(e)) then begin
    e := TULEObj(ef.Add(ULEID));
    FillULDExpImp(e);
  end;
  if not ef.HasChildWithFieldUsrValue(fnExtName, TxtExt, TULObj(e)) then begin
    e := TULEObj(ef.Add(ULEID));
    FillTxtExpImp(e);
  end;
  if not ef.HasChildWithFieldUsrValue(fnExtName, DatExt, TULObj(e)) then begin
    e := TULEObj(ef.Add(ULEID));
    FillDatExpImp(e);
  end;
  if not ef.HasChildWithFieldUsrValue(fnExtName, BExt, TULObj(e)) then begin
    e := TULEObj(ef.Add(ULEID));
    FillBExpImp(e);
  end;
  if not ef.HasChildWithFieldUsrValue(fnExtName, TomExt, TULObj(e)) then begin
    e := TULEObj(ef.Add(ULEID));
    FillTomExpImp(e);
  end;
end;

function ConvertDataFile(const InFileName: string; const InFileFormat: string;
  const OutFileName: string; const OutFileFormat: string): integer;
var
  ef: TULFObj;
  f: array[1..2] of string;
  e: array[1..2] of TULEObj;
  i: integer;
  fldn: string;
  ifn, tfn, ofn: string;
  src, tmp, dest: TFileStream;

begin
  ef := nil;
  ULEFInit(ef);

  if InFileFormat = '' then
    f[1] := ExtractFileExt(InFileName)
  else
    f[1] := InFileFormat;

  if OutFileFormat = '' then
    f[2] := ExtractFileExt(OutFileName)
  else
    f[2] := OutFileFormat;
  if f[2] = '' then
    f[2] := DatExt;

  for i := 1 to 2 do begin

    if (f[i] <> '') and (f[i][1] = '.') then
      f[i] := copy(f[i], 2, 255);
    if length(f[i]) > 3 then begin
      fldn := fnDefName;
    end else begin
      fldn := fnExtName;
      f[i] := UpperCase(f[i]);
      if f[i] = '' then
        raise EConvert.Create('No data format specified.');
      f[i] := '.' + f[i];
    end;
    if not ef.HasChildWithFieldUsrValue(fldn, f[i], TULObj(e[i])) then begin
      raise EConvert.Create('Dat format definition ' + f[i] + ' not found.');
    end;
  end;

  ifn := InFileName;
  ofn := OutFileName;

  if ofn = '' then begin
    ofn := ChangeFileExt(ifn, e[2].ExtName);
  end else begin
    if ExtractFileExt(ofn) = '' then
      ofn := ChangeFileExt(ofn, e[2].ExtName);
  end;

  if FileExists(ofn) then begin
    raise EConvert.Create(ofn + ' aready exists.');
  end;
  src := nil;
  tmp := nil;
  dest := nil;
  tfn := GetTempFileName;
  try
    Src := TFileStream.Create(ifn, fmOpenRead);
    Tmp := TFileStream.Create(tfn, fmCreate);
    ULConvertFrom(e[1], Src, Tmp);
    { Convert data from Src stream to Dest stream (both opened) using
      info in E object. Src is in format specified in E, Dest is
      in new standard raw data format, i.e. array of TExpPoint. }
    Src.Free;
    Src := nil;
    Tmp.Free;
    Tmp := nil;
    if e[2].ExtName = DatExt then begin
      if not RenameFile(tfn, ofn) then begin
        raise EConvert.Create('Can not rename ' + tfn + ' to ' + ofn);
      end;
    end else begin
      Src := TFileStream.Create(tfn, fmOpenRead);
      Dest := TFileStream.Create(ofn, fmCreate);
      ULConvertTo(e[2], Src, Dest);
      { Convert data from Src stream to Dest stream (both opened) using
        info in E object. Src is in standard raw data format (array of TExpPoint),
        Dest is in format specified by E. }
      Src.Free;
      Src := nil;
      Dest.Free;
      Dest := nil;
    end;
  finally
    src.Free;
    tmp.Free;
    dest.Free;
    ULEFDone(ef);
    if FileExists(tfn) then
      DeleteFile(tfn);
  end;
end;


function TryConvertFromFile(const AFileName: string; Dest: TStream): boolean;
var
  ef: TULFObj;
  e: TULEObj;
  s: TFileStream;
begin
  Result := false;
  ef := nil;
  s := nil;
  try
    ULEFInit(ef);
    if not ef.HasChildWithFieldUsrValue(fnExtName, UpperCase(ExtractFileExt(AFileName)),
      TULObj(e)) then
    begin
      exit;
    end;
    s := TFileStream.Create(AFileName, fmOpenRead);
    ULConvertFrom(e, s, Dest);
    s.Free;
    s := nil;
    Result := true;
  finally
    ULEFDone(ef);
    s.Free;
  end;
end;
{/v0.18}

end.
