////////////////////////////////////////////////////////////////////////////////
// CM2PlugInTypes.pas
// -------------------
// This unit contains plugin system routines for CoolMon 2.
//
// Last Edit: September 11th 2019
// Certified: NA
//
// This unit is coded in : Delphi 7
//
// Unit is copyright (c) 2003 - 2019, The CoolMon Project
////////////////////////////////////////////////////////////////////////////////
//
// What's new
//
// Engine Version 1.0.0.0
//  * Added ElevatedExecution.pas to Engine Package
//  * Bump version number for Win10 Release
//
// Engine Version 0.8.6.0
//  * Added GDI+ support for main program (Core number still needs revision)
//
// Engine Version 0.8.5.0
//  * Added Editor Support Vis 20 Interface
//
// { Progress between 0.8.2.1 --> 0.8.5.0 not logged}
//
// Engine Version 0.8.2.1
//  * Visual Object List Parent changed from TForm to TWinControl
//
// { Progress between 0.7.6.0 --> 0.8.2.1 not logged}
//
// Engine Version 0.7.6.0
//  * Event system bug corrected
//
// Engine Version 0.7.5.1
//  * CMLx Perform will now utilize GetLastErrorMsg Function
//
// Engine Version 0.7.5.0
//  * Upgraded to CML1.3
//  * Added CM2CMLxPlug2 interface, allows for long strings
//
// Engine Version 0.7.0.0
//  * CM2Form jumps back to original location after screen resolution change
//  * CMLx now fully implemented (Still experimental though)
//  * Text tags containing a space will now actually contain the space
//  * Doubleclick now possible as event
//
// Engine Version 0.6.1.0
// * GDI+ Support implemented
//
// Engine Version 0.6.0.0
// * Event Support
//
// Engine Version 0.5.1.0
// * Verbose window has been changed to accomodate realtime debug level
//   changing
// * CML tree will no longer resolve comment tags
//
////////////////////////////////////////////////////////////////////////////////


{$D+}
unit CM2PlugInTypes;

interface

Uses
  SysUtils,
  Classes,
  Verbose;

Const
 CoreVersion = 1000;
 OutdatedCoreVersion = 0299;
 CertifiedGENPluginsLocation = '\software\The CoolMon Project\CertifiedPlugins\General';
 CertifiedVISPluginsLocation = '\software\The CoolMon Project\CertifiedPlugins\Visual';
 CertifiedCMLXPlugInsLocation = '\software\The CoolMon Project\CertifiedPlugins\CMLX';
 ReservedWordList: array [0 .. 11] of string = ('CML', 'DISPLAY', 'FORM', 'VISUAL', 'SENSOR',
    'PARAMETERS', 'CONTENT', 'TEXT', 'EVENTS', 'EVENTHANDLER', 'ACTION', '#TEXT');
 // TSensorStyle
 ssNumeric = 0;
 ssNonNumeric = 1;
 ssUnknown = 2;

Var
 UseSafeMode: Boolean = True;
 CoolStartUp: Boolean = False;
 Debug: Boolean = false;
 SilentDebug: Boolean = false;

Type
 EDllError = Class(Exception); // Exception used when DLL loading is causing trouble
 EOutOfBounds = Class(Exception); // Exception used to inform about wrong list reference
 EVersionError = Class(Exception); // Indicates version conflict
 TPlugInListProgress = Procedure(PlugName: String; Loaded: Integer; Total: Integer) of object;
 TInfo = Record                                                                 // Enables us to append name and other types of data to the sensor system (works like the FileVersion system in windows)
  VarName: String;                                                              // Variable Name
  Variable: String;                                                             // Variable Result
 End;
 TExInfoType = (eitRequired, eitOptional);
 TExInfo = Record
  Name: String;
  Value: String;
  Description: String;
  EIT: TExInfoType;
 End;
 TResult = record
  SensorStyle: Byte;
  Name: String;
  Str: String;
  Value: Double;
 End;
 TResultList = Class(TObject)                                                      // Multiple Results
  private
   fResultList: Array of TResult;                                                     // The actual list
   function GetCount: Integer;
    function GetRes(Index: Integer): TResult;
    procedure SetRes(Index: Integer; const Value: TResult);                        // Return the length of the list
  public
   Procedure Add(Res: TResult);                                                    // Add a record
   Procedure Delete(Index: Integer);                                            // Delete a specific record
   Property Res[Index: Integer]: TResult read GetRes write SetRes; Default;
   Property Count: Integer read GetCount;                                       // Return the length of the list
 end;
 TInfoList = Class(TObject)                                                     // Multiple Info
  private
   fInfoList: Array of TInfo;                                                   // The actual list
   function GetCount: Integer;
    function GetInfo(Index: Integer): TInfo;
    procedure SetInfo(Index: Integer; const Value: TInfo);
  public
   Procedure Add(Info: TInfo); overload;                                        // Add a Info record the the list
   Procedure Add(VarName, Variable: String); Overload;                          // Add a Info, via 2 strings
   Procedure Delete(Index: Integer);                                            // Delete a specific Info record
   Property Info[Index: Integer]: TInfo read GetInfo write SetInfo; Default;
   Property Count: Integer read GetCount;                                       // Returns the length of the lsit
   Function Query(Const InfoName: String; Var InfoVar: String): Boolean;
 end;
 TExInfoList = Class(TObject)
 private
  flist: Array of TExInfo;
  function GetCount: Integer;
  function GetExInfo(Index: Integer): TExInfo;
  procedure SetExInfo(Index: Integer; const Value: TExInfo);
 public
  Procedure Add(Name, Value, Description: String; EIT: TExInfoType);
  Property ExInfo[Index: Integer]: TExInfo read GetExInfo write SetExInfo; Default;
  Property Count: Integer read GetCount;
 end;
 TOnEventList = Class(TObject)
 private
  fList: Array of TNotifyEvent;
  Parent: TObject;
  function GetCount: Integer;
  function GetEvent(Index: Integer): TNotifyEvent;
  procedure SetEvent(Index: Integer; const Value: TNotifyEvent);
 public
  Constructor Create(aParent: TObject);
  Procedure Add(Event: TNotifyEvent);
  Procedure Delete(Event: TNotifyEvent);
  Property Event[Index: Integer]: TNotifyEvent read GetEvent write SetEvent; default;
  Property Count: Integer read GetCount;
  Procedure Trigger;
 End;
 TEventType = (etUnknown, etDblClick, etMouseDownLeft, etMouseDownMiddle,
                etMouseDownRight, etMouseUpLeft, etMouseUpMiddle, etMouseUpRight,
                 etMouseWheelAny, etMouseWheelUp, etMouseWheelDown,
                  etMouseMove);
 TModifierKeyState = (mksUnknown, mksNone, mksShift, mksAlt, mksCtrl, mksAltShift, mksAltCtrl, mksCtrlShift, mksAltCtrlShift, mksAny);
 TTrigger = Record
  EventType: TEventType;
  ModKeys: TModifierKeyState;
  Execute: String;
  Parameters: String;
  VisualTarget: String;
 End;
 PTrigger = ^TTrigger;
 TTriggerList = Class(TObject)
 private
  fList: Array of TTrigger;
  function GET_TRIGGER(Index: Integer): TTrigger;
  function GETCOUNT: Integer;
  procedure SET_TRIGGER(Index: Integer; const Value: TTrigger);
 public
  Function Add(et: TEventType; ModifierKey: TModifierKeyState; Execute: String; Parameters: String; VisualTarget: String): PTrigger;
  Procedure Delete(Index: Integer);
  Property Trigger[Index: Integer]: TTrigger read GET_TRIGGER write SET_TRIGGER; default;
  Property Count: Integer read GETCOUNT;
 End;

implementation

{ TInfoList }

procedure TInfoList.Add(Info: TInfo);
Var
 Index: Integer;
begin
 SetLength(Self.fInfoList, Length(Self.fInfoList) + 1);
 Index := Length(Self.fInfoList) - 1;
 Self.fInfoList[Index] := Info;
end;

procedure TInfoList.Add(VarName, Variable: String);
Var
 Index: Integer;
begin
 SetLength(Self.fInfoList, Length(Self.fInfoList) + 1);
 Index := Length(Self.fInfoList) - 1;
 Self.fInfoList[Index].VarName := VarName;
 Self.fInfoList[Index].Variable := Variable;
end;

procedure TInfoList.Delete(Index: Integer);
Var
 I: Integer;
begin
 If (Index < 0) or (Index > Length(fInfoList) - 1) Then
  Raise EOutOfBounds.Create('TInfo List Error - Index out of bounds');
 For I := Index to Length(fInfoList) - 2 do begin
  fInfoList[I] := fInfoList[I + 1];
 End;
 SetLength(fInfoList, Length(fInfoList) - 1);
end;

function TInfoList.GetCount: Integer;
begin
 Result := Length(fInfoList);
end;

function TInfoList.GetInfo(Index: Integer): TInfo;
begin
 Result := fInfoList[Index];
end;

function TInfoList.Query(const InfoName: String;
  var InfoVar: String): Boolean;
Var
 I: Integer;
begin
 Result := False;
 For I := 0 to Self.Count - 1 do begin
  If uppercase(InfoName) = Uppercase(Self.Info[I].VarName) Then begin
   Result := True;
   InfoVar := Self.Info[I].Variable;
   Exit;
  end;
 end;
end;

procedure TInfoList.SetInfo(Index: Integer; const Value: TInfo);
begin
 fInfoList[Index] := Value;
end;

{ TResultList }

procedure TResultList.Add(Res: TResult);
Var
 Index: Integer;
begin
 SetLength(Self.fResultList, Length(Self.fResultList) + 1);
 Index := Length(Self.fResultList) - 1;
 Self.fResultList[Index] := Res;
end;

procedure TResultList.Delete(Index: Integer);
Var
 I: Integer;
begin
 If (Index < 0) or (Index > Length(fResultList) - 1) Then
  Raise EOutOfBounds.Create('TResult List Error - Index out of bounds');
 For I := Index to Length(fResultList) - 2 do begin
  fResultList[I] := fResultList[I + 1];
 End;
 SetLength(fResultList, Length(fResultList) - 1);
end;

function TResultList.GetCount: Integer;
begin
 Result := Length(fResultList);
end;

function TResultList.GetRes(Index: Integer): TResult;
begin
 Result := fResultList[Index];
end;

procedure TResultList.SetRes(Index: Integer; const Value: TResult);
begin
 fResultList[Index] := Value;
end;

{ TOnEventList }

procedure TOnEventList.Add(Event: TNotifyEvent);
begin
 If Debug Then Form4.Add('Adding Event [$' + IntToStr(Cardinal(@Event)) + ']', dlcore);
 {
 For I := 0 to length(fList) - 1 do begin
  If @fList[I] = @Event then exit; // is this correct ?
 End;
 }
 SetLength(fList, Length(fList) + 1);
 fList[Length(fList)-1] := Event;
end;

constructor TOnEventList.Create(aParent: TObject);
begin
 Parent := aParent;
end;

procedure TOnEventList.Delete(Event: TNotifyEvent);
Var
 Sel, I: Integer;
begin
 Sel := -1;
 For I := 0 to Length(fList) - 1 do begin
  If addr(fList[I]) = addr(event) then begin
   Sel := I;
   break;
  end;
 end;
 If Sel = -1 then exit;
 For I := Sel to Count - 2 do begin
  fList[I] := fList[I + 1];
 end;
 SetLength(fList, length(fList) - 1);
end;

function TOnEventList.GetCount: Integer;
begin
 Result := length(fList);
end;

function TOnEventList.GetEvent(Index: Integer): TNotifyEvent;
begin
 If (index < 0) or (Index >= length(fList)) then raise EOutOfBounds.Create('TOnEventList.GetEvent index is out of bounds');
 Result := fList[Index];
end;

procedure TOnEventList.SetEvent(Index: Integer; const Value: TNotifyEvent);
begin
 If (index < 0) or (Index >= length(fList)) then raise EOutOfBounds.Create('TOnEventList.GetEvent index is out of bounds');
 fList[Index] := Value;
end;

procedure TOnEventList.Trigger;
Var
 I: Integer;
begin
 For I := 0 to count-1 do begin
  If Assigned(fList[I]) Then Begin
   If Debug Then Form4.Add('Triggering Event [$' + IntToStr(Cardinal(@fList[I])) + ']', dlcore);
   fList[I](Parent);
  End;
 End;
end;

{ TExInfoList }

procedure TExInfoList.Add(Name, Value, Description: String;
  EIT: TExInfoType);
begin
 SetLength(fList, Length(fList) + 1);
 fList[Length(fList)-1].Name := Name;
 fList[Length(fList)-1].Value := Value;
 fList[Length(fList)-1].Description := Description;
 fList[Length(fList)-1].EIT := EIT;
end;

function TExInfoList.GetCount: Integer;
begin
 Result := Length(fList);
end;

function TExInfoList.GetExInfo(Index: Integer): TExInfo;
begin
 Result := fList[Index];
end;

procedure TExInfoList.SetExInfo(Index: Integer; const Value: TExInfo);
begin
 fList[Index] := Value;
end;

{ TTriggerList }

function TTriggerList.Add(et: TEventType; ModifierKey: TModifierKeyState;
  Execute: String; Parameters: String; VisualTarget: String): PTrigger;
begin
 SetLength(fList, length(fList) + 1);
 fList[Length(fList)-1].EventType := et;
 fList[Length(fList)-1].ModKeys := ModifierKey;
 fList[Length(fList)-1].Execute := Execute;
 fList[Length(fList)-1].Parameters := Parameters;
 fList[Length(fList)-1].VisualTarget := VisualTarget;
 Result := Addr(fList[Length(fList)-1]);
end;

procedure TTriggerList.Delete(Index: Integer);
Var
 I: Integer;
begin
 If (Index < 0) or (Index >= Count) then exit;
 For I := Index to Count - 2 do begin
  fList[I] := fList[I+1];
 end;
 SetLength(fList, length(fList) - 1);
end;

function TTriggerList.GET_TRIGGER(Index: Integer): TTrigger;
begin
 Result := fList[Index];
end;

function TTriggerList.GETCOUNT: Integer;
begin
 Result := length(fList);
end;

procedure TTriggerList.SET_TRIGGER(Index: Integer; const Value: TTrigger);
begin
 fList[Index] := Value;
end;

end.
