* Add timer API and demo

packages/wasm-utils/demo/README.md

@@ -1,15 +1,17 @@
 # Assorted Webassembly utility routine demos
 
-For the HTTP and Websocket demos, you need also the corresponding host application
-which will load the demo and provide the needed APIs
+For the Timer, HTTP and Websocket demos, you need also the corresponding host application
+which will load the demo and provide the needed APIs.
 
 They are contained in the Pas2JS demos under 
 ```
+demos/wasienv/timer
+```
+for the timer host, the http host is located under
+```
 demos/wasienv/wasm-http 
 ```
-
-and
-
+and the websocket host is in
 ```
 demos/wasienv/wasm-websocket
 ```

packages/wasm-utils/demo/timer/timerdemo.lpi

@@ -0,0 +1,66 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="Webassembly timer demo"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <Units>
+      <Unit>
+        <Filename Value="timerdemo.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="../../src/wasm.timer.objects.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="timerdemo.wasm" ApplyConventions="False"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../../src"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Options>
+        <ExecutableType Value="Library"/>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/wasm-utils/demo/timer/timerdemo.pp

@@ -0,0 +1,52 @@
+library timerdemo;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}
+  cthreads,
+  {$ENDIF}
+  SysUtils, Classes, wasm.timer.shared, wasm.timer.api, wasm.logger.api, wasm.timer.objects, wasm.http.api;
+
+Type
+
+  { TTestTimer }
+
+  TTestTimer = class(TObject)
+     FTimer1 : TWasmTimer;
+     FTimer2 : TTimer;
+     Fcount : Integer;
+     Procedure Run;
+  private
+    procedure DoTimerTick(Sender: TObject);
+  end;
+
+{ TTestTimer }
+
+procedure TTestTimer.Run;
+begin
+  Writeln('Creating timers');
+  FTimer1:=TWasmTimer.Create(1000,@DotimerTick,Self);
+  FTimer2:=TTimer.Create(Nil);
+  FTimer2.Interval:=3000;
+  FTimer2.OnTimer:=@DoTimerTick;
+  FTimer2.Enabled:=True;
+end;
+
+procedure TTestTimer.DoTimerTick(Sender: TObject);
+begin
+  Inc(FCount);
+  Writeln('Timer tick ',FCount,':  sender: ',Sender.ClassName);
+  if FCount>=33 then
+    begin
+    Writeln('Stopping timers');
+    FreeAndNil(FTimer1);
+    FreeAndNil(FTimer2);
+    end;
+end;
+
+begin
+  With TTestTimer.Create do
+    Run;
+end.
+

packages/wasm-utils/fpmake.pp

@@ -25,9 +25,21 @@ begin
     P.OSes:=[wasi];
     P.CPUs:=[wasm32];
     P.SourcePath.Add('src');
+    // Logger
+    T:=P.Targets.AddUnit('wasm.logger.api.pas');
     
+    // Timer
+    T:=P.Targets.AddUnit('wasm.timer.shared.pas');
+    T:=P.Targets.AddUnit('wasm.timer.api.pas');
+      T.Dependencies.AddUnit('wasm.timer.shared');
+      T.Dependencies.AddUnit('wasm.logger.api');
+    T:=P.Targets.AddUnit('wasm.timer.objects.pas');
+      T.Dependencies.AddUnit('wasm.timer.api');
+      T.Dependencies.AddUnit('wasm.logger.api');
+      
+    // HTTP
     T:=P.Targets.AddUnit('wasm.http.shared.pas');
-    
+
     T:=P.Targets.AddUnit('wasm.http.api.pas');
       T.Dependencies.AddUnit('wasm.http.shared');
       
@@ -35,15 +47,20 @@ begin
       T.Dependencies.AddUnit('wasm.http.api');
       T.Dependencies.AddUnit('wasm.http.shared');
 
+    // Websocket
     T:=P.Targets.AddUnit('wasm.websocket.shared.pas');
+    
     T:=P.Targets.AddUnit('wasm.websocket.api.pas');
       T.Dependencies.AddUnit('wasm.websocket.shared');
+      T.Dependencies.AddUnit('wasm.timer.api');
       
     T:=P.Targets.AddUnit('wasm.websocket.objects.pas');
       T.Dependencies.AddUnit('wasm.websocket.api');
       T.Dependencies.AddUnit('wasm.websocket.shared');
-      
+    
+    // Regexp  
     T:=P.Targets.AddUnit('wasm.regexp.shared.pas');
+    
     T:=P.Targets.AddUnit('wasm.regexp.api.pas');
       T.Dependencies.AddUnit('wasm.regexp.shared');
       

packages/wasm-utils/src/wasm.http.api.pas

@@ -19,12 +19,21 @@ unit wasm.http.api;
 
 interface
 
-uses wasm.http.shared;
+uses wasm.http.shared, wasm.logger.api;
 
 Type
-  TWasmHTTPLogLevel = (hllTrace, hllDebug, hllInfo, hllWarning, hllError, hllCritical);
-  TWasmHTTPLogLevels = set of TWasmHTTPLogLevel;
+  TWasmHTTPLogLevel = TWasmLogLevel;
+  TWasmHTTPLogLevels = TWasmLogLevels;
 
+const
+  hllTrace    = wllTrace;
+  hllDebug    = wllDebug;
+  hllInfo     = wllInfo;
+  hllWarning  = wllWarning;
+  hllError    = wllError;
+  hllCritical = wllCritical;
+
+Type
   TWasmString = record
     Data : PAnsiChar;
     Len : Longint;
@@ -58,7 +67,7 @@ Type
 
   TWasmHTTPResponseEvent    = procedure(aRequestID : Longint; aUserData : Pointer; aStatus : TWasmHTTPResponseStatus; var Deallocate : Boolean) of object;
   TWasmHTTPResponseCallback = procedure(aRequestID : Longint; aUserData : Pointer; aStatus : TWasmHTTPResponseStatus; var Deallocate : Boolean);
-  TWasmHTTPLogHook = procedure (Level : TWasmHTTPLogLevel; const Msg : string) of object;
+  TWasmHTTPLogHook = TWasmLogHook;
 
 function __wasmhttp_request_allocate(aRequest : PWasmHTTPAPIRequest; aUserData : Pointer; aRequestID : PWasmHTTPRequestID) : TWasmHTTPResult; external httpExportName name httpFN_RequestAllocate;
 function __wasmhttp_request_execute(aRequestID : TWasmHTTPRequestID) : TWasmHTTPResult; external httpExportName name httpFN_RequestExecute;
@@ -81,7 +90,7 @@ procedure __wasmhttp_log(level : TWasmHTTPLogLevel; const Fmt : String; Args : A
 var
   OnWasmHTTPResponse : TWasmHTTPResponseEvent;
   WasmHTTPResponseCallback : TWasmHTTPResponseCallback;
-  OnWasmHTTPLog : TWasmHTTPLogHook;
+  EnableWasmHTTPLog : Boolean;
 
 implementation
 
@@ -94,15 +103,17 @@ uses sysutils;
 procedure __wasmhttp_log(level : TWasmHTTPLogLevel; const Msg : String);
 
 begin
-  If assigned(OnWasmHTTPLog) then
-    OnWasmHTTPLog(level,Msg);
+  if not EnableWasmHTTPLog then
+    exit;
+  __wasm_log(level,'HTTP',Msg);
 end;
 
 procedure __wasmhttp_log(level : TWasmHTTPLogLevel; const Fmt : String; Args : Array of const);
 
 begin
-  If assigned(OnWasmHTTPLog) then
-    OnWasmHTTPLog(level,SafeFormat(Fmt,Args));
+  if not EnableWasmHTTPLog then
+    exit;
+  __wasm_log(level,'HTTP',Fmt,Args);
 end;
 
 function __wasmhttp_response_callback(aRequestID : TWasmHTTPRequestID; aUserData : Pointer; aStatus : TWasmHTTPResponseStatus) : TWasmHTTPResponseResult;

packages/wasm-utils/src/wasm.logger.api.pas

@@ -0,0 +1,66 @@
+{
+    This file is part of the Free Component Library
+
+    Webassembly centralized utility logging API.
+    Copyright (c) 2024 by Michael Van Canneyt michael@freepascal.org
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit wasm.logger.api;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  {$IFDEF FPC_DOTTEDUNITS}
+  System.SysUtils;
+  {$ELSE}
+  SysUtils;
+  {$ENDIF}
+
+Type
+  TWasmLogLevel = (wllTrace, wllDebug, wllInfo, wllWarning, wllError, wllCritical);
+  TWasmLogLevels = set of TWasmLogLevel;
+
+  TWasmLogHook = procedure (Level : TWasmLogLevel; const Msg : string) of object;
+
+Const
+  AllLogLevels = [Low(TWasmLogLevel)..High(TWasmLogLevel)];
+
+var
+  OnWasmLog : TWasmLogHook;
+  WasmLogLevels : TWasmLogLevels = AllLogLevels;
+
+procedure __wasm_log(level : TWasmLogLevel; const Module, Msg : String);
+procedure __wasm_log(level : TWasmLogLevel; const Module, Fmt : String; Args : Array of const);
+
+implementation
+
+procedure __wasm_log(level : TWasmLogLevel; const Module, Msg : String);
+
+begin
+  if not (level in WasmLogLevels) then
+    exit;
+  if not Assigned(OnWasmLog) then
+    exit;
+  OnWasmLog(level,'['+Module+'] '+Msg);
+end;
+
+procedure __wasm_log(level : TWasmLogLevel; const Module, Fmt : String; Args : Array of const);
+
+begin
+  if not (level in WasmLogLevels) then
+    exit;
+  __wasm_log(level,Module,SafeFormat(Fmt,Args));
+end;
+
+end.
+

packages/wasm-utils/src/wasm.timer.api.pas

@@ -0,0 +1,74 @@
+{
+    This file is part of the Free Component Library
+
+    Webassembly Timer API - imported functions and structures.
+    Copyright (c) 2024 by Michael Van Canneyt michael@freepascal.org
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit wasm.timer.api;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  {$IFDEF FPC_DOTTEDUNITS}
+  System.SysUtils,
+  {$ELSE}
+  SysUtils,
+  {$ENDIF}
+  wasm.logger.api, wasm.timer.shared;
+
+Type
+  TWasmTimerTickEvent = Procedure (aTimerID : TWasmTimerID; userdata : pointer; var aContinue : Boolean);
+
+function __wasm_timer_allocate(ainterval : longint; userdata: pointer) : TWasmTimerID; external TimerExportName name TimerFN_allocate;
+
+procedure __wasm_timer_deallocate(timerid: TWasmTimerID); external TimerExportName name TimerFN_Deallocate;
+
+function __wasm_timer_tick(timerid: TWasmTimerID; userdata : pointer) : boolean;
+
+procedure __wasmtimer_log(level : TWasmLogLevel; const Msg : String);
+procedure __wasmtimer_log(level : TWasmLogLevel; const Fmt : String; Args : Array of const);
+
+var
+  OnWasmTimerTick : TWasmTimerTickEvent;
+  WasmTimerLogEnabled : Boolean;
+
+implementation
+
+function __wasm_timer_tick(timerid: TWasmTimerID; userdata : pointer) : boolean;
+
+begin
+  Result:=True;
+  if assigned(OnWasmTimerTick) then
+    OnWasmTimerTick(timerid,userdata,Result)
+  else
+    Result:=False;
+end;
+
+procedure __wasmtimer_log(level : TWasmLogLevel; const Msg : String);
+begin
+  if not WasmTimerLogEnabled then
+    exit;
+  __wasm_log(level,'timer',msg);
+end;
+
+procedure __wasmtimer_log(level : TWasmLogLevel; const Fmt : String; Args : Array of const);
+begin
+  if not WasmTimerLogEnabled then
+    exit;
+  __wasm_log(level,'timer',fmt,args);
+end;
+
+exports __wasm_timer_tick;
+
+end.
+

packages/wasm-utils/src/wasm.timer.objects.pas

@@ -0,0 +1,175 @@
+{
+    This file is part of the Free Component Library
+
+    Webassembly Timer API - Objects layer.
+    Copyright (c) 2024 by Michael Van Canneyt michael@freepascal.org
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit wasm.timer.objects;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+{$IFDEF FPC_DOTTEDUNITS}
+  System.Classes, System.SysUtils,
+{$ELSE}
+  Classes, SysUtils,
+{$ENDIF}
+  wasm.timer.api, wasm.timer.shared;
+
+{ TTimer }
+Type
+  EWasmTimer = Class(Exception);
+
+  { TWasmTimer }
+
+  TWasmTimer = Class(TObject)
+  Private
+    FOnTimer : TNotifyEvent;
+    FSender : TObject;
+    FID : TWasmTimerID;
+    FInterval : Integer;
+  Public
+    Constructor Create(aInterval : Integer; aEvent : TNotifyEvent; aSender : TObject);
+    destructor Destroy; override;
+    Procedure Execute;
+    property OnTimer : TNotifyEvent Read FOnTimer;
+    Property ID : TWasmTimerID Read FID;
+    class procedure HandleWasmTimer(aTimerID: TWasmTimerID; userdata: pointer; var aContinue: Boolean); static;
+  end;
+
+  TTimer = Class(TComponent)
+  private
+    FTimer : TWasmTimer;
+    FEnabled: Boolean;
+    FInterval: Integer;
+    FOnTimer: TNotifyEvent;
+    procedure SetEnabled(AValue: Boolean);
+    procedure SetInterval(AValue: Integer);
+    procedure SetOnTimer(AValue: TNotifyEvent);
+  protected
+    procedure DoOnTimer(Sender: TObject); virtual;
+    procedure CheckEnabled; virtual;
+    procedure Loaded; override;
+  public
+    Destructor Destroy; override;
+  Published
+    Property Enabled : Boolean Read FEnabled Write SetEnabled;
+    Property Interval : Integer Read FInterval Write SetInterval;
+    Property OnTimer : TNotifyEvent Read FOnTimer Write SetOnTimer;
+  end;
+
+implementation
+
+uses wasm.logger.api;
+
+resourcestring
+  SErrCouldNotCreateTimer = 'Could not create timer';
+
+constructor TWasmTimer.Create(aInterval: Integer; aEvent: TNotifyEvent; aSender: TObject);
+begin
+  FOnTimer:=aEvent;
+  FSender:=aSender;
+  FInterval:=aInterval;
+  FID:=__wasm_timer_allocate(aInterval,Self);
+  if (FID=0) then
+    begin
+    __wasmtimer_log(wllError,SErrCouldNotCreateTimer);
+    Raise EWasmTimer.Create(SErrCouldNotCreateTimer);
+    end;
+end;
+
+destructor TWasmTimer.Destroy;
+begin
+  __wasm_timer_deallocate(FID);
+  inherited Destroy;
+end;
+
+procedure TWasmTimer.Execute;
+begin
+  FOnTimer(FSender);
+end;
+
+class procedure TWasmTimer.HandleWasmTimer(aTimerID: TWasmTimerID; userdata: pointer; var aContinue: Boolean);
+
+var
+  Obj : TWasmTimer absolute userdata;
+
+begin
+  __wasmtimer_log(wllTrace, 'Timer(ID: %d) tick. Data [%p]',[aTimerID,UserData]);
+  aContinue:=(Obj.FID=aTimerID);
+  __wasmtimer_log(wllDebug, 'Timer(id: %d) tick. Data [%p] continue: %b',[aTimerID,UserData,aContinue]);
+  if aContinue then
+    Obj.Execute;
+end;
+
+{ TTimer }
+
+procedure TTimer.SetEnabled(AValue: Boolean);
+begin
+  if FEnabled=AValue then Exit;
+  FEnabled:=AValue;
+  if csDesigning in ComponentState then
+    exit;
+  CheckEnabled;
+end;
+
+procedure TTimer.SetInterval(AValue: Integer);
+begin
+  if FInterval=AValue then Exit;
+  FInterval:=AValue;
+end;
+
+procedure TTimer.SetOnTimer(AValue: TNotifyEvent);
+begin
+  if FOnTimer=AValue then Exit;
+  FOnTimer:=AValue;
+end;
+
+
+procedure TTimer.DoOnTimer(Sender : TObject);
+
+begin
+  If Assigned(FOnTimer) then
+    FOnTimer(Self);
+end;
+
+procedure TTimer.CheckEnabled;
+
+begin
+  if FEnabled then
+    begin
+    if Assigned(FTimer) or (Interval=0) then
+      FreeAndNil(FTimer)
+    else
+      FTimer:=TWasmTimer.Create(Interval,@DoOnTimer,Self);
+    end
+  else
+    FreeAndNil(FTimer);
+end;
+
+procedure TTimer.Loaded;
+begin
+  inherited Loaded;
+  CheckEnabled;
+end;
+
+destructor TTimer.Destroy;
+begin
+  Enabled:=False;
+  inherited Destroy;
+end;
+
+initialization
+  OnWasmTimerTick:=@TWasmTimer.HandleWasmTimer
+end.
+

packages/wasm-utils/src/wasm.timer.shared.pas

@@ -0,0 +1,33 @@
+{
+    This file is part of the Free Component Library
+
+    Webassembly Timer API - shared info with pas2js hosting implementation.
+    Copyright (c) 2024 by Michael Van Canneyt michael@freepascal.org
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit wasm.timer.shared;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+Type
+  TWasmTimerID = Longint;
+
+const
+  TimerExportName  = 'timer';
+  TimerFN_Allocate = 'allocate';
+  TimerFN_DeAllocate = 'deallocate';
+
+
+implementation
+
+end.
+

packages/wasm-utils/src/wasm.websocket.api.pas

@@ -25,12 +25,21 @@ uses
   {$ELSE}
   sysutils,
   {$ENDIF}
+  wasm.logger.api,
   wasm.websocket.shared;
 
 Type
-  TWasmWebSocketLogLevel = (wllTrace, wllDebug, wllInfo, wllWarning, wllError, wllCritical);
+  TWasmWebSocketLogLevel = TWasmLogLevel;
   TWasmWebSocketLogLevels = set of TWasmWebsocketLogLevel;
 
+const
+  wllTrace    = wasm.logger.api.wllTrace;
+  wllDebug    = wasm.logger.api.wllDebug;
+  wllInfo     = wasm.logger.api.wllInfo;
+  wllWarning  = wasm.logger.api.wllWarning;
+  wllError    = wasm.logger.api.wllError;
+  wllCritical = wasm.logger.api.wllCritical;
+
 function __wasm_websocket_allocate(
     aURL : PByte;
     aUrlLen : Longint;
@@ -71,30 +80,32 @@ Function __wasm_websocket_on_open (aWebsocketID : TWasmWebSocketID; aUserData :
 Function __wasm_websocket_on_close (aWebsocketID : TWasmWebSocketID; aUserData : Pointer; aCode: Longint; aReason : PByte; aReasonLen : Longint; aClean : Longint) : TWebsocketCallBackResult;
 
 
-procedure __wasmwebsocket_log(level : TWasmWebsocketLogLevel; const Msg : String);
-procedure __wasmwebsocket_log(level : TWasmWebSocketLogLevel; const Fmt : String; Args : Array of const);
+procedure __wasmwebsocket_log(level : TWasmLogLevel; const Msg : String);
+procedure __wasmwebsocket_log(level : TWasmLogLevel; const Fmt : String; Args : Array of const);
 
 var
+  WebSocketLogEnabled : Boolean;
   WebSocketErrorCallback : TWasmWebsocketErrorCallback;
   WebSocketMessageCallback : TWasmWebsocketMessageCallback;
   WebSocketCloseCallback : TWasmWebsocketCloseCallback;
   WebSocketOpenCallback : TWasmWebsocketOpenCallback;
-  OnWebsocketLog : TWasmWebsocketLogHook;
 
 implementation
 
 procedure __wasmwebsocket_log(level : TWasmWebSocketLogLevel; const Msg : String);
 
 begin
-  if assigned(OnWebsocketLog) then
-    OnWebSocketLog(level,msg)
+  if not WebSocketLogEnabled then
+    exit;
+  __wasm_log(level,'websocket',msg);
 end;
 
 procedure __wasmwebsocket_log(level : TWasmWebSocketLogLevel; const Fmt : String; Args : Array of const);
 
 begin
-  if assigned(OnWebsocketLog) then
-    OnWebSocketLog(level,SafeFormat(Fmt,Args));
+  if not WebSocketLogEnabled then
+    exit;
+  __wasm_log(level,'websocket',Fmt,Args);
 end;