Sordie.co.uk

libsassy/libSassy.Variant.pas

Raw

{(
 )) libSassy.Variant
((    Variant type data
 ))
((  Copyright  Sordie Aranka Solomon-Smith 2015-2016
 ))
((  This work is made available under the terms of the Creative Commons
 )) Attribution-NonCommercial-ShareAlike 3.0 Unported license
((  http://creativecommons.org/licenses/by-nc-sa/3.0/
 )}

unit libSassy.Variant;

interface

uses
  libSassy.Arrays;

type
  TVariantType = (vtInteger, vtFloat, vtString, vtBoolean, vtPointer, vtObject, vtMethod, vtTag);
  TTag = Byte;

{$REGION 'TVariant'}
  PVariant = ^TVariant;
  TVariant = record
    type
    TVariants = TArray<TVariant>;
    TVariantMethod = reference to function(Params: TVariants): TVariant;

    var
    fString: String;
    fMethod: TVariantMethod;

    class operator Implicit(Value: Integer):        TVariant;
    class operator Implicit(Value: Extended):       TVariant;
    class operator Implicit(Value: String):         TVariant;
    class operator Implicit(Value: Boolean):        TVariant;
    class operator Implicit(Value: Pointer):        TVariant;
    class operator Implicit(Value: TObject):        TVariant;
    class operator Implicit(Value: TVariantMethod): TVariant;
    class operator Implicit(Value: TTag):           TVariant;

    class operator Implicit(Value: TVariant): Integer;
    class operator Implicit(Value: TVariant): Extended;
    class operator Implicit(Value: TVariant): String;
    class operator Implicit(Value: TVariant): Boolean;
    class operator Implicit(Value: TVariant): Pointer;
    class operator Implicit(Value: TVariant): TObject;
    class operator Implicit(Value: TVariant): TVariantMethod;
    class operator Implicit(Value: TVariant): TTag;

    function Valid(v: array of TVariantType): Boolean;

  case Kind: TVariantType of
    vtInteger:   (fInteger: Integer);
    vtFloat:     (fFloat:   Extended);
    vtBoolean:   (fBoolean: Boolean);
    vtPointer:   (fPointer: Pointer);
    vtObject:    (fObject:  TObject);
    vtTag:       (fTag:     TTag);
  end;
{$ENDREGION}

{$REGION 'TNamedVariants'}
  TNamedVariants = TDictionary<TVariant>;
{$ENDREGION}

implementation

uses
  libSassy.Strings;

{$REGION 'TVariant'}
class operator TVariant.Implicit(Value: Integer): TVariant;
begin
  Result.fString  := '';
  Result.fMethod  := nil;
  Result.Kind     := vtInteger;
  Result.fInteger := Value;
end;

class operator TVariant.Implicit(Value: Extended): TVariant;
begin
  Result.fString := '';
  Result.fMethod := nil;
  Result.Kind    := vtFloat;
  Result.fFloat  := Value;
end;

class operator TVariant.Implicit(Value: String): TVariant;
begin
  Result.Kind    := vtString;
  Result.fMethod := nil;
  Result.fString := Value;
end;

class operator TVariant.Implicit(Value: Boolean): TVariant;
begin
  Result.fString  := '';
  Result.fMethod  := nil;
  Result.Kind     := vtBoolean;
  Result.fBoolean := Value;
end;

class operator TVariant.Implicit(Value: Pointer): TVariant;
begin
  Result.fString  := '';
  Result.fMethod  := nil;
  Result.Kind     := vtPointer;
  Result.fPointer := Value;
end;

class operator TVariant.Implicit(Value: TObject): TVariant;
begin
  Result.fString := '';
  Result.fMethod := nil;
  Result.Kind    := vtObject;
  Result.fObject := Value;
end;

class operator TVariant.Implicit(Value: TVariantMethod): TVariant;
begin
  Result.fString := '';
  Result.fMethod := Value;
  Result.Kind    := vtMethod;
end;

class operator TVariant.Implicit(Value: TTag): TVariant;
begin
  Result.fString := '';
  Result.fMethod := nil;
  Result.Kind    := vtTag;
  Result.fTag    := Value;
end;

class operator TVariant.Implicit(Value: TVariant): Integer;
begin
  with Value do
    case Kind of
      vtInteger: Result := fInteger;
      vtFloat:   Result := Round(fFloat);
      vtString:  Result := fString.AsInteger;
      vtBoolean: if fBoolean then Result := 1 else Result := 0;
      vtPointer: Result := Integer(fPointer);
      vtObject:  Result := Integer(fObject);
      vtTag:     Result := fTag;
    else
      Result := 0;
    end;
end;

class operator TVariant.Implicit(Value: TVariant): Extended;
begin
  with Value do
    case Kind of
      vtInteger: Result := fInteger;
      vtFloat:   Result := fFloat;
      vtString:  Result := fString.AsFloat;
      vtBoolean: if fBoolean then Result := 1 else Result := 0;
      vtPointer: Result := Integer(fPointer);
      vtObject:  Result := Integer(fObject);
      vtTag:     Result := fTag;
    else
      Result := 0;
    end;
end;

class operator TVariant.Implicit(Value: TVariant): String;
begin
  with Value do
    case Kind of
      vtInteger: Result := String.Int(fInteger);
      vtFloat:   Result := String.Float(fFloat);
      vtString:  Result := fString;
      vtBoolean: Result := String.Bool(fBoolean);
      vtPointer: Result := '0x' + String.Hex(Integer(fPointer), 8);
      vtObject:  Result := fObject.ClassName;
      vtTag:     Result := String.Int(fTag);
    else
      Result := '';
    end;
end;

class operator TVariant.Implicit(Value: TVariant): Boolean;
begin
  with Value do
    case Kind of
      vtInteger: Result := fInteger <> 0;
      vtFloat:   Result := fFloat <> 0;
      vtString:  Result := String.Bool(fString);
      vtBoolean: Result := fBoolean;
      vtPointer: Result := fPointer <> nil;
      vtObject:  Result := fObject <> nil;
      vtTag:     Result := fTag <> 0;
    else
      Result := False;
    end;
end;

class operator TVariant.Implicit(Value: TVariant): Pointer;
begin
  with Value do
    case Kind of
      vtInteger: Result := Pointer(fInteger);
      vtFloat:   Result := Pointer(trunc(fFloat));
      vtString:  Result := @fString[1];
      vtPointer: Result := fPointer;
      vtObject:  Result := fObject;
      vtMethod:  Result := @fMethod;
      vtTag:     Result := @fTag
    else
      Result := nil;
    end;
end;

class operator TVariant.Implicit(Value: TVariant): TObject;
begin
  with Value do
    case Kind of
      vtInteger: Result := Pointer(fInteger);
      vtFloat:   Result := Pointer(trunc(fFloat));
      vtString:  Result := @fString[1];
      vtPointer: Result := fPointer;
      vtObject:  Result := fObject;
      vtTag:     Result := @fTag;
    else
      Result := nil;
    end;
end;

class operator TVariant.Implicit(Value: TVariant): TVariantMethod;
begin
  with Value do
    case Kind of
      vtMethod: Result := fMethod;
    else
      Result := nil;
    end;
end;

class operator TVariant.Implicit(Value: TVariant): TTag;
begin
  with Value do
    case Kind of
      vtInteger: Result := fInteger;
      vtFloat:   Result := trunc(fFloat);
      vtString:  Result := String.Int(fString);
      vtPointer: Result := TTag(fPointer^);
      vtObject:  Result := TTag(fObject);
      vtTag:     Result := fTag;
    else
      Result := 0;
    end;
end;

function TVariant.Valid;
var
  i: Integer;
begin
  for i := low(v) to high(v) do
    if Kind = v[i] then exit(True);

  Result := False;
end;
{$ENDREGION}

end.