unit LBRMThread;

interface

uses
  Classes, SysUtils, Windows,
  LBRMGlob, MyUtils, FcstUtil, MyDates, Arrays;


//
//  These types are what we get from the unit Arrays:
//
//  type
//    ArrayOfLongInt = array [0..100] of longint;
//    PArrayOfLongInt = ^ArrayOfLongInt;
//
//    ArrayOfSmallInt = array [0..100] of smallint;
//    PArrayOfSmallInt = ^ArrayOfSmallInt;
//
//    ArrayOfSingle = array [0..100] of single;
//    PArrayOfSingle = ^ArrayOfSingle;
//


type
  TLBRMThread = class(TThread)
  private
    MsgText : string;

    function CreateConfigFile : boolean;
    procedure SendMemoMessage;

  protected
    procedure Execute; override;

  public
     ReturnStatus : integer;
     KCons        : single;
     EditBoxHndl  : integer;   // handle of hidden edit box used for messaging


     CfgFileName  : string;
     ParmFileName : string;
     BCFileName   : string;
     MetFileName  : string;
     OutFileName  : string;
     FlowFileName : string;
     WorkingDir   : string;

     constructor Create;
  end;


procedure LBRM_Guts(var ErrStatus           : longint;    // 0=no errors
                    var PassHnd             : longint;    // windows handle for messaging
                    var Cons                : single;     // Proportionality Constant
                    var BC, DS              : longint;
                    var BCDates             : ArrayOfLongInt;
                    var Upr, Lwr, Grnd      : ArrayOfSingle;
                    var Srf, Snw            : ArrayOfSingle;
                    var Tmx, TMn, Prc       : ArrayOfSmallInt;
                    var ORun, OUsz, OLsz    : ArrayOfSingle;
                    var OGz, OSs, OSnw      : ArrayOfSingle;
                    var LTnsg, LTrun, LTint : single;
                    var LTgwf, LTuev, LTlev : single);
                 stdcall; external 'LBRM.DLL';

procedure LBRM_ReadData(var ErrStatus           : longint;    // 0=no errors
                        var PassHnd             : longint;    // windows handle for messaging
                        var BC, DS              : longint;
                        var BCDates             : ArrayOfLongInt;
                        var Upr, Lwr, Grnd      : ArrayOfSingle;
                        var Srf, Snw            : ArrayOfSingle;
                        var Tmx, TMn, Prc       : ArrayOfSmallInt);
                 stdcall; external 'LBRM.DLL';


procedure LBRM_WriteData(var ErrStatus           : longint;    // 0=no errors
                         var PassHnd             : longint;    // windows handle for messaging
                         var DS                  : longint;
                         var Run, Upr, Lwr       : ArrayOfSingle;
                         var Gnd, Srf, Snw       : ArrayOfSingle);
                 stdcall; external 'LBRM.DLL';


procedure LBRM_ArraySizes(var ErrStatus          : longint;    // 0=no errors
                          var PassHnd            : longint;    // windows handle for messaging
                          var BC, DS             : longint);
                 stdcall; external 'LBRM.DLL';

implementation

{$RANGECHECKS OFF}

//------------------------------------------------------------------------
constructor TLBRMThread.Create;
begin
   FreeOnTerminate := TRUE;
   inherited Create(TRUE);
end;


//------------------------------------------------------------------------
procedure TLBRMThread.Execute;
var
   Err  : longint;
   CurDir, NewDir : string;
   LT1, LT2, LT3, LT4, LT5, LT6 : single;
begin
   ReturnStatus := 1;            // status = incomplete (terminated early?)
   if (Terminated) then exit;

   //
   // move to the right directory
   //
   try
     GetDir(0, CurDir);
     NewDir := ExtractFilePath(CfgFileName);
     chdir(NewDir);
   except
     exit;
   end;

   //
   // Build the config file
   //
   if (not CreateConfigFile) then begin
      ReturnStatus := -1;        // status = some type of error
      exit;
   end;
   if (Terminated) then exit;

   if (FileExists('ERROR.INT')) then SysUtils.DeleteFile('ERROR.INT');

   if (KCons = 0)     then KCons := 1.0; // dummy value signalling "calibration mode"
   if RecalculateCons then KCons := 1.0; // dummy value signalling "calibration mode"

   //
   // Run the LBRM in the right directory (already there)
   //
   try
     LBRM_Guts(Err, EditBoxHndl, KCons, BC, DS, iBCD^, AUpper^, ALower^,
               AGround^, ASurf^, ASnow^, Tmx^, TMn^, Prc^, ORun^, OUsz^,
               OLsz^, OGzm^, OSs^, OSnw^, LT1, LT2, LT3, LT4, LT5, LT6);
   except
     ReturnStatus := -9;         // status = could not run LBRM
     chdir(CurDir);              // return the original directory
     exit;
   end;

   chdir(CurDir);                // return the original directory

   if (Err <> 0) then begin
      ReturnStatus := -2;        // status = some type of error while running LBRM
      exit;
   end;

   ReturnStatus := 0;            // status = successful completion
end;


//------------------------------------------------------------------------
function TLBRMThread.CreateConfigFile : boolean;
var
   F  : TextFile;
begin
   Result := FALSE;   // default in case of early exit

   try
     AssignFile(F, CfgFileName);
   except
     MsgText := '~!~Error creating LBRM configuration file';
     SYNCHRONIZE(SendMemoMessage);
     exit;
   end;

   try
     Rewrite(F);
     Writeln(F, 'PARMFILE=' + ParmFileName);
     Writeln(F, 'BCFILE='   + BCFileName);
     Writeln(F, 'METFILE='  + MetFileName);
     Writeln(F, 'OUTFILE='  + OutFileName);
     Writeln(F, 'DATAFILE=' + FlowFileName);
     Writeln(F, 'WORKDIR='  + WorkingDir);
     CloseFile(F);
   except
     CloseFile(F);
     MsgText := '~!~Error writing LBRM configuration file';
     SYNCHRONIZE(SendMemoMessage);
     exit;
   end;

   Result := TRUE;   // successful completion

end;

//---------------------------------------------------------------------
procedure TLBRMThread.SendMemoMessage;
var
     S : string;
     P : pChar;
begin
     S := MsgText;    // prepend nothing.  This goes to the standard memo window.
     P := PChar(S);   // convert to PChar for Win API call
     SetWindowTextA(EditBoxHndl, P);
end;



end.
