unit TutorialSystem;

interface

Uses
 Classes, Controls, extctrls, graphics;

Type
 TTutorialList = class;
 TtssProcedure = class(TObject)
 private
  fProcedureName: String;
  Parent: TTutorialList;
 public
  tssProcedure: TStringList;
  Property Procedurename: String read fProcedureName;
  Constructor Create(ProcedureName: String; Owner: TTutorialList);
  Procedure Run;
 end;
 TProcedureList = Class(TObject)
 private
  fList: array of TtssProcedure;
  Parent: TTutorialList;
  function GETCOUNT: cardinal;
  function GETtssPROCEDURE(Index: Integer): TtssProcedure;
 public
  Constructor Create(Owner: TTutorialList);
  Property Count: cardinal read GETCOUNT;
  Function FindProcedure(tssProcedureName: String): TtssProcedure;
  Procedure Clear;
  Function Add(tssProcedureName: String): TtssProcedure;
  Property tssProcedure[Index: Integer]: TtssProcedure read GETtssPROCEDURE; default;
 end;
 TErrorHandler = record
  OnError: String;
  RunProcedure: String;
 end;
 TErrorHandlerList = class(TObject)
 private
  Parent: TTutorialList;
  fList: Array of TErrorHandler;
  function GETCOUNT: cardinal;
    function GETHANDLER(Index: Integer): TErrorHandler;
 public
  Procedure Clear;
  Constructor create(Owner: TTutorialList);
  Procedure Add(OnThis, RunThis: String);
  Property Count: cardinal read GETCOUNT;
  Procedure CheckForAndRun(Error: String);
  Property ErrorHandler[Index: Integer]: TErrorHandler read GETHANDLER; default;
 end;
 TTutorial = Record
  ScreenName: String;
  Filename: String;
 end;
 TTutorialList = Class(TObject)
 private
  fList: Array of TTutorial;
  Cap, Des, Name, Description, Author: String;
  Selected: TComponent;
  WaitFor, Proceed: Boolean;
  fObjectTrace: boolean;
  fWaitingForCallback: string;
  fSetTerminate: Boolean;
  function GETCOUNT: Cardinal;
    procedure SET_TERMINATE(const Value: boolean);
 public
  ProcedureList: TProcedureList;
  ErrorHandler: TErrorHandlerList;
  PauseTimer: TTimer;
  CaptionFont: TFont;
  MainFont: TFont;
  Constructor Create;
  Procedure OnTimer(Sender: TObject);
  Procedure OnMenuItemClick(Sender: TObject);
  Procedure Add(Filename: String);
  Procedure BuildMenu;
  Property Count: Cardinal read GETCOUNT;
  Property ObjectTrace: boolean read fObjectTrace write fObjectTrace;
  Procedure Run(Index: Integer);
  Function GetObject(Comp: TComponent; FindWhat: String): TComponent;
  Function GetObjectPath(Comp: TComponent): string;
  Procedure OnProceed(Sender: TObject);
  Procedure SetPathAsHint(Comp: TComponent);
  Function IsValidTControl(Comp: TComponent): boolean;
  Procedure SetHintType(Extended: boolean; Comp: TComponent);
  Property WaitingForCallback: string read fWaitingForCallback write fWaitingForCallBack;
  Function Callback(Sender: TObject; CallBackStr: String = ''): boolean;
  Procedure ExecuteScriptLine(CurLine: String);
  Property SetTerminate: boolean read fSetTerminate write SET_TERMINATE;
 end;

implementation

{ TTutorialList }

uses sysutils, main, menus, Dialogs, forms, filter, popupHint, messages, oi, pluginPalette;

procedure TTutorialList.Add(Filename: string);
Var
 List: TStringList;
 I: Integer;
begin
 List := TStringList.Create;
 List.LoadFromFile(filename);
 If list.count = 0 then exit;
 If uppercase(List[0]) <> uppercase('OUTLAWEDTUTORIAL1') then exit;
 Setlength(flist, length(flist) + 1);
 fList[Length(fList) -1].Filename := Filename;
 For i := 0 to list.count - 1 do begin
  If uppercase(list[I]) = 'TUTORIALNAME' then begin
   fList[Length(fList) - 1].ScreenName := List[I+1];
   break;
  end;
 end;
 freeandnil(list);
end;

procedure TTutorialList.BuildMenu;
Var
 I: Integer;
 MI: TMenuItem;
begin
 If Count = 0 then begin
  oeMain.tutorials1.Enabled := false;
  exit;
 end;
 For I := 0 to count - 1 do begin
  MI := TMenuItem.Create(oeMain.tutorials1);
  MI.Caption := flist[I].ScreenName;
  MI.Tag := I;
  MI.OnClick := OnMenuItemClick;
  oeMain.tutorials1.Add(MI);
 end;
end;

Function TTutorialList.Callback(Sender: TObject; CallBackStr: String = ''): boolean;
Var
 S, Path: String;
begin
 Result := true;
 If uppercase(Getfilt(WaitingforCallBack, 1, ' ')) = 'DRAGGENERALCOMPLETE' then begin
  S := DelFilt(WaitingForcallback, 1, ' ');
  if uppercase(Callbackstr) = uppercase(S) then begin
   Waitfor := true;
   exit;
  end
   else
  begin
   If uppercase(getfilt(callbackstr, 1, '.')) = uppercase(getfilt(s, 1, '.')) then begin
    ErrorHandler.CheckForAndRun('WRONGSENSOR');
   end
    else
   begin
    ErrorHandler.CheckForAndRun('WRONGGENERAL');
   end;
   Result := false;
   exit;
  end;
 end;
 If uppercase(GetFilt(WaitingForCallBack, 1, ' ')) = 'DRAGGENERAL' then begin
  If uppercase(Callbackstr) = 'DRAGGENERAL' then begin
   Waitfor := true;
   Application.ProcessMessages;
   exit;
  end;
 end;
 If uppercase(GetFilt(WaitingForCallback, 1, ' ')) = 'DRAGVISUAL' then begin
  If uppercase(callbackstr) = uppercase(GetFilt(WaitingForCallback, 2, ' ')) then begin
   Waitfor := true;
   exit;
  end
   else
  begin
   ErrorHandler.CheckForAndRun('WRONGVISUAL');
   Exit;
  end;
 end;
 // From here on out it's automation and that requires the sender to be of TComponent
 If not(sender is TComponent) then exit;
 Path := GetObjectPath((sender as TComponent));
 If WaitingForCallback = 'showevents' then begin
  MessageDlg('You just triggered the following event.' + #13#10#13#10 + Path, mtInformation, [mbOK], 0);
  exit;
 end;
 If uppercase(Path) = uppercase(WaitingForCallback) then begin
  Waitfor := true;
 end;
end;

constructor TTutorialList.Create;
begin
 CaptionFont := TFont.Create;
 CaptionFont.Name := 'Arial';
 CaptionFont.Size := 10;
 CaptionFont.Style := [fsBold];
 MainFont := Tfont.Create;
 MainFont.Name := 'Arial';
 MainFont.Size := 8;
 Pausetimer := TTimer.Create(nil);
 PauseTimer.Enabled := False;
 PauseTimer.OnTimer := OnTimer;
 ProcedureList := TProcedureList.Create(self);
 ErrorHandler := TErrorHandlerList.Create(Self);
 setTerminate := false;
end;

procedure TTutorialList.ExecuteScriptLine(CurLine: String);
Var
 Handled: Boolean;
 Proc: TtssProcedure;
 IntVal: Integer;
begin
  Handled := false;
  // Scripting commands

  If (Uppercase(GetFilt(Curline, 1, ' '))) = 'ON' then begin
   CurLine := DelFilt(Curline, 1, ' ');
   ErrorHandler.Add(GetFilt(Curline, 1, ' '), GetFilt(CurLine, 2, ' '));
  end;

  // Showinfo - will open a message with the tutorial information
  If (uppercase(CurLine) = 'SHOWINFO') or (Uppercase(CurLine) = 'ABOUT') then begin
   MessageDlg(Name + #13#10#13#10 + Description + #13#10#13#10 + 'By: ' + Author, mtInformation, [mbOK], 0);
   Handled := true;
  end;

  // Select = defines the position (control) where the bubble is to point to
  If uppercase(copy(CurLine, 1, length('SELECT:'))) = 'SELECT:' then begin
   CurLine := Copy(CurLine, Length('Select:') + 1, length(Curline));
   If uppercase(copy(curline, 1, length('FORMMGR,'))) = 'FORMMGR,' then begin
    CurLine := Copy(curline, length('FORMMGR,') + 1, length(curline));
    Try
     Selected := oeMain.FormMgr[StrToInt(Curline)];
    except
     Selected := nil;
    end;
   end
    else
   begin
    Selected := GetObject(nil, CurLine);
   end;
   Handled := true;
  end;

  // Set = Allows you to set a certain value to a component
  If (uppercase(Getfilt(curline, 1, ' '))) = 'SET' then begin
   Curline := delfilt(curline, 1, ' ');
   If uppercase(GetFilt(Curline, 1, ' ')) = 'PALETTEPAGE' then begin
    CurLine := delFilt(Curline, 1, ' ');
    Try
     IntVal := StrToInt(Curline);
    except
     IntVal := 0;
    end;
    oePlugin.PageControl1.ActivePageIndex := IntVal;
   end;
  end;

  // Caption = will set the caption text for the hint
  If uppercase(copy(CurLine, 1, length('CAPTION:'))) = 'CAPTION:' then begin
   CurLine := Copy(CurLine, Length('CAPTION:') + 1, length(curline));
   Cap := CurLine;
   Handled := true;
  end;

  // Description = will the the main text of the hint
  If uppercase(copy(Curline, 1, length('HINTDESCRIPTION:'))) = 'HINTDESCRIPTION:' then begin
   CurLine := Copy(CurLine, Length('HINTDESCRIPTION:') + 1, length(CurLine));
   Des := CurLine;
   Handled := true;
  end;

  If uppercase(curline) = 'SHOWSELECTED' then begin
   Handled := true;
   If selected = nil then begin
    Showmessage('NIL!!!');
   end
    else
   begin
    showmessage('Name: ' + selected.Name + #13#10 + 'Type: ' + Selected.ClassName);
   end;
  end;

  // Showhint = will popup the hint
  If uppercase(curline) = 'SHOWHINT' then begin
   Handled := true;
   Proceed := false;
   HintWin.OnHiding := OnProceed;
   HintWin.borcolor := clRed;
   If (Selected is TControl) then begin
    HintWin.ShowHint((Selected as TControl), adAuto, Cap, Des, 0, CaptionFont, MainFont, clinfobk, clred);
   end
    else
   begin
    HintWin.ShowHint(point(0,0), adAuto, Cap, Des, 0, CaptionFont, MainFont, clinfobk, clred);
   end;
   While not proceed do begin
    Application.ProcessMessages;
   end;
   HintWin.OnHiding := nil;
  end;

  // TControl general commands
  If uppercasE(curline) = 'ENABLE' then begin
   Handled := true;
   if IsValidTControl(Selected) then begin
    (Selected as TControl).Enabled := true;
   end;
  end;
  If uppercase(Curline) = 'DISABLE' then begin
   Handled := true;
   if IsValidTControl(Selected) then begin
    (Selected as TControl).Enabled := false;
   end;
  end;
  If uppercase(CurLine) = 'HIDE' then begin
   Handled := true;
   if IsValidTControl(Selected) then begin
    (Selected as TControl).Visible := False;
   end;
  end;
  If uppercase(CurLine) = 'SHOW' then begin
   Handled := true;
   if IsValidTControl(Selected) then begin
    (Selected as TControl).Visible := true;
    (Selected as TControl).BringToFront;
    (selected as TControl).Update;
   end;
  end;
  If uppercase(CurLine) = 'ONCLICK' then begin
   Handled := true;
   if IsValidTControl(Selected) then begin
    (Selected as TControl).Perform(WM_LBUTTONDOWN, 0, 0);
    (Selected as TControl).Perform(WM_LBUTTONUP, 0, 0)
   end;
  end;
  If uppercase(copy(curline, 1, length('SETHINT:'))) = 'SETHINT:' then begin
   Handled := true;
   If IsValidTControl(Selected) then begin
    CurLine := Copy(CurLine, Length('SETHINT:') + 1, length(curline));
    (Selected as TControl).Hint := CurLine;
   end;
  end;

  // Pause - cause script suspention for xxx msec
  If uppercase(copy(curline, 1, length('PAUSE:'))) = 'PAUSE:' then begin
   Handled := true;
   CurLine := Copy(CurLine, Length('PAUSE:') + 1, length(Curline));
   Proceed := False;
   PauseTimer.Interval := StrToInt(CurLine);
   PauseTimer.Enabled := true;
   While not Proceed do begin
    Application.ProcessMessages;
   end;
  end;

  // WaitFor - cause the script suspention until user has performed an event
  If uppercase(copy(curline, 1, length('WAITFOR:'))) = 'WAITFOR:' then begin
   Handled := true;
   CurLine := copy(curline, length('WAITFOR:') + 1, length(curline));
   fWaitingForCallback := CurLine;
   Waitfor := false;
   While not Waitfor do begin
    Application.ProcessMessages;
   end;
   fWaitingForCallback := '';
  end;

  // End
  If uppercase(curLine) = 'END' then begin
   Handled := true;
   MessageDlg('This concludes the tutorial.'+#13+#10+'Hope you learned something usefull.', mtInformation, [mbOK], 0);
  end;

  If not handled then begin
   Proc := ProcedureList.FindProcedure(Curline);
   If Proc <> nil then begin
    Proc.Run;
   end;
  end;
end;

function TTutorialList.GETCOUNT: Cardinal;
begin
 Result := length(fList);
end;

function TTutorialList.GetObject(Comp: TComponent;
  FindWhat: String): TComponent;
Var
 I: Integer;
 S: String;
begin
 Result := nil;
 S := GetFilt(FindWhat, 1, '.');
 If Comp = nil then comp := Application;
 For I := 0 to comp.ComponentCount - 1 do begin
  if uppercase(S) = uppercase(Comp.Components[I].Name) then begin
   If countFilt(FindWhat, '.') = 1 then begin
    Result := Comp.Components[I];
    exit;
   end
    else
   begin
    Result := GetObject(Comp.Components[I], DelFilt(FindWhat, 1, '.'));
    exit;
   end;
  end;
 end;
end;

function TTutorialList.GetObjectPath(Comp: TComponent): string;
begin
 Result := '';
 While (Comp <> nil) do begin
  Result := Comp.Name + '.' + Result;
  Comp := Comp.Owner;
 end;
 Result := Copy(Result, 2, length(result) - 2);
end;

function TTutorialList.IsValidTControl(Comp: TComponent): boolean;
begin
 If comp = nil then begin
  MessageDlg('Tutorial Script error.'+#13+#10+'You cannot perform commands on selected item, because you have not yet set selected control.', mtError, [mbOK], 0);
  Result := False;
  Exit;
 end;
 Result := Comp is TControl;
 If not result then begin
  MessageDlg('Tutorial Script Error:'+#13+#10+'Selected object is not of TControl type.'+#13+#10+'ComponentName: ' + Comp.Name +#13+#10+'Classname: ' + Comp.ClassName, mtError, [mbOK], 0);
 end;
end;

procedure TTutorialList.OnMenuItemClick(Sender: TObject);
begin
 Run((sender as tmenuitem).Tag);
end;

procedure TTutorialList.OnProceed(Sender: TObject);
begin
 Proceed := true;
end;

procedure TTutorialList.OnTimer(Sender: TObject);
begin
 PauseTimer.Enabled := false;
 Proceed := true;
end;

procedure TTutorialList.Run(Index: Integer);
Var
 Script: TStringList;
 BeginAt, AtLine: Integer;
 CurLine: string;
 ReEnableExtendedHelp: Boolean;
begin
 Script := TStringlist.Create;
 Script.LoadFromFile(fList[Index].Filename);
 ReEnableExtendedHelp := oeMain.Extendedhints1.Checked;
 If ReEnableExtendedHelp then begin
  oeMain.Extendedhints1Click(self);
 end;
 BeginAt := -1;
 ProcedureList.Clear;
 ErrorHandler.Clear;
 // First we run through to get the basic information
 AtLine := 0;
 Repeat
  CurLine := Script[AtLine];

  // Check for plugins
  If copy(CurLine, 1, length('REQUIREDGENERAL:')) = 'REQUIREDGENERAL:' then begin
   CurLine := Copy(CurLine, length('REQUIREDGENERAL:') + 1, length(curline));
   If oeMain.gpl.IndexOf(curline) = -1 then begin
    MessageDlg('Unable to run tutorial. You''re missing a general plugin [' + curline + ']', mtWarning, [mbOK], 0);
    exit;
   end;
  end;

  If copy(CurLine, 1, length('REQUIREDVISUAL:')) = 'REQUIREDVISUAL:' then begin
   CurLine := Copy(CurLine, length('REQUIREDVISUAL:') + 1, length(curline));
   If oeMain.vpl.GetIndexOf(curline) = -1 then begin
    MessageDlg('Unable to run tutorial. You''re missing a visual plugin [' + curline + ']', mtWarning, [mbOK], 0);
    exit;
   end;
  end;

  // Load information
  If uppercase(CurLine) = 'TUTORIALNAME' then begin
   Name := Script[AtLine+1];
  end;
  If uppercase(CurLine) = 'DESCRIPTION' then begin
   Description := Script[AtLine+1];
  end;
  If uppercase(CurLine) = 'AUTHOR' then begin
   Author := Script[AtLine+1];
  end;

  // Locate Script begin line
  If uppercase(CurLine) = 'BEGIN' then begin
   BeginAt := AtLine;
  end;

  If uppercase(copy(curline, 1, length('PROCEDURE '))) = 'PROCEDURE ' then begin
   CurLine := Copy(curline, length('PROCEDURE ') + 1, length(curline));
   Inc(AtLine);
   With ProcedureList.Add(Curline) do begin
    While uppercase(Script[AtLine]) <> 'ENDPROCEDURE' do begin
     tssProcedure.Add(Script[AtLine]);
     Inc(AtLine);
    end;
   end;
  end;

  Inc(AtLine);
 Until (BeginAt > -1) or (AtLine >= Script.Count);
 If BeginAt = -1 then begin
  MessageDlg('Unable to locate BEGIN statement in the tutorial script.', mtError, [mbOK], 0);
  exit;
 end;
 Cap := ''; Des := '';
 AtLine := BeginAt;
 Selected := nil;
 While AtLine < script.count do begin
  ExecuteScriptLine(Script[AtLine]);
  Inc(AtLine);
  If SetTerminate then break;
 end;
 FreeAndNil(Script);
 If ReEnableExtendedHelp then begin
  oeMain.Extendedhints1Click(self);
 end;
end;

procedure TTutorialList.SetHintType(Extended: boolean; Comp: TComponent);
Var
 I: Integer;
begin
 If (Comp is Tcontrol) then begin
  (Comp as TControl).ShowHint := Extended;
 end;
 For I := 0 to Comp.ComponentCount - 1 do begin
  SetHintType(Extended, Comp.Components[I]);
 end;
end;

procedure TTutorialList.SetPathAsHint(Comp: TComponent);
Var
 I: Integer;
begin
 If (comp is TControl) then begin
  (Comp as TControl).Hint := GetObjectPath(Comp);
 end;
 For I := 0 to comp.ComponentCount - 1 do begin
  SetPathAsHint(Comp.Components[I]);
 end;
end;

procedure TTutorialList.SET_TERMINATE(const Value: boolean);
begin
  fSetTerminate := Value;
  If value then begin
   proceed := true;
   waitfor := true;
  end;
end;

{ TtssProcedure }

constructor TtssProcedure.Create(ProcedureName: String; Owner: TTutorialList);
begin
 tssProcedure := Tstringlist.Create;
 fProcedureName := ProcedureName;
 Parent := Owner;
end;

procedure TtssProcedure.Run;
Var
 I: integer;
begin
 For I := 0 to tssProcedure.count - 1 do begin
  Parent.ExecuteScriptLine(tssProcedure[I]);
 end;
end;

{ TProcedureList }

function TProcedureList.Add(tssProcedureName: String): TtssProcedure;
begin
 Setlength(fList, Count + 1);
 fList[Count-1] := TtssProcedure.Create(tssProcedureName, Parent);
 Result := fList[Count-1];
end;

procedure TProcedureList.Clear;
begin
 Setlength(fList, 0);
end;

constructor TProcedureList.Create(Owner: TTutorialList);
begin
 Parent := owner;
end;

function TProcedureList.FindProcedure(tssProcedureName: String): TtssProcedure;
Var
 I: Integer;
begin
 Result := nil;
 For I := 0 to count - 1 do begin
  If uppercase(tssProcedureName) = uppercase(fList[I].Procedurename) then begin
   Result := fList[I];
  end;
 end;
end;

function TProcedureList.GETCOUNT: cardinal;
begin
 Result := length(fList);
end;

function TProcedureList.GETtssPROCEDURE(Index: Integer): TtssProcedure;
begin
 Result := fList[Index];
end;

{ TErrorHandlerList }

procedure TErrorHandlerList.Add(OnThis, RunThis: String);
begin
 Setlength(fList, count + 1);
 fList[count-1].OnError := OnThis;
 fList[Count-1].RunProcedure := RunThis;
end;

procedure TErrorHandlerList.CheckForAndRun(Error: String);
Var
 II, I: Integer;
begin
 For I := 0 to count - 1 do begin
  If uppercase(fList[I].OnError) = uppercase(Error) then begin
   For II := 0 to Parent.ProcedureList.Count -1 do begin
    If uppercase(PArent.ProcedureList[II].Procedurename) = uppercase(fList[I].RunProcedure) then begin
     Parent.ProcedureList[II].Run;
    end;
   end;
  end;
 end;
end;

procedure TErrorHandlerList.Clear;
begin
 SetLength(fList, 0);
end;

constructor TErrorHandlerList.create(Owner: TTutorialList);
begin
 Parent := Owner;
end;

function TErrorHandlerList.GETCOUNT: cardinal;
begin
 Result := Length(fList);
end;

function TErrorHandlerList.GETHANDLER(Index: Integer): TErrorHandler;
begin
 Result := fList[Index];
end;

end.
