unit prggoto;
{
   Hyppylauseet logiikkaohjelmalle

   Author:  Vesa Lappalainen
   Date:    15.3.1997
   Changes: 01.01.1997
     + Wait tehty kutsumaan TStepProgram -luokan WaitStep -metodia.
     + Wait asettaa ehdon sen mukaan, odotettiinko pyydetty aika vai ei

}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  PrgLabel, StdCtrls,  PrgSteps,PrgProg;


type
  TFormAskGoto = class(TForm)
    Label1: TLabel;
    LabelId: TLabel;
    ButtonCancel: TButton;
    ButtonOK: TButton;
    EditID: TComboBox;
    EditProg: TComboBox;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TStepGoto = class (TStepDouble)
    where : string;
    prog : string;
  protected
    function FindProg(var v:TStepValue;var isthis:boolean) : TStepProgram;
  public
    function Ask:boolean; override;
    function Des : integer; override;
    function Name : string; override;
    function Expl : string; override;
    procedure Init(var v:TStepValue); override;
    function DoJob(var v:TStepValue) : integer; override;
    function GetStr : string; override;
    procedure SetStr(const s:string); override;
  end;

  TStepIfGoto = class (TStepGoto)
  public
    function DoIf(var v:TStepValue;b:boolean) : integer; virtual;
  end;


  function DoAskGoto(const q:string; g:TStepGoto):boolean;


implementation
{$R *.DFM}
uses kdouble,KFormPrg;

function DoAskGoto(const q:string; g:TStepGoto):boolean;
var FormAskGoto: TFormAskGoto;
begin
  FormAskGoto := TFormAskGoto.Create(NIL);
  g.steps.FillCombo(FormAskGoto.EditID,TStepLabel,['Pause','Repeat','Run','Start']);
  g.steps.FillCombo(FormAskGoto.EditProg,TStepProgram,['']);
  FormAskGoto.EditId.Text := g.where;
  FormAskGoto.EditProg.Text := g.prog;
  FormAskGoto.Caption := q;
  CenterForm(FormAskGoto,'ButtonOK');
  Result := False;
  if ( FormAskGoto.ShowModal <> mrCancel ) and
     ( FormAskGoto.EditId.Text <> '' ) then begin
    Result := True;
    g.where := FormAskGoto.EditId.Text;
    g.prog := FormAskGoto.EditProg.Text;
  end;
  FormAskGoto.Free;
end;

//------------------------------------------------------------------------------
function TStepGoto.Des : integer; begin Result := 2; end;

function TStepGoto.Ask:boolean;
begin Result := DoAskGoto('Give place where to jump',self); end;

function TStepGoto.Name : string; begin Result := 'Goto'; end;

function TStepGoto.Expl : string;
begin Result := 'Command to jump'; end;

procedure TStepGoto.Init(var v:TStepValue);
begin
end;

function TStepGoto.FindProg(var v:TStepValue;var isthis:boolean) : TStepProgram;
var sn : TOneProgStep; pnr:integer;
begin
  Result := NIL;
  if ( prog = '' ) then pnr := v.progNr
  else pnr := TAllSteps(Steps).FindStep(Prog);
  isthis := ( pnr = v.progNr );
  if ( pnr < 0 ) then exit;
  sn := TAllSteps(Steps).Items[pnr];
  if (  sn.Step is TStepProgram ) then
    Result := sn.Step as TStepProgram;
end;

function TStepGoto.DoJob(var v:TStepValue) : integer;
// Mennään sen ohjelman (prog) askeleeseen (where) johon halutaan
// jos ohjelmaa ei mainittu tai se on tämä ohjelma, niin palautetaan
// tiedoksi tämän ohjelman siirtyminen
var p : TStepProgram;
    delta:double; isthis : boolean;


  function DoPause : integer;
  begin
    p := FindProg(v,isthis);
//    if ( isthis ) then begin Result := -2; exit; end;
    if ( p <> NIL ) then p.DoPause;
    Result := inherited DoJob(v);
  end;

  function DoRepeat : integer;
  begin
    p := FindProg(v,isthis);
    if ( isthis ) then begin Result := -1; exit; end;
    if ( p <> NIL ) then p.DoStart;
    Result := inherited DoJob(v);
  end;

  function DoRun : integer;
  begin
    p := FindProg(v,isthis);
    if ( p <> NIL ) then p.DoContinue;
    Result := inherited DoJob(v);
  end;

  function DoStartRun : integer;
  begin
    p := FindProg(v,isthis);
    if ( p <> NIL ) then p.DoStartRun;
    Result := inherited DoJob(v);
  end;

begin
  if ( Parent = NIL ) then begin // Ei kunnon askel
    Result := inherited DoJob(v);
    exit;
  end;
  delta := StrToDoubleDef(where,12345);
  if ( delta <> 12345 ) then begin           // Suhteellinen hyppy
    Result := StepOne - 1 + Trunc(delta);
    exit;
  end;
  Result := TAllSteps(Steps).FindStep(where);
  if ( Result < 0 ) then begin               // Hyppypaikan nimeä ei löydy
    if ( CompareText(where,'Pause') = 0 ) then begin
      Result := DoPause; exit;
    end;
    if ( CompareText(where,'Repeat') = 0 ) then begin
      Result := DoRepeat; exit;
    end;
    if ( CompareText(where,'Run') = 0 ) then begin
      Result := DoRun; exit;
    end;
    if ( CompareText(where,'Start') = 0 ) then begin
      Result := DoStartRun; exit;
    end;
    Result := inherited DoJob(v);
    exit;
  end;

  p := FindProg(v,isthis);
  if ( isthis ) then exit;
  if ( p <> NIL ) then p.DoGoto(Result);
  Result := inherited DoJob(v);
end;

const InStr:string = ' in ';

procedure TStepGoto.SetStr(const s:string);
var i:integer;
begin
  where := s; prog := '';
  i := POS(InStr,s);
  if ( i <= 0 ) then exit;
  where := trim(copy(s,1,i-1));
  prog := trim(copy(s,i+length(InStr),100));
end;

function TStepGoto.GetStr : string;
begin
  Result := where;
  if ( prog = '' ) then exit;
  Result := where + ' ' + InStr + ' ' + prog;
end;

//------------------------------------------------------------------------------
function TStepIfGoto.DoIf(var v:TStepValue;b:boolean) : integer;
begin
  if ( b ) then begin Result := inherited DoJob(v); exit; end;
  Result := StepOne;
end;


//------------------------------------------------------------------------------
type
  TStepIfTrueGoto = class (TStepIfGoto)
  public
    function Name : string; override;
    function Expl : string; override;
    function DoJob(var v:TStepValue) : integer; override;
  end;

function TStepIfTrueGoto.Name : string; begin Result := 'IfTrueGoto'; end;

function TStepIfTrueGoto.Expl : string;
begin Result := 'Jump if previous condition true'; end;

function TStepIfTrueGoto.DoJob(var v:TStepValue) : integer;
begin Result := DoIf(v,v.condition); end;

//------------------------------------------------------------------------------
type
  TStepIfFalseGoto = class (TStepIfGoto)
  public
    function Name : string; override;
    function Expl : string; override;
    function DoJob(var v:TStepValue) : integer; override;
  end;

function TStepIfFalseGoto.Name : string; begin Result := 'IfFalseGoto'; end;

function TStepIfFalseGoto.Expl : string;
begin Result := 'Jump if previous condition false'; end;

function TStepIfFalseGoto.DoJob(var v:TStepValue) : integer;
begin Result := DoIf(v,not v.condition); end;

//------------------------------------------------------------------------------
type
  TStepRepeat = class (TStepGoto)
  public
    function Name : string; override;
    function Expl : string; override;
    function GetStr : string; override;
    procedure SetStr(const s:string); override;
  end;

function TStepRepeat.Name : string;
begin Result := 'Repeat'; end;

function TStepRepeat.Expl : string;
begin Result := 'Repeat the program from start!'; end;

procedure TStepRepeat.SetStr(const s:string);
begin
  where := name;
  prog := s;
end;

function TStepRepeat.GetStr : string;
begin Result := prog; end;

//------------------------------------------------------------------------------
type
  TStepPause = class (TStepRepeat)
  public
    function Name : string; override;
    function Expl : string; override;
  end;

function TStepPause.Name : string;
begin Result := 'Pause'; end;

function TStepPause.Expl : string;
begin Result := 'Stop the program!'; end;

//------------------------------------------------------------------------------
type
  TStepRun = class (TStepRepeat)
  public
    function Name : string; override;
    function Expl : string; override;
  end;

function TStepRun.Name : string;
begin Result := 'Run'; end;

function TStepRun.Expl : string;
begin Result := 'Continue the program!'; end;

//------------------------------------------------------------------------------
type
  TStepStart = class (TStepRepeat)
  public
    function Name : string; override;
    function Expl : string; override;
  end;

function TStepStart.Name : string;
begin Result := 'Start'; end;

function TStepStart.Expl : string;
begin Result := 'Start and run the program!'; end;


//------------------------------------------------------------------------------
type
  TStepWait = class (TStepDouble)
  public
    function Name : string; override;
    function Expl : string; override;
    function Des  : integer; override;
    function DoJob(var v:TStepValue) : integer; override;
  end;

function TStepWait.Des : integer; begin Result := 3; end;

function TStepWait.Name : string;
begin Result := 'Wait'; end;

function TStepWait.Expl : string;
begin Result := 'Waits choosen amount of seconds!'; end;

function TStepWait.DoJob(var v:TStepValue) : integer;
begin
  v.Condition := TStepProgram(v.Prog).StepWait(trunc(v.op1*1000));
  Result := StepOne;
end;

//------------------------------------------------------------------------------
type
  TStepCall = class (TStepGoto)
  public
    function Ask:boolean; override;
    function Name : string; override;
    function Expl : string; override;
    function DoJob(var v:TStepValue) : integer; override;
  end;

function TStepCall.Ask:boolean;
begin Result := DoAskGoto('Give place where to go as subroutine',self); end;

function TStepCall.Name : string; begin Result := 'Call'; end;

function TStepCall.Expl : string;
begin Result := 'Subroutine to go'; end;

function TStepCall.DoJob(var v:TStepValue) : integer;
var b:boolean;
    p : TStepProgram;
begin
  p := FindProg(v,b);
  p.PushReturn(StepOne);
  Result := inherited DoJob(v);
end;

//------------------------------------------------------------------------------
initialization begin
  StepAdd(TStepGoto.Create);
  StepAdd(TStepIfTrueGoto.Create);
  StepAdd(TStepIfFalseGoto.Create);
  StepAdd(TStepRepeat.Create);
  StepAdd(TStepPause.Create);
  StepAdd(TStepRun.Create);
  StepAdd(TStepStart.Create);
  StepAdd(TStepWait.Create);
  StepAdd(TStepCall.Create);
end;

end.