unit MyThread;
{$IFDEF FPC}
  {$MODE DELPHI}{$H+}
{$ENDIF}
interface

uses    Classes, SysUtils,Graphics,
        Forms,Dialogs, Controls, extctrls;

type
     TMethod = procedure of object;
     TyProcedure=procedure;
 Type
    TMyThread = class(TThread)
   protected
      procedure Execute; override;
   public
      Constructor Create(prc: tyProcedure; Urgency:TThreadPriority; StackSize:sizeUint);
      procedure SyncExec(p:TMethod);
      destructor Destroy; override;
   private
      parasection:TyProcedure;
      {$IFDEF Darwin} completed:boolean; {$ENDIF}
      procedure DoOnTerminate(Sender: TObject);virtual;
  end;


  Type
     TBASICFirstThread = class(TMyThread)

    protected
       procedure Execute; override;
    public
       Constructor Create( Urgency:TThreadPriority; StackSize:sizeUint);
       destructor Destroy; override;
    private
       procedure DoOnTerminate(Sender: TObject);override;


  end;
  var
    BASICThread0 : TBASICFirstThread;
    BASICThread1,BASICThread2,BASICThread3,BASICThread4,BASICThread5,BASICThread6,BASICThread7:TMyThread;


   procedure MainTask;

   type
      TAllThreadsList=class(TThreadList)
         public
           function finished:boolean;
           procedure suspend;
           procedure resume;
           procedure kill;
      end;
    var
      AllThreadsList:TAllThreadsList;


implementation
uses
  base,base2,sconsts,charinp,textfrm,textfile,paintfrm,graphsys,graphque,debugdg,baslib,inputdlg,
  textout,BASICunit;





procedure MainTask;
var
d:Dword;
begin
   (TThread.CurrentThread).Yield;
    if BASICUnit.DrawTimeInterval>0 then sleep(BASICUnit.DrawTimeInterval);

    GraphOutExec;
    if not HiddenDrawMode then
       RepaintExec;

    TextOutExec;


    if ConsoleInputRequest then
        begin
          InputDialog.execute;
          ConsoleInputRequest:=false;
         end;

    if CharacterInputRequest then
       begin
            charInput.execute;
            CharacterInputRequest:=false;
       end;

    if CtrlBreakHit then
       begin
         {$IFDEF Windows} AllThreadsList.Suspend;{$ENDIF}
         DebugDLG.Execute;
         CtrlBreakHit:=false;
         {$IFDEF Windows}AllThreadsList.Resume;{$ENDIF}
       end;

    Application.ProcessMessages;
 end;


constructor TMyThread.Create(prc: TyProcedure; Urgency:TThreadPriority; StackSize:sizeUint);

begin
    inherited Create(true,StackSize);
    priority:=Urgency;
    parasection:=prc;
    FreeOnTerminate := true;
    OnTerminate:= DoOnTerminate;
    AllThreadsList.add(self);
end;

constructor TBASICFirstThread.Create( Urgency:TThreadPriority; StackSize:sizeUint);
 begin
    inherited Create(BASICMain,Urgency,StackSize);
 end;

  procedure TMyThread.Execute;
   begin
      controlword:=NormalCW;
      SetFPUMask(NormalCW);
      ParaSection;
      {$IFDEF Darwin} Completed:=true {$ENDIF}
   end;

  procedure TBASICFirstThread.Execute;
   begin
      controlword:=NormalCW;
      SetFPUMask(NormalCW);
      ModulesInit;
      ParaSection;
      {$IFDEF Darwin} Completed:=true {$ENDIF}
   end;

  destructor TMyThread.Destroy;
  begin
       AllThreadsList.remove(self);
       inherited destroy;
  end;
destructor TBASICFirstThread.Destroy;
begin
     ModulesDone;
     inherited destroy;
end;

procedure TMyThread.SyncExec(p:TMethod);
begin
  synchronize(p);
  //synchronize(Application.ProcessMessages);
end;

procedure TMyThread.DoOnTerminate(Sender: TObject);
var
    E:Exception;
begin
   if Assigned(TMyThread(Sender).FatalException) = True then
   begin
     E:=Exception(TMyThread(Sender).FatalException);
     MainTask;
     if not (E is EParStop) then
      begin
        TextForm.memo1.Lines.BeginUpdate;
        TextForm.memo1.selText:=EOL+EXMess(E ,excode);
        TextForm.Memo1.Lines.EndUpdate;
        TextForm.show;
        MessageDlg(EXMess(E ,excode), mtError, [mbOK], 0);
     end;
   end;
   self:=nil;
 end;

procedure TBASICFirstThread.DoOnTerminate(Sender: TObject);
begin
    inherited DoOnTerminate(Sender);
end;

function TAllThreadsList.finished:boolean;
var
    i:integer;
begin
    result:=true;
    with LockList do
     begin
       for i:=0 to count -1 do
       result:=result and (((TObject(items[i]) as TThread)=nil{.Finished})
      {$IFDEF Darwin} or ((TObject(items[i]) as TMyThread).Completed){$ENDIF});
     end;
    unlocklist;
end;

procedure TAllThreadsList.Suspend;
var
    i:integer;
begin
    with LockList do
     begin
       for i:=0 to count -1 do
         TThread(items[i]).suspend;
     end;
    unlocklist;
end;

procedure TAllThreadsList.Resume;
var
    i:integer;
begin
    with LockList do
     begin
       for i:=0 to count -1 do
         TThread(items[i]).Resume;
     end;
    unlocklist;
end;

procedure TAllThreadsList.kill;
var
    i:integer;
begin
    with LockList do
     begin
       for i:=0 to count -1 do
       KillThread(TThread(items[i]).Handle);
     end;
    unlocklist;
end;


initialization
    AllThreadsList:=TAllThreadsList.create;

finalization
    AllThreadsList.free;

end.

