A3DGE Code

unit a3dge.Classes;
(*< Implements some utility classes. *)
(* Copyright (c) 2012, 2025 Guillermo Martínez Jiménez.

This software is provided 'as-is', without any express or implied
warranty. In no event will the authors be held liable for any damages
arising from the use of this software.

Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:

    1. The origin of this software must not be misrepresented; you must not
    claim that you wrote the original software. If you use this software
    in a product, an acknowledgment in the product documentation would be
    appreciated but is not required.

    2. Altered source versions must be plainly marked as such, and must not be
    misrepresented as being the original software.

    3. This notice may not be removed or altered from any source
    distribution.
 *)

{$Include a3dge.cfg}

interface

  uses
    Classes, sysutils;

  type
  (* Base class for exceptions raised by the engine.

     This class will try to log the exception using
     @link(TA3DGEApplication.Log).
   *)
    A3DGEException = class (Exception)
    private
      procedure LogException;
    public
    (* Constructs a new exception object with a given message. *)
      constructor Create (const aMsg: String);
    (* Constructs a new exception object and formats a new message. *)
      constructor CreateFmt (const aMsg: string; const aArgs: array of const);
    end;



  (* Base class for states. *)
    TState = class (TObject)
    private
      fName: AnsiString;
    protected
    (* Sets name. *)
      procedure SetName (const aValue: AnsiString); virtual;
    public
    (* Constructor. *)
      constructor Create; virtual;
    (* Prepare the state to be used. *)
      procedure Enter (aEntity: TObject); virtual;
    (* Execute state. *)
      procedure Update (aEntity: TObject); virtual; abstract;
    (* Clean state after using it. *)
      procedure Leave (aEntity: TObject); virtual;

    (* State name. *)
      property Name: AnsiString read fName write SetName;
    end;



  (* A @italic(State Machine) implementation. *)
    TStateMachine = class (TObject)
    private
      fNextState, fCurrentState, fPreviousState,
      fNextGlobalState, fGlobalState: TState;

      procedure SetCurrentState (aState: TState);
      procedure SetGlobalState (aState: TState);
    public
    (* Execute @link(Current) and @link(Global) states. *)
      procedure Update (aEntity: TObject);
    (* Swap between @link(Current) and previous states. *)
      procedure SwapPreviousState;

    (* Current state. *)
      property Current: TState read fCurrentState write SetCurrentState;
    (* If assigned, it will be executed every time along with @link(Current). *)
      property Global: TState read fGlobalState write SetGlobalState;
    end;

implementation

  uses
    al5strings,
    a3dge;

(*
 * A3DGEException
 ************************************************************************)

  procedure A3DGEException.LogException;
  begin
    if Assigned (a3dge.Application)
       and Assigned (a3dge.Application.Log)
    then
      a3dge.Application.Log.Trace (
        etError,
        al_string_to_str (Self.Message)
      )
  end;



  constructor A3DGEException.Create (const aMsg: String);
  begin
    inherited Create (aMsg);
    Self.LogException
  end;



  constructor A3DGEException.CreateFmt (
    const aMsg: string;
    const aArgs: array of const
  );
  begin
    inherited CreateFmt (aMsg, aArgs);
    Self.LogException
  end;



(*
 * TState
 ************************************************************************)

  procedure TState.SetName (const aValue: AnsiString);
  begin
    fName := aValue
  end;



  constructor TState.Create;
  begin
    inherited Create
  end;



{$PUSH}
  {$WARN 5024 OFF : Parameter "$1" not used}
  procedure TState.Enter (aEntity: TObject);
  begin
    { Does nothing. } ;
  end;



  procedure TState.Leave(aEntity: TObject);
  begin
    { Does nothing. } ;
  end;
{$POP}



(*
 * TStateMachine
 ************************************************************************)

  procedure TStateMachine.SetCurrentState (aState: TState);
  begin
    if not Assigned (aState) then
      a3dge.Application.Log.Trace (etWarning, 'Trying to set Null state!');
    fNextState := aState
  end;



  procedure TStateMachine.SetGlobalState (aState: TState);
  begin
    if aState = fCurrentState then
      raise A3DGEException.CreateFmt (
        'Current and Global states cannot be the same ("%s")',
        [aState.Name]
      );
    fNextGlobalState := aState
  end;



  procedure TStateMachine.Update (aEntity: TObject);
  begin
  { Check if states changed. }
    if Assigned (fNextGlobalState) and (fNextGlobalState <> fGlobalState) then
    begin
      if Assigned (fGlobalState) then
        fGlobalState.Leave (aEntity);
      fGlobalState := fNextGlobalState;
      fNextGlobalState := Nil;
      if Assigned (fGlobalState) then
        fGlobalState.Enter (aEntity)
    end;
    if Assigned (fNextState) and (fNextState <> fCurrentState) then
    begin
      if Assigned (fCurrentState) then
        fCurrentState.Leave (aEntity);
      fPreviousState := fCurrentState;
      fCurrentState := fNextState;
      fNextState := Nil;
      if Assigned (fCurrentState) then
        fCurrentState.Enter (aEntity)
    end;
  { State should be assigned. }
    if not Assigned (fCurrentState) then
      raise A3DGEException.Create ('No state assigned!');
  { Run states. }
    if Assigned (fGlobalState) then
      fGlobalState.Update (aEntity);
    fCurrentState.Update (aEntity)
  end;



  procedure TStateMachine.SwapPreviousState;
  begin
    Self.SetCurrentState (fPreviousState)
  end;

end.