Sordie.co.uk

libsassy/libSassy.DateTime.pas

Raw

{(
 )) libSassy.DateTime
((    Date and time functions
 ))
((  Copyright  Sordie Aranka Solomon-Smith 2015-2017
 ))
((  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.DateTime;

interface

uses
  WinApi.Windows,
  WinApi.Messages,

  libSassy.Strings,
  libSassy.Tasks;

const
  MonthDays: array [Boolean, 0..11] of Word =
    ((31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31),
     (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31));

  HoursPerDay   = 24;
  MinsPerDay    = HoursPerDay * 60;
  SecsPerDay    = MinsPerDay  * 60;
  MSecsPerDay   = SecsPerDay  * 1000;

  SecsPerMin  = 60;
  SecsPerHour = SecsPerMin * 60;
  SecsPerWeek = SecsPerDay * 7;


  // Days between 1/1/0001 and 12/31/1899
  DateDelta = 693594;

  DayNames: array[Boolean, 0..6] of String[9] =  (('Sun',    'Mon',    'Tue',     'Wed',       'Thur',     'Fri',    'Sat'),
                                                  ('Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday'));

  MonthNames: array[Boolean, 1..12] of String[9] = (('Jan',     'Feb',      'Mar',   'Apr',   'May', 'June', 'July', 'Aug',    'Sept',      'Oct',     'Nov',      'Dec'),
                                                    ('January', 'February', 'March', 'April', 'May', 'June', 'July', 'August', 'September', 'October', 'November', 'December'));


type
{$REGION 'TSystemTimeHelper'}
  TSystemTimeHelper = record helper for TSystemTime
    function Format(f: String): String;
  end;
{$ENDREGION}

{$REGION 'TickService'}
  TickService = class abstract
  private
    class var fUsePerformanceCounter: Boolean;
    class var fTickScale: Extended;
  public
    class constructor Create;

    class function Seconds: Extended;

    class function  Sleep   (const Seconds: Extended; const ProcessMessages: Boolean = True): Extended;
    class procedure SysSleep(const Seconds: Extended; const Alertable: Boolean = False);

    class procedure TimeSlice(const JustYield: Boolean = False);
    class function ProcessMessages(const Wait: Boolean = False): UINT;

    class property UsingPerformanceCounter: Boolean read fUsePerformanceCounter;
    class property TickScale: Extended read fTickScale write fTickScale;
  end;

function GetTickCount64: Int64; stdcall; external kernel32;
function NtDelayExecution(Alertable: BOOL; Delay: PInt64): LONG; stdcall; external 'ntdll.dll';
{$ENDREGION}

{$REGION 'TStopwatch'}
type
  TStopwatch = record
    Start: Extended;

    procedure Reset; inline;

    function Elapsed: Extended; inline;

    function Split: Extended; inline;

    function Expired     (const Seconds: Extended): Boolean;  inline;
    function ExpiredDelta(const Seconds: Extended): Extended;

    function WaitFor(const Seconds: Extended; const ResetBefore: Boolean = True; const ResetAfter: Boolean = False; const ProcessMessages: Boolean = True): Extended;
  end;
{$ENDREGION}

{$REGION 'TScheduler'}
  TScheduler = class(TTask)
  private
    fTicksPerSec:       Integer;
    fTargetTicksPerSec: Integer;
    fTargetTimer:       TStopwatch;

    fTickCount: Integer;
    fTickTimer: TStopwatch;

    fDelta: Extended;

    fThrottle: Boolean;

    fRunning: Boolean;
  public
    constructor Create(ATargetTicksPerSec: Integer = 50);
    destructor  Destroy; override;

    procedure Reset; override;

    function Update(const Delta: Extended): Boolean; override;

    procedure CompleteTask(Task: TTask);
    procedure Stop; inline;

    property Delta: Extended read fDelta;

    property TicksPerSec:       Integer read fTicksPerSec;
    property TargetTicksPerSec: Integer read fTargetTicksPerSec write fTargetTicksPerSec;

    property Throttle: Boolean read fThrottle write fThrottle;

    property Running: Boolean read fRunning;
  end;
{$ENDREGION}

{$REGION 'Date/Time functions'}
function Now: TSystemTime; inline;

function IsLeapYear(Year: Word): Boolean;
function DaysPerMonth(Year, Month: Integer): Integer;

function SecondsToStr(const Seconds: Int64): String;
function StrToSeconds(const Str: String): Int64;
{$ENDREGION}

implementation

{$REGION 'TSystemTimeHelper'}
function TSystemTimeHelper.Format;
var
  s: String;
begin
  Result := f;

  Result := Result.Replace('%YYYY%', String.Int(wYear));
  Result := Result.Replace('%YY%',   String.Int(wYear).RAlign('0000').Copy(2, 2));
  Result := Result.Replace('%Y%',    String.Int(wYear));

  Result := Result.Replace('%MMMM%', String(MonthNames[True,  wMonth]));
  Result := Result.Replace('%MMM%',  String(MonthNames[False, wMonth]));
  Result := Result.Replace('%MM%',   String.Int(wMonth).RAlign('00'));
  Result := Result.Replace('%M%',    String.Int(wMonth));

  Result := Result.Replace('%DDDD%', String(DayNames[True,  wDayOfWeek]));
  Result := Result.Replace('%DDD%',  String(DayNames[False, wDayOfWeek]));
  Result := Result.Replace('%DD%',   String.Int(wDay).RAlign('00'));
  Result := Result.Replace('%D%',    String.Int(wDay));

  case wDay of
    1, 21, 31: s := 'st';
    2, 22:     s := 'nd';
    3, 23:     s := 'rd';
  else
    s := s + 'th';
  end;

  Result := Result.Replace('%DP%', s);

  Result := Result.Replace('%SS%',   String.Int(wSecond).RAlign('00'));
  Result := Result.Replace('%S%',    String.Int(wSecond));

  Result := Result.Replace('%MSS%', String.Int(wMilliseconds).RAlign('00'));
  Result := Result.Replace('%MS%', String.Int(wMilliseconds));

  Result := Result.Replace('%NN%',   String.Int(wMinute).RAlign('00'));
  Result := Result.Replace('%N%',    String.Int(wMinute));

  s := String.Int(wHour);
  Result := Result.Replace('%HHHH%', s.RAlign('00'));
  Result := Result.Replace('%HHH%',  s);

  if wHour > 12 then s := String.Int(wHour - 12);
  Result := Result.Replace('%HH%', s.RAlign('00'));
  Result := Result.Replace('%H%',  s);

  if wHour < 12 then s := 'am' else if (wHour = 12) and (wMinute = 30) then s := 'noon' else s := 'pm';
  Result := Result.Replace('%?M%', s);
end;
{$ENDREGION}

{$REGION 'TickService'}
class constructor TickService.Create;
var
  Frequency: Int64;
begin
  fUsePerformanceCounter := QueryPerformanceFrequency(Frequency);

  if fUsePerformanceCounter then
    fTickScale := 1 / Frequency
  else
    fTickScale := 0.001;
end;

class function TickService.Seconds;
var
  Tick: Int64;
begin
  if fUsePerformanceCounter then
    QueryPerformanceCounter(Tick)
  else
    Tick := GetTickCount64;

  Result := Tick * fTickScale;
end;

class function TickService.Sleep;
var
  Expires:   Extended;
  Processed: Boolean;
begin
  Expires := TickService.Seconds + Seconds;

  Processed := False;

  if Seconds = 0 then
    SysSleep(0)
  else
    while TickService.Seconds < Expires do
    begin
      if ProcessMessages then
      begin
        Processed := True;
        TickService.ProcessMessages(False);
      end;

      SysSleep((Expires - TickService.Seconds) * 0.5, True);
    end;

  if ProcessMessages and (not Processed) then
    TickService.ProcessMessages(False);

  Result := TickService.Seconds - (Expires - Seconds);
end;

class procedure TickService.SysSleep;
begin
  if Seconds <= 0 then
    //WinApi.Windows.Sleep(0)
    SwitchToThread
  else
    WinApi.Windows.SleepEx(round(Seconds * 1000), Alertable);
end;

class procedure TickService.TimeSlice;
const
  d: Int64 = -1;
begin
  if JustYield then
    //WinApi.Windows.Sleep(0)
    SwitchToThread
  else
    //WinApi.Windows.Sleep(1)
    NtDelayExecution(False, @d);
end;

class function TickService.ProcessMessages;
var
  Msg: TMsg;
begin
  if Wait then WaitMessage;

  Msg.message := 0;

  while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
  begin
    if Msg.message = WM_QUIT then break;

    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;

  Result := Msg.message;
end;
{$ENDREGION}

{$REGION 'TStopwatch'}
procedure TStopwatch.Reset;
begin
  Start := TickService.Seconds;
end;

function TStopwatch.Elapsed;
begin
  Result := TickService.Seconds - Start;
end;

function TStopwatch.Split;
begin
  Result := Elapsed;
  Reset;
end;

function TStopwatch.Expired;
begin
  Result := ExpiredDelta(Seconds) <= 0;
end;

function TStopwatch.ExpiredDelta;
begin
  Result := Seconds - Elapsed;
  if Result <= 0 then Reset;
end;

function TStopwatch.WaitFor;
begin
  if ResetBefore then Reset;

  if Seconds > 0 then
  begin
    TickService.Sleep(Seconds - Elapsed, ProcessMessages);

    Result := (Elapsed / Seconds);
  end
  else
    Result := 1;

  if ResetAfter then Reset;
end;
{$ENDREGION}

{$REGION 'TScheduler'}
constructor TScheduler.Create;
begin
  inherited Create;

  fTargetTicksPerSec := ATargetTicksPerSec;
  fThrottle := True;
end;

destructor TScheduler.Destroy;
begin
  Stop;

  inherited;
end;

procedure TScheduler.Reset;
begin
  fTicksPerSec := 0;
  fTickCount   := 0;
  fTickTimer.Reset;
  fTargetTimer.Reset;
  fDelta       := 0;
  Stop;
end;

const
  SchedulerSelfLoopFlag: Extended = ($5E1F) + (1 / $1009);

function TScheduler.Update;
begin
  if fThrottle then
    fDelta := fTargetTimer.WaitFor(1 / fTargetTicksPerSec, False, True)
  else
    fDelta := fTargetTicksPerSec * fTargetTimer.Split;

  inc(fTickCount);

  if fTickTimer.Elapsed >= 1 then
  begin
    fTicksPerSec := {ceil}trunc(fTickCount / fTickTimer.Split);
    fTickCount   := 0;
  end;

  Result := True;
end;

procedure TScheduler.CompleteTask;
begin
  if fRunning then exit;

  fRunning := True;

  try
    repeat
      Execute(SchedulerSelfLoopFlag);
    until (not Task.Execute(fDelta)) or (not fRunning);
  finally
    fRunning := False;
  end;
end;

procedure TScheduler.Stop;
begin
  fRunning := False;
end;
{$ENDREGION}

{$REGION 'Date/Time functions'}
function Now;
begin
  GetLocalTime(Result);
end;

function IsLeapYear;
begin
  Result := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));
end;

function DaysPerMonth;
begin
  Result := MonthDays[False, Month];
  if (Month = 2) and IsLeapYear(Year) then Inc(Result);
end;

function SecondsToStr;
var
  w, d, h, m, s: Int64;
begin
  Result := '';
  w := 0;
  d := 0;
  h := 0;
  m := 0;
  s := Seconds;

  while s >= 60 do
  begin
    inc(m);
    dec(s, 60);
  end;

  while m >= 60 do
  begin
    inc(h);
    dec(m, 60);
  end;

  while h >= 24 do
  begin
    inc(d);
    dec(h, 24);
  end;

  while d >= 7 do
  begin
    inc(w);
    dec(d, 7);
  end;

  if w > 0 then Result := String.Int(w) + 'w';
  if d > 0 then Result := Result.AddSep(String.Int(d) + 'd');
  if h > 0 then Result := Result.AddSep(String.Int(h) + 'h');
  if m > 0 then Result := Result.AddSep(String.Int(m) + 'm');
  if s > 0 then Result := Result.AddSep(String.Int(s) + 's');
end;

function StrToSeconds;
var
  s, v, n: String;
begin
  Result := 0;
  s := Str.Lowercase;
  s := s.Replace('s', 's ');
  s := s.Replace('m', 'm ');
  s := s.Replace('h', 'h ');
  s := s.Replace('d', 'd ');
  s := s.Replace('w', 'w ');

  while not S.Empty do
  begin
    v := S.SplitToken;
    if not v.ValidChars('0123456789') then Exit(-1);

    n := S.SplitToken;

         if n = 's' then Result := Result +  v.AsInteger
    else if n = 'm' then Result := Result + (v.AsInteger * SecsPerMin)
    else if n = 'h' then Result := Result + (v.AsInteger * SecsPerHour)
    else if n = 'd' then Result := Result + (v.AsInteger * SecsPerDay)
    else if n = 'w' then Result := Result + (v.AsInteger * SecsPerWeek)
    else Exit(-1);
  end;
end;
{$ENDREGION}

end.