unit prgsteps;
{
   Tässä tiedostossa on logiikkaohjelmien peruskäskyt

   Author:  Vesa Lappalainen
   Date:    15.3.1997
   Changes: 26.3.1997
     + lisätty metodi IsCond, sillä joskus on kiva periä TStepCond
       -luokkaa, mutta silti ei haluta tehdä ehtoa.  Samalla
       muutettu kaikki testit  if ( step is TStepCond ) muotoon
                               if ( step.IsCond )
   Changes: 24.4.1997
     + kaikki askeleet voivat omistaa id:n ja näin niitä voidaan muuttaa
       ulkoa päin
   Changes: 18.7.1997
     + # kommentti käsitellään 1. merkkinä
   Changes: 22.11.1997
     + InsertBefore ja InsertAfter metodit
   Changes: 29.12.1997
     + ehtoihin function IsEventWait:boolean; virtual;
                function DoEventWait(var v:TStepValue) : boolean; virtual;
   Changes: 31.12.1997
     + StartAll ja StopAll siirretty tänne
     + lisätty StopAllTotally, jota kutsutaan ennen listan tyhjennystä
   Changes: 13.4.1998
     + komentin sijoittaminen komennon päälle tallettaa komennon vanhan
       nimen ja seuraavalla sijoituksella palauttaa komennon takaisin
   Changes: 20.4.1998
     + ohjelma-askeleisiin ParaCalc ParamTime?,+,500
     + +,=,*,-,/
     + Myös ParaComp <,=,>,<=,!=,>=
   Changes: 26.4.1998
     + pinon käsittely (VarStack) ja aliohjelmakutsut (CallStack)
     + TSDouble-tyyppi TStepDouble:n arvotyypiksi (tallettaa
       myös tiedon siitä, pitääkö arvo ottaa pinosta vai ei,
       jos arvo otetaan pinosta, ei varsinaisella arvolla
       ole merkitystä.  Arvo otetaan pinosta jo askeleen
       Init-metodissa, joten älä hämäänny tästä debuggerissa).
     + varsinaisen ohjelman laskureihin viittaaminen, viittaus
       haetaan askeleen Init-metodissa 
   Changes: 12.7.1998
     + PauseAll

   Ominaisuudet:
    - kaikki ohjelma-askeleet ovat periaatteessa samanarvoisia
    - kuitenkin seuraavan luonteisia käskyjä esiintyy
       1) Label     - tällaiseen voidaan hypätä, ei suorita mitään
                      (ks. prglabel.pas), vaan siirtyy vain seuraavaan
                      askeleeseen
       2) Program   - kuten Label, mutta pitää kirjaa suorituksen
                      kohteena olevasta askeleesta (ks. prgprog.pas)
       3) Tekoset   - tekee jonkin yksinkertaisen tehtävän ja
                      siirtyy seuraavaan askeleeseen
       4) Hypyt     - hyppää johonkin Labeliin tai ehdollisessa
                      tapauksessa hyppää
       5) Ehdot     - jos seuraava askel on ehdollinen hyppy, suoritetaan
                      ja hypätään ehdon mukaan.
                      Jos seuraava ei ole ehdollinen hyppy, jäädään
                      odottamaan kunnes ehto tulee voimaan

    - kun halutaan tehdä uusi ohjelma-askel (=käsky), pitää
       1) periä jokin olemassa oleva käsky
       2) Override ainakin metodit:
            name    - ohjelmakäskyn nimi
            expl    - selitys ohjelmakäskystä
            DoJob   - mitä ohjelmakäsky tekee, pitää palauttaa
                      seuraavan ohjelma-askeleen numeron.
                      Perusaskeleessa (TStepBasic) on valmis metodi
                      StepOne, joka siirtyy seuraavaan askeleeseen.
                      Jos on peritty ehto ja kirjoitettu matkalle
                      uusi DoJob, voidaan käyttää DoCondJob, joka
                      tekee ehdon DoJob ja näin alkuperäinen ehdon
                      käyttäytyminen voidaan palauttaa
          Lisäksi voidaan määritellä:
            speexpl - erikoisselitys, joka liittyy askeleen sen
                      hetkiseen todelliseen tilnateeseen,
                      esim. asetusarvosta riippuva
          Yleensä uuden "sarjan" aluksi vielä tarvitaan metodi
            Ask     - kyselee ohjelmakäskyn tietoja, esim. asetettavan
                      arvon tms.
          Tarvittaessa myös parametriton muodostaja:
            Create
          Jos peritään TStepCond-luokkaa tai sen jälkeläisiä, pitää
          tarkistaa että metodi IsCond on kunnossa:
            IsCond  - onko todella kyse ehdosta, vai onko vain peritty
                      ehdosta, jotta myöhemmät jälkeläiset on kivempi
                      tehdä ehdoksi
          Jos todella on kyse ehdosta, niin pitää vielä määritellä
            Cond    - palauttaa tiedon siitä, onko ehto totta vai ei
            IsEventWait - tosi jos ehdon odotus toteutetaan säikeen Eventin
                      odotuksena
            DoEventWait - jos odotetaan Eventtiä, niin tämä tekee sen.
                      Palauttaa ehdon arvon kun Event on saatu.
          Joskus jos on kyse jostakin tilasta riippuvasta tapahtumasta,
          määritellään metodi
            Init    - alustaa tilaa kuvaavan tietueen askeleen suorittamista
                      varten
          Askeleen tietojen tallettamiseksi/luk tiedostoon ja näyttämiseksi
          ohjelmalistassa määritellään metodit:
            GetStr  - muuttaa askeleen arvoineen merkkijonoksi
            SetStr  - muuttaa merkkijonon askeleeksi arvoineen
          Jos askel sisältää desimaalitietoa, niin siihen on ohjelmoitava
          vielä
            SetValue(val:double):Boolean - asettaa arvon
            GetValue : double            - ottaa arvon

          Jos halutaan lisätä joitakin käskyjä ennen uuden askeleen lisäystä
          tai uuden lisäyksen jälkeen, niin override metodit:
            function InsertBefore : string;
            function InsertAfter : string;
          Tällä tavalla voidaan automatisoida aina 'lähes' yhteenkuuluvien
          komentojen lisäys samanaikaisesti.  Huom!   Tämä ei lisää
          rekursiivisesti!

          Jos komennon ulkoasua halutaan muuttaa, niin override metodit:
            Level : Integer     - millä sisennystasolla komento kuuluu olla
            Color : TColor      - millä värillä komento kuuluu tulostaa
            TextColor : TColor  - minkä värinen on komennon teksti
            Style : TFontStyles - komennon fontin tyyli


       3) Lisätään modulin initialization kohtaan rivi jokaista uutta
          käskyä kohti:
            StepAdd(TStepMyNew.Create);

    - HUOM! ohjaus-form pitää ladata riittävän aikaisin, eli ainakin ennen
      FormProgia

   Missing:
    - breakpoint
    - Counter-testaaminen
}


interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,numerot,syncobjs;

type

  TAllSteps = class;
  TOneProgStep = class;

  TStepValue = record
    op1 : double;  // Reserved for operand in command
    op2 : double;  // Reserved for operand in command
    val : double;
    l : longint;
    w : word;
    g : word;
    s : string;
    ptr : Pointer;
    progNr : integer;
    prog : TObject;
    condition : boolean;
  end;

  TSDouble = record
    d:double;
    FromStack : boolean;
  end;

  PTSDouble = ^TSDouble;

  // Kaikki ohjelma-askeleet periytyvät tästä
  TStepBasic = class (TObject)
    id        : string;
  private
    FParent   : TOneProgStep;
    FSteps    : TAllSteps;
    fcomment  : string;
    fnr       : Integer;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    function GetFromStack: boolean; virtual;
    procedure SetFromStack(const Value:boolean); virtual;
    function Ask:boolean; virtual;
    function AskDoubleValue:boolean; virtual;
    function Name : string; virtual;
    function InsertBefore : string; virtual;
    function InsertAfter : string; virtual;
    function Expl : string; virtual;
    function SpeExpl : string; virtual;
    function StepOne : integer; virtual;
    function DoJob(var v:TStepValue) : integer; virtual;
    procedure Init(var v:TStepValue); virtual;

    function GetStr : string; virtual;
    procedure SetStr(const s:string); virtual;
    function IsCond:Boolean; virtual;
    function AskComment : boolean; virtual;
    function SetValue(val:double):boolean; virtual;
    function GetValue:double;            virtual;

    function Level : Integer;            virtual;
    function Color : TColor;             virtual;
    function TextColor : TColor;         virtual;
    function Style : TFontStyles;        virtual;

    property Comment : string read FComment;
    property Str : string read GetStr write SetStr;
    property Nr : integer read fnr;
    property Steps : TAllSteps read FSteps;
    property Parent : TOneProgStep read FParent;
    property FromStack : boolean read GetFromStack write SetFromStack;
//    property Value : double read GetValue write SetValue;
  end;

  TStepDouble = class (TStepBasic)
    d:TSDouble;
  private
    procedure SetValue2(val: double);
  public
    function GetFromStack: boolean; override;
    procedure SetFromStack(const Value: boolean); override;
    function Ask:boolean; override;
    function AskDoubleValue:boolean; override;
    function Name : string; override;
    procedure Init(var v:TStepValue); override;
    function Expl : string; override;
    function GetStr : string; override;
    function Des : integer; virtual;
    procedure SetStr(const s:string); override;
    function SetValue(val:double):boolean; override;
    function GetValue:double;            override;
    property Value : double read GetValue write SetValue2;
  end;

  TStepDummy = class (TStepBasic)
  public
    function Level : Integer;            override;
    function TextColor : TColor;         override;
  end;

  TAvailableSteps = class (TList)
  public
    function FindStep(const name:string) : integer; virtual;
    procedure UpdateListBox(lb:TListBox);
  end;

  TAllSteps = class (TList)
    changes : boolean;
    filename : string;
    form : TForm;
  private
    FFullStop: boolean;
    procedure SetFullStop(const Value: boolean);
  public
    function FindStep(const name:string) : integer; virtual;
    function GetStep(n:integer):TStepBasic;
    function FindAnyStep(const name:string; AllowComment:boolean) : integer;
    procedure StartAll; virtual;
    procedure StopAll; virtual;
    procedure PauseAll; virtual;
    procedure StopAllTotally; virtual;
    destructor Destroy; override;
    Procedure UpdateCurNros; virtual;
    procedure WriteToFile(const fname:string);
    procedure ReadFromFile(const fname:string);
    procedure UpdateListBox(lb:TListBox);
    function Del(i:integer) : boolean;
    procedure Changed;
    procedure SetRow(i:integer);
    procedure FillCombo(cb:TComboBox;cl:TClass;st:array of string);
    procedure FillComboParam(cb:TComboBox);
    property  FullStop : boolean read FFullStop write SetFullStop;

  end;

  TOneProgStep = class
    fnr    : integer;   // Index to ProgComm array
    steps  : TAllSteps;
    step : TStepBasic;
    CurNr  : integer;  // Index to steps -list
    strvalue : string;
  public
    constructor Create(i:integer;stps:TAllSteps);
    destructor Destroy; override;
    function GetStr:String;
    procedure SetStr(s:string);
    procedure SetNr(n:integer);
    function Text:String;
    function Stop:boolean;
    function ListStr:String;
    property str:string read GetStr write SetStr;
    property Nr:integer read Fnr write SetNr;
    function Edit:boolean;
  end;

  TStepCond = class (TStepDouble)
    DoLoop : boolean;
  public
//    function Ask:boolean; override;
    function Des : integer; override;
    procedure Init(var v:TStepValue); override;
    function Cond(var v:TStepValue) : boolean; virtual;
    function DoCondJob(var v:TStepValue) : integer; virtual;
    function DoJob(var v:TStepValue) : integer; override;
    function IsCond:Boolean; override;
    function IsEventWait:boolean; virtual;
    function DoEventWait(var v:TStepValue) : boolean; virtual;
  end;

var ProgComm : TAvailableSteps;
function EventHandle(var v:TStepValue) : integer;
procedure InitProgComm;
procedure StepAdd(s:TStepBasic);
procedure ColorListBox(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState; steps:TAllSteps);

function StrToSDoubleDef(const s:string;def:double) : TSDouble;
function SDoubleToStr(const d:TSDouble; des:integer) : string;

implementation
uses KDouble,PrgLabel,PrgProg, PrgGoto, PrgComme, progc, kstring;
var StepDummy : TStepBasic;

//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------
function StrToSDoubleDef(const s:string;def:double) : TSDouble;
begin
  with Result do begin
    if ( s = 'Pop' ) then begin d := def; FromStack := true; end
    else begin d := IniStrToDouble(s,def); FromStack := false; end;
  end;
end;

function SDoubleToStr(const d:TSDouble; des:integer) : string;
begin
  if ( d.FromStack ) then Result := 'Pop'
  else Result := DoubleToIniStr(d.d,des);
end;


function EventHandle(var v:TStepValue) : integer;
begin
  Result := 0;
  if not (v.prog is TStepProgram) then exit;
  Result := (v.prog as TStepProgram).Event;
end;

procedure ClearEvent(var v:TStepValue);
begin
  if not (v.prog is TStepProgram) then exit;
  (v.prog as TStepProgram).ClearEvent;
end;

//------------------------------------------------------------------------------
// TOneProgStep
//------------------------------------------------------------------------------
procedure TOneProgStep.SetNr(n:integer);
// if n is number for comment, then the old step is togled either to
// comment or to command it was before togled to comment
var WasComment : boolean; s:TStepBasic; o:TObject; name:string;

  procedure TakeCommandOut(const cs:string);
  var p,i:integer;
  begin
    if ( cs = '' ) then exit;
    p := pos(cs,strvalue);
    if ( p = 0 ) then exit;
    name := Copy(strvalue,1,p-1);
    delete(strvalue,1,p+Length(cs)-1);
    i := ProgComm.FindStep(name);
    if ( i < 0 ) then exit;
    s := ProgComm[i];
    Fnr := i;
  end;

begin
  name := '';
  WasComment := false;
  if ( Stop ) then exit;
  if ( FNr = n ) and not ( assigned(step) and (step is TStepComment) ) then exit;
  if ( assigned(step) ) then begin
    strvalue := step.str;
    name := step.name;
    WasComment := step is TStepComment;
    step.Free;
  end;
  step := NIL;
  FNr := n;
  if ( n < 0 ) then
    s := StepDummy
  else begin
    if ( n < 0 ) or ( n >= ProgComm.Count ) then exit;
    s := ProgComm[FNr];
  end;

  if ( s is TStepComment ) then
    if (  WasComment ) then TakeCommandOut('::')
    else if ( name <> '' ) then
      strvalue := name+'::'+strvalue;

  o := s.NewInstance;
  step := o as TStepBasic;
  step.Create;
  step.str := strvalue;
  step.FParent := self;
  step.FSteps := steps;
  step.FNr := CurNr;
end;


constructor TOneProgStep.Create(i:integer;stps:TAllSteps);
begin
  inherited Create;
  steps := stps;
  strvalue := '';
//  Step := ProgComm.Items[0];
  Step := NIL;
  FNr := -2;
  SetNr(i);
end;

destructor TOneProgStep.Destroy;
begin
  if ( Step <> NIL ) then Step.Free;
  Step := NIL; 
end;


function TOneProgStep.Edit:boolean;
begin
  Result := false;
  if Stop then exit;
  Result := step.Ask;
end;


function TOneProgStep.Stop:Boolean;
begin
  Result := ( Fnr = -1 );
end;

function TOneProgStep.Text:String;
begin
  Result := '----------';
  if ( stop ) then exit;
  Result := step.Name;
end;

function TOneProgStep.GetStr:String;
begin
  Result := Text;
  if ( Stop ) then exit;
  Result := Result + ' ' + Step.Str;
end;

procedure TOneProgStep.SetStr(s:string);
begin
//
end;

function TOneProgStep.ListStr:String;
begin
  Result := '----------';
  if ( stop ) then exit;
  Result := Copy('                          ',1,2*(2-step.Level))+str;
//  if  not ( Step is TStepLabel ) then Result := '  ' + str
//  else Result := str;
end;

//------------------------------------------------------------------------------
// Available implementations:
//------------------------------------------------------------------------------
function TAvailableSteps.FindStep(const name:string) : integer;
var i:integer; s:TStepBasic; n:string;
begin
  n := Trim(UpperCase(name));
  for i:=0 to Count-1 do begin
    s := Items[i];
    if ( Trim(UpperCase(s.Name)) = n ) then begin
      Result := i;
      Exit;
    end;
  end;
  Result := -1;
end;

procedure TAvailableSteps.UpdateListBox(lb:TListBox);
var s:TStepBasic; i: integer;
begin
  for i := 0 to Count-1 do begin
    s := Items[i];
    lb.Items.Add(s.Name);
  end;
end;

//------------------------------------------------------------------------------
//  TAllSteps = class (TList)
//------------------------------------------------------------------------------
procedure TAllSteps.StartAll;
var i: integer; s: TOneProgStep;
begin
  for i:=0 to Count-1 do begin
    s := Items[i];
    if not ( s.Step is TStepProgram ) then continue;
    (s.Step as TStepProgram).DoStart;
  end;
end;

procedure TAllSteps.StopAll;
var i: integer; s: TOneProgStep;
begin
  for i:=0 to Count-1 do begin
    s := Items[i];
    if not ( s.Step is TStepProgram ) then continue;
    (s.Step as TStepProgram).DoStop;
  end;
end;

procedure TAllSteps.PauseAll;
var i: integer; s: TOneProgStep;
begin
  for i:=0 to Count-1 do begin
    s := Items[i];
    if not ( s.Step is TStepProgram ) then continue;
    (s.Step as TStepProgram).DoPause;
  end;
end;

procedure TAllSteps.StopAllTotally;
var i: integer; s: TOneProgStep;
begin
  for i:=0 to Count-1 do begin
    s := Items[i];
    if not ( s.Step is TStepProgram ) then continue;
    (s.Step as TStepProgram).DoStopTotally;
  end;
end;



destructor TAllSteps.Destroy;
var i:integer; s: TOneProgStep;
begin
  StopAllTotally;
  for i := 0 to Count-1 do begin
    s := Items[i];
    Items[i] := nil;
    s.Free;
  end;
  inherited Destroy;
end;

procedure TAllSteps.Changed;
begin
  Changes := true;
end;

function TAllSteps.Del(i:integer) : boolean;
var s: TOneProgStep;
begin
  Result := false;
  if ( i < 0 ) or ( i > Count-1 ) then exit;
  s := Items[i];
//  s.Step.Free;
  Result := True;
//  Remove(i);
  Remove(s);
  s.Free;
end;

procedure TAllSteps.SetRow(i:integer);
begin
  if ( form is TFormProg ) then begin
    (form as TFormProg).SetRow(i);
  end;
end;

//-----------------------------------------------------------------------------
function TAllSteps.GetStep(n:integer):TStepBasic;
var s : TOneProgStep;
begin
  s := Items[n];
  Result := s.Step;
end;

function TAllSteps.FindAnyStep(const name:string; AllowComment:boolean) : integer;
var i:integer; s: TOneProgStep;
begin
  for i := 0 to Count-1 do begin
    s := Items[i];
    if ( s <> nil ) and ( s.Step <> nil ) and
       ( s.Step.id = name ) and ( AllowComment or
         ( not ( s.Step is TStepComment ) )  ) then
      begin Result := i; exit; end;
  end;
  Result := -1;
end;

function TAllSteps.FindStep(const name:string) : integer;
begin
  Result := FindAnyStep(name,false);
end;

procedure TAllSteps.UpdateCurNros;
var i:integer; s: TOneProgStep;
begin
  for i := 0 to Count-1 do begin
    s := Items[i];
    s.CurNr := i;
    s.Step.FNr := i;
  end;
end;

procedure TAllSteps.ReadFromFile(const fname:string);
var f:TextFile; pi,pc,p,i:integer; id,comment,name,s:string; st : TOneProgStep;
  procedure CreateLastStep;
  begin
    st := TOneProgStep.Create(-1,self);
    st.Step.Str := '';
    Add(st);
    UpdateCurNros;
    Changes := false;
  end;

begin
  filename := fname;
  AssignFile(f,fname);
  if ( not FileExists(filename) ) then begin
    ShowMessage('Logic program file: ' + filename + ' not found!');
    CreateLastStep;
    Exit;
  end;
  p := IoResult; if ( p > 0 ) then s := ''; // Just to remove IoResult :-)
  Reset(f);
  while (not eof(f) ) do begin
    Readln(f,s);
    p := Pos(':',s);
    if ( p = 0 ) then continue;
    name := trim(Copy(s,1,p-1));

    pc := Pos('#',s);
    comment := '';
    if ( pc = 0 ) then pc := 400
    else comment := trim(copy(s,pc+1,400));
    if ( pc < p ) then continue;
    s := trim(copy(s,1,pc-1));
    p := Pos(':',s);

    pi := Pos('=',s);                      // find format jumphere=command
    id := '';
    if ( pi <> 0 ) then begin
      if ( pi <= p ) then continue;
      if ( pi < Length(s) ) and ( s[pi+1] <> '=' ) then begin // if not format s == 5
        id := trim(copy(s,p+1,pi-p-1));
        if ( not ValidIdentifier(id,[' ',';',','],['0'..'9']) ) then id := ''
        else s := copy(s,pi+1,200);
      end;
    end;
    if ( id = '' ) then  s := copy(s,p+1,200);
    s := trim(s);

    i := ProgComm.FindStep(name);
    if ( i < 0 ) then begin
      ShowMessage('Unknown command: ' + name + ':' + s);
      Continue;
    end;
    st := TOneProgStep.Create(i,self);
    st.Step.Id := id;
    st.Step.Str := s;
    st.Step.FComment := comment;
    Add(st);
  end;
  CloseFile(f);
  CreateLastStep;
end;


procedure TAllSteps.WriteToFile(const fname:string);
var f:TextFile; i:integer; comms,ids,line,name,s:string; st : TOneProgStep;
begin
  if ( not Changes ) then exit;
  if fname <> '' then filename := fname;
  AssignFile(f,filename);
  Rewrite(f);
  for i:=0 to Count-2 do begin
    st := Items[i];
    name := st.step.Name;
    ids := '';
    if not ( st.Step is TStepLabel ) then begin
      name := '  ' + name;
      if ( st.Step.id <> '' ) then ids := st.Step.id + '=';
    end;  
    s := copy(name+':'+'                                 ',1,20);
    if ( s[20] <> ' ' ) then s := name + ':';
    s := s + ids + st.step.Str;
    line := s;
    comms := '';
    if ( st.Step.Comment <> '' ) then begin
      comms := ' # ' + st.Step.Comment;
      if Length(line) < 60 then begin
        line := line + '                                                          ';
        line := copy(line,1,60);
      end;  
    end;
    Writeln(f,line + comms);
  end;
  CloseFile(f);
  Changes := false;
end;

procedure TAllSteps.UpdateListBox(lb:TListBox);
var i:integer; s: TOneProgStep;
begin
  lb.Clear;
  for i := 0 to Count-1 do begin
    s := Items[i];
    lb.Items.Add(s.ListStr);
  end;
  lb.ItemIndex := Count;
end;

procedure TAllSteps.FillCombo(cb:TComboBox;cl:TClass;st:array of string);
var i:integer; s: TOneProgStep; b: TStepBasic;
begin
  cb.Clear;
  for i := 0 to Count-1 do begin
    s := Items[i];
    b := s.step;
    if ( b is cl ) then cb.Items.Add(b.id);
  end;
  for i := 0 to High(st) do begin
    cb.Items.Add(st[i]);
  end;
end;

procedure TAllSteps.FillComboParam(cb:TComboBox);
var i:integer; s: TOneProgStep; b: TStepBasic;
begin
  cb.Clear;
  for i := 0 to Count-1 do begin
    s := Items[i];
    b := s.step;
    if ( pos('?',b.id) > 0 ) then cb.Items.Add(b.id);
  end;
end;

procedure TAllSteps.SetFullStop(const Value: boolean);
begin
  if ( FullStop = Value ) then exit;
  FFullStop := Value;
  if Value then PauseAll else StartAll;
  TFormProg(form).Stopped(value);
end;

//------------------------------------------------------------------------------
// Step implementations:
//------------------------------------------------------------------------------
function TStepBasic.GetFromStack: boolean;
begin
  Result := false;
end;

constructor TStepBasic.Create;
begin
  FParent := NIL; id := ''; FComment := '';
end;

destructor TStepBasic.Destroy;
begin
  inherited Destroy;
end;

function TStepBasic.AskDoubleValue: boolean;
begin
  Result:=Ask;
end;

function TStepBasic.Ask:boolean;
begin
  Result := true;
end;

function TStepBasic.Name : string;
begin  Result := '----------'; end;

function TStepBasic.Expl : string;
begin Result := 'Never use directly!'; end;

function TStepBasic.SpeExpl : string;
begin Result := ''; end;

function TStepBasic.StepOne : integer;
begin
  Result := Parent.CurNr+1;
end;

function TStepBasic.DoJob(var v:TStepValue) : integer;
begin
  Result := Parent.CurNr+1;
end;

procedure TStepBasic.Init(var v:TStepValue);
begin
  v.val := 0;
  v.op1 := 0;
  v.op2 := 0;
  v.l := 0;
  v.w := 0;
  v.g := 0;
  v.s := '';
end;

function TStepBasic.GetStr : string;
begin Result := '-----------'; end;

procedure TStepBasic.SetStr(const s:string); begin end;

function TStepBasic.IsCond:Boolean; begin Result := False; end;

function TStepBasic.AskComment : boolean;
begin
  result := DoAskComment('Give the comment and Id',FComment,id);
end;

function TStepBasic.SetValue(val:double):boolean;
begin Result := false; end;

function TStepBasic.GetValue:double; begin Result := 0; end;

function TStepBasic.InsertBefore : string; begin Result := ''; end;
function TStepBasic.InsertAfter : string;  begin Result := ''; end;

function TStepBasic.Level : Integer;     begin Result := 0;    end;
function TStepBasic.Color : TColor;      begin Result := 0;    end;
function TStepBasic.TextColor : TColor;  begin Result := 0;    end;
function TStepBasic.Style : TFontStyles; begin Result :=[];    end;

//------------------------------------------------------------------------------
function TStepDouble.SetValue(val:double):boolean;
begin d.d:=val; Result := true; end;

procedure TStepDouble.SetValue2(val:double);
begin SetValue(val); end;

function TStepDouble.GetValue:double; begin Result := d.d; end;

function TStepDouble.Des : integer; begin Result := 4; end;

function TStepDouble.Ask:boolean;
begin
  Result := AskValue(Name + ' = ' + expl,d.d,-100000,100000,des);
end;

function TStepDouble.AskDoubleValue:boolean;
begin
  Result := AskValue(Name + ' = ' + expl,d.d,-100000,100000,des);
end;

function TStepDouble.Name : string;
begin Result := 'Double'; end;

function TStepDouble.Expl : string; //virtual;
begin Result := 'Real number as a variable'; end;

function TStepDouble.GetStr : string;
begin Result := SDoubleToStr(d,Des); end;

procedure TStepDouble.SetStr(const s:string);
begin d := StrToSDoubleDef(s,0); end;

procedure TStepDouble.Init(var v:TStepValue); //  override;
begin
  v.op1 := GetValue;
  if ( d.FromStack ) then begin
    v.op1 := GetProgFromV(v).PopVar;
  end;
end;

function TStepDouble.GetFromStack : boolean;
begin
  Result := d.FromStack;
end;

//------------------------------------------------------------------------------
function TStepCond.Des : integer; begin Result := 0; end;

function TStepCond.Cond(var v:TStepValue) : boolean;
begin Result := True; end;

procedure TStepCond.Init(var v:TStepValue);
begin
  inherited Init(v);
  DoLoop := True;
  if ( TOneProgStep(steps[nr+1]).Step is TStepIfGoto ) then DoLoop := false;
end;

function TStepCond.IsEventWait:boolean;  begin Result := false; end;

function TStepCond.DoEventWait(var v:TStepValue) : boolean;
begin Result := true; end;

function TStepCond.DoCondJob(var v:TStepValue) : integer;
begin
  if ( DoLoop and ProgUseThread and IsEventWait ) then begin
    ClearEvent(v);
    v.Condition := DoEventWait(v);
    Result := StepOne;
    Exit;
  end;
  v.Condition := Cond(v);
  if ( not v.Condition ) and DoLoop Then Result := nr
  else Result := StepOne;
end;

function TStepCond.DoJob(var v:TStepValue) : integer;
begin
  Result := DoCondJob(v);
end;

function TStepCond.IsCond:Boolean; begin Result := True; end;

//------------------------------------------------------------------------------
// The whole module initializtion:
//------------------------------------------------------------------------------
procedure InitProgComm;
begin
  if ( Assigned(ProgComm) ) then exit;
  ProgComm := TAvailableSteps.Create;
  if ( not Assigned(ProgComm) ) then begin
    ShowMessage('Can''t initialize logic programs!');
    Halt;
  end;
end;

procedure StepAdd(s:TStepBasic);
begin
  if ( not Assigned(ProgComm) ) then InitProgComm;
  ProgComm.Add(s);
end;

procedure ColorListBox(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState; steps:TAllSteps );
var s:string; offset : integer; so : TOneProgStep; b : TStepBasic;
begin
  if not ( Control is TListBox ) then exit;
  with (Control as TListBox) do
  with (Control as TListBox).Canvas do	{ draw on the control canvas, not on the form }
  begin
    s := Items[index];
//    if ( s[1] = 'P' ) and ( state = [] ) then // Ohjelmat keltaisella
//      Canvas.Brush.Color := clYellow;
    if ( steps <> nil ) and ( steps.Count > index ) and
       ( not ( odSelected in state ) ) then begin
      so := steps[Index];
      b := so.Step;
      if ( not Assigned(b) ) then exit;
      if ( b.Color <> 0 )     then Brush.Color := b.Color;
      if ( b.TextColor <> 0 ) then Font.Color := b.TextColor;
      if ( b.Style <> [] )    then Font.Style := b.Style;
    end;
    FillRect(Rect);	{ clear the rectangle }
    Offset := 2;	{ provide default offset }
    TextOut(Rect.Left + Offset, Rect.Top, s)	{ display the text }
  end;
end;

//------------------------------------------------------------------------------
// The whole module initializtion:
//------------------------------------------------------------------------------
function TStepDummy.Level : Integer; begin Result := 2000; end;
function TStepDummy.TextColor : TColor; begin Result := 0; end;



procedure TStepDouble.SetFromStack(const Value: boolean);
begin
  d.FromStack := Value;
end;

procedure TStepBasic.SetFromStack(const Value: boolean);
begin
  ;
end;

initialization begin
  StepAdd(TStepDouble.Create);
  StepDummy := TStepDummy.Create;
end;





end.