unit setfunc;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
  CustomDrawnControls, Menus, ExtCtrls, Spin; //RichMemo;

type

  { TProgForm }

  TProgForm = class(TForm)
    quitItem: TMenuItem;
    RateEdit: TFloatSpinEdit;
    StartingTEdit: TFloatSpinEdit;
    FinalTEdit: TFloatSpinEdit;
    RepeatnumEdit: TFloatSpinEdit;
    newbutton: TCDButton;
    StartingTbutton: TCDButton;
    repeatNumbutton: TCDButton;
    FinalTbutton: TCDButton;
    Exitbutton: TCDButton;
    setfuncbutton: TCDButton;
    savebutton: TCDButton;
    saveasbutton: TCDButton;
    Progfileedit: TEdit;
    KeyordsMenu: TPopupMenu;
    endItem: TMenuItem;
    lamptestItem: TMenuItem;
    resetmeasureItem: TMenuItem;
    autosaveItem: TMenuItem;
    AbsoluteItem: TMenuItem;
    RelativeItem: TMenuItem;
    MeasureItem: TMenuItem;
    rateItem: TMenuItem;
    Timer: TTimer;
    ToItem: TMenuItem;
    holdItem: TMenuItem;
    SaveItem: TMenuItem;
    Ratebutton: TCDButton;
    ListBox: TListBox;
    Memo: TMemo;
    addbutton: TCDButton;
    procedure AbsoluteItemClick(Sender: TObject);
    procedure autosaveItemClick(Sender: TObject);
    procedure endItemClick(Sender: TObject);
    procedure ExitbuttonClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure quitItemClick(Sender: TObject);
    procedure StartingTbuttonClick(Sender: TObject);
    procedure holdItemClick(Sender: TObject);
    procedure lamptestItemClick(Sender: TObject);
    procedure MeasureItemClick(Sender: TObject);
    procedure newbuttonClick(Sender: TObject);
    procedure NumbuttonClick(Sender: TObject);
    procedure RatebuttonClick(Sender: TObject);
    procedure rateItemClick(Sender: TObject);
    procedure RelativeItemClick(Sender: TObject);
    procedure resetmeasureItemClick(Sender: TObject);
    procedure saveasbuttonClick(Sender: TObject);
    procedure savebuttonClick(Sender: TObject);
    procedure SaveItemClick(Sender: TObject);
    procedure setfuncbuttonClick(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure ToItemClick(Sender: TObject);
    procedure FinalTbuttonClick(Sender: TObject);
  private

  public

  end;

var
  ProgForm: TProgForm;
  procedure fillproglist;
  function programload:boolean;

implementation

uses main, variables,communication;

var
  olditemindex:longint;
  errorline:string;
  errorindex:longint;

{$R *.lfm}

{ TProgForm }


function splitp(var s:string;var param:double):boolean;

      var
         params:string;
         code,i:longint;
         b:boolean;

      begin
       b:=true;
       param:=-1;
       if s='' then
         begin
           splitp:=true;
           exit;
         end;
       while (s[1]=' ') and (length(s)<>0) do s:=copy(s,2,100);
       while (s[length(s)]=' ') and (length(s)<>0)
                                do s:=copy(s,1,length(s)-1);
       i:=pos(' ',s);
       if i=0 then i:=100;
       params:=copy(s,i,101);
       if params<>'' then
         begin
          code:=0;
          while params[1]=' ' do params:=copy(params,2,100);
          while params[length(params)]=' ' do
	            params:=copy(params,1,length(params)-1);
          if length(params)>0 then val(params,param,code);
          if code<>0 then
           b:=false;
         end;
       s:=copy(s,1,i-1);
       splitp:=b;
      end;


function sintax(filen:string):boolean;

 var f:text;
     s,st:string;
     param:double;
     b,b0:boolean;
     i:longint;

   begin
    {$I-}
    assign(f,filen);
    reset(f);
    i:=ioresult;

    b:=false;
    repeat
      readln(f,s);
      if ioresult<>0 then b:=true;;
      if (not splitp(s,param)) then b:=true;
      if (s='to') and (param<0) then b:=true;;
      if (s='hold') and (param<0) then b:=true;
      if (s='velocity') and (param<0) then b:=true;;
      if (s='rate') and (param<0) then b:=true;
      if not((s='to')or(s='velocity')or(s='rate')or(s='resetmeasure')or
         (s='hold')or(s='measure')or(s='save')or(s='lamptest')or(s='overTtest')or(s='autosave')or(s='end')or(s='quit')
         or(s='absolute')or(s='relative')or(s='lagon'))
	   then b:=true;
     until eof(f);
     close(f);
     sintax:=b;
  end;

procedure fillproglist;

var Info : TSearchRec;

  begin
    ProgForm.ListBox.visible:=true;
    ProgForm.ListBox.Items.Clear;
    //writeln(programsDirectory);
    If FindFirst (programsDirectory+'/*.prg',faAnyFile,Info)=0 then
      begin
      Repeat
        With Info do
          begin
            If (Attr and faDirectory)<>faDirectory then
              begin
                if not Sintax(programsDirectory+'/'+Name) then
                    ProgForm.ListBox.Items.Add(Name);
              end;
          end;
      Until FindNext(info)<>0;
      FindClose(Info);
      ProgForm.ListBox.ItemIndex:=-1;
      oldItemindex:=-1;
      end;
  end;


procedure TProgForm.RelativeItemClick(Sender: TObject);
begin
  ProgForm.Memo.SelText:='relative'+chr(13);
end;

procedure TProgForm.resetmeasureItemClick(Sender: TObject);
begin
  ProgForm.Memo.SelText:='resetmeasure'+chr(13);
end;



procedure saveprogram;

var SaveDialog: TSaveDialog;

begin
  ProgForm.Memo.Lines.SaveToFile(tmpdirectory+'tmp.prg');
  if  sintax(tmpdirectory+'tmp.prg') then
        begin
          showmessage('Sintax error in line:'+Inttostr(errorindex)+' '+errorline);
          exit;
        end;
  if programfile<>'' then
    begin
        ProgForm.Memo.Lines.SaveToFile(programsdirectory+programfile);
    end
  else
    begin
        SaveDialog:=TSaveDialog.Create(nil);
        Savedialog.Initialdir:=programsdirectory;
        if not SaveDialog.execute then
         begin
          Savedialog.free;
          exit;
         end;
        ProgForm.Memo.Lines.SaveToFile(SaveDialog.FileName);
        programsdirectory:=Savedialog.Initialdir;
        programfile:=copy(SaveDialog.FileName, programsdirectory.Length+1,100);
        ProgForm.Progfileedit.text:=programfile;
        Savedialog.free;
    end;
  fillproglist;
end;

procedure TProgForm.saveasbuttonClick(Sender: TObject);
begin
 programfile:='';
 saveprogram;
end;


procedure TProgForm.savebuttonClick(Sender: TObject);
begin
  saveprogram;
end;

procedure TProgForm.SaveItemClick(Sender: TObject);
begin
  ProgForm.Memo.SelText:='save'+chr(13);
end;

procedure TProgForm.setfuncbuttonClick(Sender: TObject);

var SelectProgDirectory: TSelectDirectoryDialog;

begin
    SelectProgDirectory:= TSelectDirectoryDialog.create(nil);
    SelectProgDirectory.Initialdir:=programsdirectory;
    if not SelectProgDirectory.execute then
     begin
      SelectProgDirectory.free;
      exit;
     end;
    programsDirectory:=SelectProgDirectory.Filename;
    SelectProgDirectory.free;
    fillproglist;
end;

procedure TProgForm.TimerTimer(Sender: TObject);

var f:string;

begin
   if (ProgForm.ListBox.ItemIndex<>oldItemindex) and
         (ProgForm.ListBox.ItemIndex>=0) then
      begin
        olditemindex:=ProgForm.ListBox.ItemIndex;
        if programfile<>'' then programfile:=ProgForm.ListBox.Items[olditemindex];
        ProgForm.Memo.Clear;
        ProgForm.Memo.Lines.LoadFromFile(ProgramsDirectory+'/'+programfile);
        ProgForm.Progfileedit.text:=programfile;
      end;

end;

procedure TProgForm.ToItemClick(Sender: TObject);
begin
    ProgForm.Memo.SelText:='to 1'+chr(13);
end;

procedure TProgForm.FinalTbuttonClick(Sender: TObject);
begin

end;



procedure TProgForm.rateItemClick(Sender: TObject);
begin
   ProgForm.Memo.SelText:='rate 1'+chr(13);
end;

procedure TProgForm.holdItemClick(Sender: TObject);
begin
  ProgForm.Memo.SelText:='hold 1'+chr(13);
end;

procedure TProgForm.autosaveItemClick(Sender: TObject);
begin
  ProgForm.Memo.SelText:='autosave'+chr(13);
end;

procedure TProgForm.endItemClick(Sender: TObject);
begin
  ProgForm.Memo.SelText:='end'+chr(13);
end;

procedure exitsetprogram;

begin
 rate:=progform.RateEdit.value;
 startingt:=progform.startingtEdit.value;
 finalt:=progform.finaltEdit.value;
 repeatnum:=progform.repeatnumEdit.value;
 mainform.func.Color:=clSilver;
 progform.Timer.enabled:=false;
 progform.visible:=false;
 programselected:=true;
 if startb then
    begin
     startb:=false;
     startp;
    end;
end;

procedure TProgForm.ExitbuttonClick(Sender: TObject);
begin
   exitsetprogram;
end;

procedure TProgForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
   exitsetprogram;
end;

procedure TProgForm.FormCreate(Sender: TObject);
begin

end;

procedure TProgForm.quitItemClick(Sender: TObject);
begin
   ProgForm.Memo.SelText:='quit'+chr(13);
end;

procedure TProgForm.StartingTbuttonClick(Sender: TObject);
begin

end;

procedure TProgForm.AbsoluteItemClick(Sender: TObject);
begin
  ProgForm.Memo.SelText:='absolute'+chr(13);
end;



procedure TProgForm.lamptestItemClick(Sender: TObject);
begin
  ProgForm.Memo.SelText:='overTtest'+chr(13);
end;

procedure TProgForm.MeasureItemClick(Sender: TObject);
begin
    ProgForm.Memo.SelText:='measure'+chr(13);
end;



procedure TProgForm.newbuttonClick(Sender: TObject);
begin
   ProgForm.Memo.Clear;
   programfile:='';
end;

procedure TProgForm.NumbuttonClick(Sender: TObject);
begin

end;

procedure TProgForm.RatebuttonClick(Sender: TObject);
begin

end;


function programload:boolean;

   var f:text;
       s:string;
       param:real;
       rr:double;
       absoluteboolean,b:boolean;
       i:integer;
       bb:boolean;
       programname:string;
       SavedialogManual:TSavedialog;

   begin
   {$I-}
    bb:=true;
    saverequest:=false;
    mintemp:=1000;
    maxtemp:=0;
    programname:=programsdirectory+programfile;
    //if baselineb then programname:=calori_path+'programs/baseline.prg';
    if sintax(programname) then
      begin
       showmessage('Error in program file');
       exit;
      end;
    assign(f,programname);
    reset(f);
    autosave:=false;
    absoluteboolean:=false;
    teston:=false;
    if repeatnum<>1 then autosave:=true;
    sendonb:=true;
    senddata(SFILL,0);
    senddata(SPOWER,1);
    senddata(SRATE,20/6e7);
    temp2on:=false;
    rate_null:=0;
    repeat
       readln(f,s);
      b:=splitp(s,param);
      if (s='lagon') and (not student) then temp2on:=true;
      if s='autosave' then autosave:=true;
      if s='absolute' then absoluteboolean:=true;
      if s='relative' then absoluteboolean:=false;
      if s='measure' then
       begin
        senddata(SMEASUREON,0);
        if rate_null=0 then rate_null:=rr;
       end;
      if s='resetmeasure' then senddata(SMEASUREOFF,0);
      //if s='lamptest' then senddata(SLAMPTEST,0);
      //if s='overTtest' then senddata(SLAMPTEST,0);
      if s='save' then senddata(SSAVE,0);
      if s='velocity' then s:='rate';
      if not absoluteboolean then
        begin
          if s='to' then
            begin
              param:=startingt+(finalt-startingt)*param;
            end;
          if s='rate' then param:=rate*param;
         end;
      if s='to' then
         begin
           if param<0 then param:=0;
           if param>800 then param:=800;
           if maxtemp<param then maxtemp:=param;
           if mintemp>param then mintemp:=param;
           senddata(STO,param);
         end;
      if s='rate' then
        begin
           if param>20 then param:=20;
           senddata(SRATE,param/6e7);
           rr:=param;
        end;
     if s='hold' then senddata(SHOLD,param*1e6);
     if s='end' then
       begin
           senddata(SMEASUREOFF,0);
           senddata(SRATE,20/6e7);
           //senddata(STO,startingt);
       end;
      if s='quit' then
       begin
           senddata(SMEASUREOFF,0);
           senddata(SRATE,20/6e7);
           senddata(STO,20);
       end;
    until eof(f);
    senddata(SFINISH,0);
    senddata(SSENDDATAON,0);
    close(f);
    sendonb:=false;
    //mintemp:=mintemp-20;
    if mintemp<10 then mintemp:=10;
    if ioresult<>0 then showmessage('Error in program file');
    programload:=bb;
    if autosave  then
     begin
       SavedialogManual:=TSavedialog.create(nil);
       SavedialogManual.Initialdir:=savedirectory;
       if SaveDialogManual.execute then
        begin
           savedirectory:=SavedialogManual.Initialdir;
           savefilename:=copy(SaveDialogManual.FileName, savedirectory.Length+1,100);
        end
       else
         begin
             showmessage('Save diretory is not selected');
             programload:=false;
             exit;
         end;
       SavedialogManual.free;
     end;
   {$I+}
   end;


end.