unit progc;
{
   Tässä tiedostossa on logiikkaohjelmien ylläpito ja käyttöliittymä
   siihen.

   Author:  Vesa Lappalainen
   Date:    26.2.1997
   Changes: 13.3.1997
    + värillä ohjelman otsikko
    + debuggaus alkamaan edellisestä lähimmästä ohj.
    + viestit?
   Changes: 25.3.1997
    + parametrien asetus
    + comm parametrien ohjaus
   Changes: 29.3.1997
    + ohjelmatiedoston nimi luetaan initiedoston kohdasta:
         [Logic Programs] PrgFileName=
   Changes: 1.4.1997
    + jos nimeä ei ole, on se sama kuin ini-tiedoston nimi + .prg';
   Changes: 11.4.1997
    + Create3 toisen lomakkeen luomista varten
    + StartAll ja StopAll -metodit
   Changes: 22.11.1997
    + Hints
    + DoubleClick inserts
    + Insert also Repeat when inserting Program 
    + korvaus ja double click
    + korjattu: jos puu ei auki, niin selected index ei mene oikeaan kohti!
    + ohjelmien ja labelien nimet ComboBoxissa.
    + puu myös debuggeriin
   Changes: 1.4.1998
    + Jos ohjelma puuttuu, sen automaattinen lisäys.
      Jos paikka AutoAddEnd, lisäys tulee sen yläpuolelle


     Ominaisuudet:

   Missing:
    -- breakpoint
    -- parametrien käyttö arvoina
    -- FindProg voisi lisätä ohjelman pyydettäessä!

}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,numerot, ExtCtrls,PrgSteps,PrgProg, PrgOutl, savepos, kComp,
  KParam,  kinicomp;


const IniProgs = 'Logic Programs';

type

  TFormProg = class(TForm)
    ListBoxCmds: TListBox;
    PanelExpl: TPanel;
    Panel2: TPanel;
    ButtonIns: TButton;
    ButtonEdit: TButton;
    ButtonChange: TButton;
    ButtonDebug: TButton;
    ButtonDel: TButton;
    ButtonPause: TButton;
    ButtonRun: TButton;
    ButtonSave: TButton;
    ButtonComment: TButton;
    PanelComment: TPanel;
    ButtonParams: TButton;
    Splitter1: TSplitter;
    PanelRow: TPanel;
    SavePos1: TSavePos;
    ParamTimerPeriod: TkParam;
    CBAutoAdd: TkCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure ButtonInsClick(Sender: TObject);
    procedure BoxStepsClick(Sender: TObject);
    procedure ListBoxCmdsDblClick(Sender: TObject);
    procedure BoxStepsDblClick(Sender: TObject);
    procedure ListBoxCmdsClick(Sender: TObject);
    procedure ButtonDebugClick(Sender: TObject);
    procedure ButtonDelClick(Sender: TObject);
    procedure ButtonPauseClick(Sender: TObject);
    procedure ButtonRunClick(Sender: TObject);
    procedure ButtonSaveClick(Sender: TObject);
    procedure BoxStepsDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure ButtonCommentClick(Sender: TObject);
    procedure ButtonParamsClick(Sender: TObject);
    procedure ButtonChangeClick(Sender: TObject);
    procedure PanelRowClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    function ParamTimerPeriodAfterAsk(Sender: TObject;
      var val: Double): Boolean;
    procedure FormHide(Sender: TObject);
  private
    { Private declarations }
    filename : string;
    NilStep : TOneProgStep;
    FSteps:TAllSteps;
    BoxSteps : TProgOutline;
    TimerPeriod : integer;
  public
    { Public declarations }
    constructor Create3(AOwner:TComponent; const afilename,aname:string);
    destructor Destroy; override;
    procedure ShowCommandStatus;
    procedure ShowStatus;
    procedure Changed;
    procedure UpdateProgs;
    function GetSelStep : TOneProgStep;
    procedure DelSelStep;
    procedure Replace(i:integer);
    function AddByName(const s:string) : boolean;
    procedure JustInsert(i:integer);
    procedure Insert(i:integer);
    function FindProg(const name:string;AutoCreate:boolean=true):TStepProgram;
    function Run(const name:string;AutoCreate:boolean=true) : boolean;
    function SetValue(const name:string;d:double): boolean;
    function GetValue(const name:string): double;
    function Stop(const name:string): boolean;
    property SelStep:TOneProgStep read GetSelStep;
    function AskParams : boolean;
    procedure SetRow(i:integer);
    procedure FullStepInsert(s:TOneProgStep);
    function InsertProg(name:string;ip:integer):boolean;
    procedure Stopped(b:boolean);
    procedure StopOrRun(b:boolean);
  published
    property Steps : TAllSteps read FSteps;  
  end;

function timeBeginPeriod(ms:Integer):integer; stdcall; far; external 'winmm.dll';
function timeEndPeriod(ms:Integer):integer;   stdcall; far; external 'winmm.dll';

var
  FormProg: TFormProg;

implementation

uses debug,IniFiles,KString, prgparam, kdouble, kErrors, IniName;
{$R *.DFM}

var
  ceProgramDebug : TCommError;


constructor TFormProg.Create3(AOwner:TComponent; const afilename,aname:string);
begin
  filename := afilename;
  name := aname;
  inherited Create(AOwner);
  name := aname;
end;

procedure TFormProg.UpdateProgs;
var i: integer; s: TOneProgStep;
begin
  Steps.UpdateCurNros;
  for i:=0 to Steps.Count-1 do begin
    s := Steps.Items[i];
    if not ( s.Step is TStepProgram ) then continue;
    (s.Step as TStepProgram).DoUpdate;
  end;
  ShowStatus;
end;

procedure TFormProg.Changed;
begin
  UpdateProgs;
  Steps.Changed;
  ButtonSave.Enabled := True;
end;

procedure TFormProg.DelSelStep;
var i: integer;
begin
  i := BoxSteps.ItemIndex;
  if ( not BoxSteps.DeleteStep(i) ) then exit;
  Changed;
end;


function TFormProg.GetSelStep : TOneProgStep;
var i: integer;
begin
  i := BoxSteps.ItemIndex;
  if ( i < 0 ) then i := 0;
  Result := NilStep;
  if ( i >= Steps.Count ) then exit;
  Result := Steps.Items[i];
end;

destructor TFormProg.Destroy;
begin
  Steps.WriteToFile('');
  Steps.Free;
  NilStep.Free;
  if ( self = FormProg ) then FormProg := nil;
  inherited Destroy;
end;


procedure TFormProg.FormCreate(Sender: TObject);
var ini:TIniFile; pname:string;
begin
  SetNumberFormat;
  if ( filename <>'' ) then pname := filename
  else begin
    pname := LowerCase(GetIniName(''));
    Ini := TIniFile.Create(pname);
    pname := Ini.ReadString(IniProgs,'PrgFileName',ChangeExtension(pname,'.prg'));
    Ini.Free;
  end;

  ProgComm.UpdateListBox(ListBoxCmds);
  FSteps := TAllSteps.Create;
  Steps.Form := self;
  BoxSteps := TProgOutline.Create2(self,Steps);
  BoxSteps.Parent := self;
  BoxSteps.OnClick := BoxStepsClick;
  BoxSteps.OnDblClick := BoxStepsDblClick;
  BoxSteps.MinWidth := 600;

//  Progs := TList.Create;
  NilStep := TOneProgStep.Create(-1,steps);
  Steps.ReadFromFile(pname);
  BoxSteps.UpdateBox;
  UpdateProgs;
  ButtonSave.Enabled := False;
  Caption := 'Logic Programs - ' + ExtractFileName(pname);
  ActiveControl := BoxSteps;
  TimerPeriod := ParamTimerPeriod.AsInteger;
  timeBeginPeriod(TimerPeriod);
end;

procedure TFormProg.JustInsert(i:integer);
var s:TOneProgStep;
begin
  if ( i < 0 ) then exit;
  s := TOneProgStep.Create(i,steps);
  if ( s = NIL ) then exit;
  BoxSteps.AddStep(s);
end;


function TFormProg.AddByName(const s:string) : boolean;
var st:string; p:integer; name : string;
begin
  st := s;
  while ( st <> '' ) do begin
    p := Pos(';',st); if p = 0 then p := 1000;
    name := Copy(st,1,p-1);
    Delete(st,1,p);
    name := Trim(name);
    JustInsert(ListBoxCmds.Items.IndexOf(name));
  end;
  Result := true;
end;

procedure TFormProg.FullStepInsert(s:TOneProgStep);
begin
  if not AddByName(s.Step.InsertBefore) then begin s.Free; exit; end;
  BoxSteps.AddStep(s);
  AddByName(s.Step.InsertAfter);
  Changed;
end;

function TFormProg.InsertProg(name:string;ip:integer):boolean;
var i:integer; s:TOneProgStep; ps : TStepProgram;
begin
  Result := false;
  i := ListBoxCmds.Items.IndexOf('Program');   if ( i < 0 ) then exit;
  s := TOneProgStep.Create(i,steps);           if ( s = NIL ) then exit;
  if ( not ( s.step is TStepProgram ) ) then begin s.free; Exit; end;
  ps := s.step as TStepProgram;
  if ( ip < 0 ) then ip := BoxSteps.ItemCount;
  BoxSteps.ItemIndex := ip;
  ps.Id := name;
  Steps.FullStop := true;
  FullStepInsert(s);
end;

procedure TFormProg.Insert(i:integer);
var s:TOneProgStep;
begin
  if ( i < 0 ) then exit;
  s := TOneProgStep.Create(i,steps);
  if ( s = NIL ) then exit;
  if not s.Edit then begin s.Free; exit; end;
  Steps.FullStop := true;
  FullStepInsert(s);
end;

procedure TFormProg.ButtonInsClick(Sender: TObject);
begin
  Insert(ListBoxCmds.ItemIndex);
end;

procedure TFormProg.ShowCommandStatus;
var s:TStepBasic;
begin
  s := ProgComm[ListBoxCmds.ItemIndex];
  PanelExpl.Caption := s.Expl;
end;

procedure TFormProg.ShowStatus;
var i:integer;
begin
  i := SelStep.Nr;
  if ( i < 0 ) then exit;
  ListBoxCmds.ItemIndex := i;
  ShowCommandStatus;
  PanelExpl.Caption := PanelExpl.Caption + '  ' + SelStep.Step.SpeExpl;
  PanelComment.Caption := SelStep.Step.Id + '= ' + SelStep.Step.Comment;
  PanelRow.Caption := IntToStr(BoxSteps.ItemIndex);
end;

procedure TFormProg.BoxStepsClick(Sender: TObject);
begin
  ShowStatus;
end;

procedure TFormProg.Replace(i:integer);
var s:TOneProgStep;
begin
  if ( i < 0 ) then exit;
  Steps.FullStop := true;
  s := SelStep;
  BoxSteps.ChangeCommand(s,i);
  Changed;
end;

procedure TFormProg.ButtonChangeClick(Sender: TObject);
begin
  Replace(ListBoxCmds.ItemIndex);
end;

procedure TFormProg.ListBoxCmdsDblClick(Sender: TObject);
begin
  Insert(ListBoxCmds.ItemIndex);
end;

procedure TFormProg.BoxStepsDblClick(Sender: TObject);
begin
  if not ( BoxSteps.Edit ) then exit;
  Changed;
end;

procedure TFormProg.ListBoxCmdsClick(Sender: TObject);
begin
  ShowCommandStatus;
end;


procedure TFormProg.ButtonDebugClick(Sender: TObject);
var i:integer;s:TOneProgStep;p:TStepProgram;
begin
  s := SelStep;
  i := BoxSteps.ItemIndex;
  while (i>=0) and not (s.step is TStepProgram) do begin
    s := Steps[i];
    dec(i);
  end;
//  p := s.step as TStepProgram;
  if not (s.step is TStepProgram) then begin exit; end;
  p := TStepProgram(s.step);
  p.DoStartDebug(self);
//  FormDebug.Start(s.step as TStepProgram);
end;

procedure TFormProg.ButtonDelClick(Sender: TObject);
begin
  if Application.MessageBox('Sure to delete item','Program',mb_OKCancel) = IDOK then begin
    Steps.FullStop := true;
    DelSelStep;
  end;
end;


procedure TFormProg.ButtonPauseClick(Sender: TObject);
begin
  Steps.FullStop := true;
end;

procedure TFormProg.ButtonRunClick(Sender: TObject);
begin
  Steps.FullStop := false;
end;

function TFormProg.FindProg(const name:string;AutoCreate:boolean):TStepProgram;
var i,ip:integer; s:TOneProgStep;
begin
  Result := NIL;
  s := NIL;
  i := Steps.FindStep(name);
  if ( i >= 0 ) then s := Steps[i];

  // Step found but not a program
  if ( s <> NIL ) and ( not (s.Step is TStepProgram) ) then begin
    ShowMessage('Step ' + name + ' is not a program!');
    Exit;
  end;

  // OK case, program found
  if ( s <> NIL ) then begin Result := s.Step as TStepProgram; exit; end;

  if ( not AutoCreate ) then exit;

  // Program not found!  Autoadd?
  if ( CBAutoAdd.State = cbUnchecked ) then begin  // AutoAddEnd not found
    ShowMessage('Program ' + name + ' not found!');
    exit;
  end;

  if ( CBAutoAdd.State = cbGrayed ) then begin  // AutoAddEnd not found
    exit;
  end;

  if ( MessageDlg('Program ' + name + ' not found!' +#10#13 + 'Add program?',
          mtConfirmation,[mbYes, mbNo],0)
         <> mrYes ) then exit;

  ip := Steps.FindAnyStep('AutoAddEnd',true);
  InsertProg(name,ip);

end;

function TFormProg.Run(const name:string; AutoCreate:boolean): boolean;
var p:TStepProgram;
begin
  Result := False;
  if ( not Assigned(self) ) then exit;
  if ( not Assigned(Steps) ) then exit;
  ceProgramDebug.Add('Start: ' + name);
  p := FindProg(name,AutoCreate);
  if ( p = NIL ) then exit;
  p.DoStartRun;
  Result := True;
end;

function TFormProg.Stop(const name:string): boolean;
var p:TStepProgram;
begin
  Result := False;
  if ( not Assigned(self) ) then exit;
  if ( not Assigned(Steps) ) then exit;
  ceProgramDebug.Add('Stop: ' + name);
  p := FindProg(name);
  if ( p = NIL ) then exit;
  p.DoStop;
  Result := True;
end;

procedure TFormProg.ButtonSaveClick(Sender: TObject);
begin
  Steps.WriteToFile('');
  ButtonSave.Enabled := False;
end;

procedure TFormProg.BoxStepsDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
  ColorListBox(Control,Index,Rect,State,Steps);
end;

procedure TFormProg.ButtonCommentClick(Sender: TObject);
var s: TOneProgStep;
begin
  s := SelStep;
  if ( s = nil ) then exit;
  if ( not s.Step.AskComment ) then exit;
  Steps.FullStop := true;
  Changed;
end;

function TFormProg.SetValue(const name:string;d:double): boolean;
begin
  Result := false;
  if not assigned(self) then exit;
  Result := DoSetParamValue(Steps,name,d);
end;

function TFormProg.GetValue(const name:string): double;
begin
  Result := DoGetParamValue(Steps,name);
end;

function TFormProg.AskParams : boolean;
var i:integer;
begin
  Result := DoAskParams(Steps);
//  Result := true;
  if ( not Result ) then exit;
  i := BoxSteps.ItemIndex;
  BoxSteps.UpdateBox;
  BoxSteps.ItemIndex := i;
  Changed;
  Steps.WriteToFile('');
  ButtonSave.Enabled := False;
end;


procedure TFormProg.ButtonParamsClick(Sender: TObject);
begin
  AskParams;
end;

procedure TFormProg.PanelRowClick(Sender: TObject);
var i:double;
begin
  i := BoxSteps.ItemIndex;
  if ( not AskValue('Which line to go?',i,0,Steps.Count-1,0) ) then exit;
  BoxSteps.ItemIndex := Round(i);
end;

procedure TFormProg.SetRow(i:integer);
begin
  BoxSteps.ItemIndex := i;
end;

procedure TFormProg.FormDestroy(Sender: TObject);
begin
  timeEndPeriod(ParamTimerPeriod.AsInteger);
end;

function TFormProg.ParamTimerPeriodAfterAsk(Sender: TObject;
  var val: Double): Boolean;
begin
  timeEndPeriod(TimerPeriod);
  Result := true;
  TimerPeriod := round(val);
  timeBeginPeriod(TimerPeriod);
end;

procedure TFormProg.Stopped(b: boolean);
begin
  ButtonPause.Enabled := not b;
  ButtonRun.Enabled := b;
end;

procedure TFormProg.FormHide(Sender: TObject);
begin
  Steps.FullStop := false;
end;

procedure TFormProg.StopOrRun(b: boolean);
begin
  if ( not Assigned(self) ) then exit;
  if ( not Assigned(Steps) ) then exit;
  Steps.FullStop := b;
end;

initialization begin
  RegisterError(ceProgramDebug,'pd', 'Program debug');
end;

end.