Browse Source

* New functionality & better performance

Michaël Van Canneyt 5 months ago
parent
commit
824fa848e1

+ 342 - 0
src/wasm/fresnel.lexeme.pp

@@ -0,0 +1,342 @@
+{
+    This file is part of the Fresnel Library.
+    Copyright (c) 2025 by the FPC & Lazarus teams.
+
+    Webassembly unicode handling of lexemes for Fresnel
+
+    See the file COPYING.modifiedLGPL.txt, 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 Fresnel.Lexeme;
+
+interface
+
+(*
+  Uses grapheme-aware function from Fresnel.Unicode
+  Note: these are 0-based
+*)
+
+function FindWordBound(const aText: String; const aIndex: Integer; out aBeginPos, aEndPos: Integer): Boolean;
+function GetLexemeBegin(const aText: String; const aIndex: Integer): Integer;
+function GetLexemeEnd(const aText: String; const aIndex: Integer): Integer;
+function GetNextLexemeBegin(const aText: String; const aIndex: Integer): Integer;
+function GetPrevLexemeBegin(const aText: String; const aIndex: Integer): Integer;
+
+// ------------------------------------------------------------------
+// ------------------------------------------------------------------
+// ------------------------------------------------------------------
+implementation
+// ------------------------------------------------------------------
+// ------------------------------------------------------------------
+// ------------------------------------------------------------------
+
+// TUnicodeCategory-based GetCharType,
+// and characters out of UCS-2 in general
+{ $define USE_TUNICODECATEGORY}
+
+uses
+  {$ifdef USE_TUNICODECATEGORY}System.Character,{$endif}
+  System.Math,
+  Fresnel.Unicode;
+
+type
+  TLexemeType = (Word, OneLetterWord, Punctuation, None);
+
+{$ifdef USE_TUNICODECATEGORY}
+// GetCharType (zero-based)
+//
+function GetCharType(const aText: String; aIndex: Integer): TLexemeType;
+var
+  ch: Char;
+  unicodeCategory: TUnicodeCategory;
+begin
+  if (aIndex < 0) or (aIndex >= Length(aText)) then
+    Exit(TLexemeType.None);
+
+  ch := aText[aIndex+1];
+  unicodeCategory := TCharacter.GetUnicodeCategory(ch);
+
+  case unicodeCategory of
+    TUnicodeCategory.ucUppercaseLetter, TUnicodeCategory.ucLowercaseLetter,
+    TUnicodeCategory.ucTitlecaseLetter, TUnicodeCategory.ucDecimalNumber,
+    TUnicodeCategory.ucModifierLetter, TUnicodeCategory.ucOtherLetter,
+    TUnicodeCategory.ucLetterNumber:
+      Result := TLexemeType.Word;
+
+    TUnicodeCategory.ucConnectPunctuation, TUnicodeCategory.ucDashPunctuation,
+    TUnicodeCategory.ucOpenPunctuation, TUnicodeCategory.ucClosePunctuation,
+    TUnicodeCategory.ucInitialPunctuation, TUnicodeCategory.ucFinalPunctuation,
+    TUnicodeCategory.ucOtherPunctuation, TUnicodeCategory.ucMathSymbol:
+      Result := TLexemeType.Punctuation;
+
+    TUnicodeCategory.ucSpaceSeparator, TUnicodeCategory.ucLineSeparator,
+    TUnicodeCategory.ucParagraphSeparator:
+      Result := TLexemeType.None;
+  else
+    Result := TLexemeType.OneLetterWord;
+  end;
+end;
+{$else}
+function GetCharType(const aText: String; aIndex: Integer): TLexemeType;
+var
+  ch, nextCh: Char;
+  codePoint: Cardinal;
+begin
+  Inc(aIndex); // Convert to 1-based
+  if (aIndex <= 0) or (aIndex > Length(aText)) then
+    Exit(TLexemeType.None);
+  ch := aText[aIndex];
+  // Cascaded classification, staring with most common characters
+  // First level: ASCII range check
+  case Ord(ch) of
+    $00..$20:     // ASCII Separators - Control chars, space
+      Exit(TLexemeType.None);
+    $21..$2F,     // ASCII Punctuation - !"#$%&'()*+,-./
+    $3A..$40,     // ASCII Punctuation - :;<=>?@
+    $5B..$60,     // ASCII Punctuation - [\]^_`
+    $7B..$7E:     // ASCII Punctuation - {|}~
+      Exit(TLexemeType.Punctuation);
+    $30..$39,     // ASCII Numbers - 0-9
+    $41..$5A,     // ASCII Uppercase - A-Z
+    $61..$7A:     // ASCII Lowercase - a-z
+      Exit(TLexemeType.Word);
+    $D800..$DBFF: begin // High surrogate range
+      if (aIndex < Length(aText)) then
+      begin
+        nextCh := aText[aIndex + 1];
+        if (Ord(nextCh) >= $DC00) and (Ord(nextCh) <= $DFFF) then
+        begin
+          // Compose the surrogate pair
+          codePoint := (Cardinal(ch) - $D800) shl 10 + (Cardinal(nextCh) - $DC00) + $10000;
+          // Check high Unicode ranges
+          case codePoint of
+            $1D400..$1D7FF, // Mathematical Alphanumeric Symbols
+            $1F000..$1F02F, // Mahjong Tiles, Domino Tiles
+            $1F0A0..$1F0FF, // Playing Cards
+            $1F100..$1F1FF, // Enclosed Alphanumerics, Regional Indicators
+            $1F300..$1F9FF, // Miscellaneous Symbols, Emoticons, Transport Symbols
+            $1FA70..$1FAFF, // Symbols and Pictographs Extended
+            $20000..$2A6DF: // CJK Unified Ideographs Extension B
+              Exit(TLexemeType.OneLetterWord);
+          else
+            Exit(TLexemeType.Word);
+          end;
+        end;
+        Exit(TLexemeType.OneLetterWord); // Invalid surrogate pair
+      end
+      else
+        Exit(TLexemeType.OneLetterWord); // High surrogate at end of string
+    end;
+  else
+    // Regular Unicode character (non-surrogate)
+    case Ord(ch) of
+      $00A0,         // Non-breaking space
+      $2000..$200A,  // General punctuation spaces
+      $2028, $2029,  // Line/paragraph separators
+      $202F, $205F,  // Narrow no-break space, Medium mathematical space
+      $3000:         // Ideographic space
+        Exit(TLexemeType.None);
+      $00A1..$00BF,  // Latin-1 Punctuation and Symbols
+      $2010..$2027,  // General punctuation (hyphens, dashes)
+      $2030..$205E,  // General punctuation (per mille, quotes)
+      $2200..$22FF,  // Mathematical operators
+      $2E00..$2E7F,  // Supplemental punctuation
+      $3001..$303F,  // CJK Symbols and Punctuation
+      $FF01..$FF0F,  // Fullwidth ASCII variants (punctuation)
+      $FF1A..$FF20,  // Fullwidth ASCII variants (punctuation)
+      $FF3B..$FF40,  // Fullwidth ASCII variants (punctuation)
+      $FF5B..$FF65:  // Fullwidth ASCII variants (punctuation)
+        Exit(TLexemeType.Punctuation);
+      $4E00..$9FFF,  // CJK Unified Ideographs
+      $E000..$F8FF,  // Private Use Area
+      $2600..$27BF:  // Miscellaneous Symbols, Dingbats
+        Exit(TLexemeType.OneLetterWord);
+    else
+      Exit(TLexemeType.Word);
+    end;
+  end;
+end;
+{$endif}
+
+// FindWordBound
+//
+function FindWordBound(const aText: String; const aIndex: Integer; out aBeginPos, aEndPos: Integer): Boolean;
+begin
+  if (aText = '') or (aIndex < 0) or (aIndex > Length(aText)) then
+    Exit(False);
+
+  aBeginPos := GetLexemeBegin(aText, aIndex);
+  aEndPos := GetLexemeEnd(aText, aIndex);
+  Result := True;
+end;
+
+// GetLexemeBegin
+//
+function GetLexemeBegin(const aText: String; const aIndex: Integer): Integer;
+var
+  originalLexemeType: TLexemeType;
+  i, prevPos: Integer;
+begin
+  if aText = '' then
+    Exit(0);
+
+  i := EnsureRange(aIndex, 0, Length(aText) - 1);
+
+  while (i > 0) and (GetCharType(aText, i) = TLexemeType.None) do
+  begin
+    prevPos := PrevGraphemePosition(aText, i);
+    i := prevPos;
+  end;
+
+  if i > 0 then
+  begin
+    originalLexemeType := GetCharType(aText, i);
+    case originalLexemeType of
+      TLexemeType.Word,
+      TLexemeType.Punctuation: begin
+        while (i > 0) do
+        begin
+          prevPos := PrevGraphemePosition(aText, i + 1) - 1;
+          if GetCharType(aText, prevPos) <> originalLexemeType then
+            Break;
+          i := prevPos;
+        end;
+      end;
+      TLexemeType.OneLetterWord: begin
+        prevPos := PrevGraphemePosition(aText, i + 1) - 1;
+        if (i > 0) and (GetCharType(aText, prevPos) = TLexemeType.OneLetterWord) then
+          i := prevPos;
+      end;
+    end;
+  end;
+
+  Result := Max(i, 0);
+end;
+
+// GetLexemeEnd
+//
+function GetLexemeEnd(const aText: String; const aIndex: Integer): Integer;
+var
+  originalLexemType: TLexemeType;
+  textLength, nextPos: Integer;
+begin
+  if aText = '' then
+    Exit(0);
+
+  textLength := Length(aText);
+  Result := EnsureRange(aIndex, 0, textLength - 1);
+
+  while (Result < textLength) and (GetCharType(aText, Result) = TLexemeType.None) do
+    Result := NextGraphemePosition(aText, Result + 1) - 1;
+
+  if Result < textLength then
+  begin
+    originalLexemType := GetCharType(aText, Result);
+    case originalLexemType of
+      TLexemeType.Word,
+      TLexemeType.Punctuation: begin
+        while true do
+        begin
+          // Get next grapheme position
+          nextPos := NextGraphemePosition(aText, Result + 1) - 1;
+          if (nextPos > textLength) or (nextPos <= 0) then
+            break;
+
+          if GetCharType(aText, nextPos) <> originalLexemType then
+            break;
+
+          Result := nextPos;
+        end;
+      end;
+      TLexemeType.OneLetterWord: begin
+        nextPos := NextGraphemePosition(aText, Result + 1) - 1;
+        if (nextPos <= textLength) and (nextPos > 0) then
+            Result := nextPos - 1;
+      end;
+    end;
+  end;
+
+  Result := Min(Result, textLength - 1);
+end;
+
+// GetNextLexemeBegin
+//
+function GetNextLexemeBegin(const aText: String; const aIndex: Integer): Integer;
+var
+  textLength: Integer;
+begin
+  if aText = '' then
+    Exit(0);
+
+  textLength := Length(aText);
+  Result := EnsureRange(aIndex, 0, textLength - 1);
+
+  if GetCharType(aText, Result) = TLexemeType.None then
+  begin
+    repeat
+      Result := NextGraphemePosition(aText, Result + 1) - 1;
+    until (Result >= textLength) or (GetCharType(aText, Result) <> TLexemeType.None);
+  end
+  else
+  begin
+    Result := GetLexemeEnd(aText, Result) + 1;
+    if Result < textLength then
+    begin
+      Result := NextGraphemePosition(aText, Result + 1) - 1;
+      while (Result < textLength) and (GetCharType(aText, Result) = TLexemeType.None) do
+        Result := NextGraphemePosition(aText, Result + 1) - 1;
+    end;
+  end;
+end;
+
+// GetPrevLexemeBegin
+//
+function GetPrevLexemeBegin(const aText: String; const aIndex: Integer): Integer;
+var
+  i: Integer;
+begin
+  if aText = '' then
+    Exit(0);
+
+  i := EnsureRange(aIndex, 0, Length(aText) - 1);
+
+  if GetCharType(aText, i) = TLexemeType.None then
+  begin
+    // Not on a lexeme, find previous lexeme
+    Result := i;
+
+    // Skip non-lexeme characters backward
+    while (Result > 0) and (GetCharType(aText, Result) = TLexemeType.None) do
+      Result := PrevGraphemePosition(aText, Result + 1) - 1;
+
+    // Get beginning of this lexeme, note that Result can't be < 0 since aText can't be empty here
+    if Result > 0 then
+      Result := GetLexemeBegin(aText, Result);
+  end
+  else
+  begin
+    // On a lexeme, find its beginning
+    Result := GetLexemeBegin(aText, i);
+
+    if Result > 0 then
+    begin
+      // Move back one grapheme
+      Result := PrevGraphemePosition(aText, Result + 1) - 1;
+
+      // Skip non-lexeme characters backward
+      while (Result > 0) and (GetCharType(aText, Result) = TLexemeType.None) do
+        Result := PrevGraphemePosition(aText, Result + 1) - 1;
+
+      // Get beginning of previous lexeme, note that Result can't be < 0 since aText can't be empty here
+      if Result > 0 then
+        Result := GetLexemeBegin(aText, Result);
+    end;
+  end;
+end;
+
+end.

+ 192 - 0
src/wasm/fresnel.polygon.clipper.pas

@@ -0,0 +1,192 @@
+{
+    This file is part of the Fresnel Library.
+    Copyright (c) 2025 by the FPC & Lazarus teams.
+
+    Webassembly polygon handling classes for Fresnel
+
+    See the file COPYING.modifiedLGPL.txt, 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 Fresnel.Polygon.Clipper;
+
+interface
+
+uses
+  System.Types, System.Math, System.Math.Vectors;
+
+// Uses Sutherland-Hodgman to compute the intersection of aSubject and aClipper
+function IntersectPolygon(const aSubject, aClipper : TPolygon) : TPolygon;
+
+// Rotate polygon around aCenter by aAngleInDegrees
+procedure RotatePolygon(var aPolygon : TPolygon; const aCenter : TPointF; aAngleInDegrees : Single);
+
+// Create a CW polygon from a RectF
+function PolygonFromRect(const aRectF : TRectF) : TPolygon;
+
+implementation
+
+// RotatePolygon
+//
+procedure RotatePolygon(var aPolygon: TPolygon; const aCenter : TPointF; aAngleInDegrees: Single);
+var
+  i: Integer;
+  x, y: Single;
+  cosAngle, sinAngle: Single;
+  dx, dy, cx, cy: Single;
+  pPoint : PPointF;
+begin
+  SinCos(DegToRad(aAngleInDegrees), sinAngle, cosAngle);
+
+  // Hint to registers
+  cx := aCenter.X;
+  cy := aCenter.Y;
+
+  pPoint := PPointF(aPolygon);
+  for i := 0 to High(aPolygon) do
+  begin
+    // Translate point to origin
+    dx := pPoint.X - cx;
+    dy := pPoint.Y - cy;
+
+    // Apply rotation
+    x := dx * cosAngle - dy * sinAngle;
+    y := dx * sinAngle + dy * cosAngle;
+
+    // Translate point back
+    pPoint.X := x + cx;
+    pPoint.Y := y + cy;
+    Inc(pPoint);
+  end;
+end;
+
+// PolygonFromRect
+//
+function PolygonFromRect(const aRectF : TRectF) : TPolygon;
+var
+  p : PPointF;
+begin
+  SetLength(Result, 4);
+  p := PPointF(Result);
+  p^.X := aRectF.Left;
+  p^.Y := aRectF.Top;
+  Inc(p);
+  p^.X := aRectF.Right;
+  p^.Y := aRectF.Top;
+  Inc(p);
+  p^.X := aRectF.Right;
+  p^.Y := aRectF.Bottom;
+  Inc(p);
+  p^.X := aRectF.Left;
+  p^.Y := aRectF.Bottom;
+end;
+
+// IsInside
+//
+// Returns True if point P lies to the left of the edge from A to B
+// For a Clipper defined in counterclockwise order, points to the left are "inside"
+function IsInside(const P, A, B: TPointF): Boolean;
+
+  function CrossProduct(const ax, ay, bx, by : Single): Single; inline;
+  begin
+    Result := ax * by - ay * bx;
+  end;
+
+begin
+  Result := CrossProduct(B.X - A.X, B.Y - A.Y, P.X - A.X, P.Y - A.Y) >= 0;
+end;
+
+// AppendPoint
+//
+procedure AppendPoint(var aPolygon: TPolygon; const aPoint: TPointF);
+var
+  n : Integer;
+begin
+  n := Length(aPolygon);
+  SetLength(aPolygon, n + 1);
+  aPolygon[n] := aPoint;
+end;
+
+// ComputeIntersection
+//
+// Computes the intersection of the infinite lines (P1,P2) and (A,B)
+function ComputeIntersection(const P1, P2, A, B: TPointF): TPointF;
+var
+  denominator, t : Single;
+  dx, dy : Single;
+begin
+  denominator := (P2.X - P1.X) * (B.Y - A.Y) - (P2.Y - P1.Y) * (B.X - A.X);
+
+  // When Lines are nearly parallel - return one of the points as a fallback
+  if Abs(denominator) < 1e-6 then
+    Exit(P2);
+
+  t := ((A.X - P1.X) * (B.Y - A.Y) - (A.Y - P1.Y) * (B.X - A.X)) / denominator;
+  dx := P2.X - P1.X;
+  dy := P2.Y - P1.Y;
+  Result := PointF(P1.X + t * dx, P1.Y + t * dy);
+end;
+
+// IntersectPolygon
+//
+function IntersectPolygon(const aSubject, aClipper: TPolygon): TPolygon;
+var
+  inputPolygon, outputPolygon : TPolygon;
+  clipCount, subjCount, i, j : Integer;
+  clipEdgeStart, clipEdgeEnd : PPointF;
+  prev, current : PPointF;
+  intersectPt : TPointF;
+begin
+  outputPolygon := aSubject;
+  clipCount := Length(aClipper);
+  if clipCount < 2 then
+    Exit(outputPolygon);
+
+  // Process each edge of the clipper
+  clipEdgeEnd := PPointF(aClipper);
+  for i := 0 to clipCount - 1 do
+  begin
+    subjCount := Length(outputPolygon);
+    if subjCount = 0 then
+      Break;
+
+    inputPolygon := outputPolygon;
+    outputPolygon := nil;
+
+    clipEdgeStart := clipEdgeEnd;
+    Inc(clipEdgeEnd);
+    if i + 1 = clipCount then
+      clipEdgeEnd := PPointF(aClipper);
+
+    prev := @inputPolygon[subjCount - 1];
+    current := PPointF(inputPolygon);
+    for j := 0 to subjCount - 1 do
+    begin
+      if IsInside(current^, clipEdgeStart^, clipEdgeEnd^) then
+      begin
+        if not IsInside(prev^, clipEdgeStart^, clipEdgeEnd^) then
+        begin
+          // Entering the clip area - add the intersection point.
+          intersectPt := ComputeIntersection(prev^, current^, clipEdgeStart^, clipEdgeEnd^);
+          AppendPoint(outputPolygon, intersectPt);
+        end;
+        AppendPoint(outputPolygon, current^);
+      end
+      else if IsInside(prev^, clipEdgeStart^, clipEdgeEnd^) then
+      begin
+        // Leaving the clip area - add the intersection point.
+        intersectPt := ComputeIntersection(prev^, current^, clipEdgeStart^, clipEdgeEnd^);
+        AppendPoint(outputPolygon, intersectPt);
+      end;
+      prev := current;
+      Inc(current);
+    end;
+  end;
+  Result := outputPolygon;
+end;
+
+end.

+ 276 - 0
src/wasm/fresnel.unicode.pp

@@ -0,0 +1,276 @@
+{
+    This file is part of the Fresnel Library.
+    Copyright (c) 2024 by the FPC & Lazarus teams.
+
+    Webassembly unicode grapheme handling classes for Fresnel
+
+    See the file COPYING.modifiedLGPL.txt, 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 Fresnel.Unicode;
+
+interface
+
+(*
+  Functions to find grapheme start positions
+
+  Graphemes are a Unicode "character" and its combining modifiers, f.i.
+  - diacritics (accents...)
+  - emoji skin tones
+  - half marks
+
+  (the ranges are encoded in IsCombiningCodePoint internal function)
+*)
+
+function NextGraphemePosition(const aStr: String; aStartPos: Integer): Integer;
+function PrevGraphemePosition(const aStr: String; aStartPos: Integer): Integer;
+
+function GetGraphemeStarts(const aStr: String): TArray<Integer>;
+
+type
+  TRenderedTextWidthMeasurer = function (const aText : String) : Single of object;
+
+function FindGraphemeByRenderPosition(const aStr: String; aX : Single; const aMeasurer : TRenderedTextWidthMeasurer) : Integer;
+
+// ------------------------------------------------------------------
+// ------------------------------------------------------------------
+// ------------------------------------------------------------------
+implementation
+// ------------------------------------------------------------------
+// ------------------------------------------------------------------
+// ------------------------------------------------------------------
+
+// IsHighSurrogate
+//
+function IsHighSurrogate(aCodeUnit: WideChar): Boolean; inline;
+begin
+  Result := (Word(aCodeUnit) >= $D800) and (Word(aCodeUnit) <= $DBFF);
+end;
+
+// IsHighSurrogate
+//
+function IsLowSurrogate(aCodeUnit: WideChar): Boolean; inline;
+begin
+  Result := (Word(aCodeUnit) >= $DC00) and (Word(aCodeUnit) <= $DFFF);
+end;
+
+// GetCodePoint
+//
+function GetCodePoint(const aStr: String; var aPos: Integer): Cardinal;
+begin
+  if (aPos > Length(aStr)) or IsLowSurrogate(aStr[aPos]) then begin
+    Inc(aPos);
+    Exit(0);
+  end;
+
+  if IsHighSurrogate(aStr[aPos]) and (aPos < Length(aStr)) and IsLowSurrogate(aStr[aPos+1]) then begin
+    Result := (Cardinal(aStr[aPos]) - $D800) shl 10 + (Cardinal(aStr[aPos+1]) - $DC00) + $10000;
+    Inc(aPos, 2);
+  end else begin
+    Result := Cardinal(aStr[aPos]);
+    Inc(aPos, 1);
+  end;
+end;
+
+// IsRegionalIndicator
+//
+function IsRegionalIndicator(aCodePoint: Cardinal): Boolean; inline;
+begin
+  Result := (aCodePoint >= $1F1E6) and (aCodePoint <= $1F1FF);
+end;
+
+// IsCombiningCodePoint
+//
+function IsCombiningCodePoint(aCodePoint: Cardinal): Boolean;
+begin
+  // This function exists because
+  //    TCharacter.GetUnicodeCategory(aCodePoint) = TUnicodeCategory.ucCombiningMark
+  // is incomplete (or incorrect, or both)
+
+  if aCodePoint < $0300 then
+    Exit(False);
+
+  case aCodePoint of
+     $0300 ..  $036F,   // Combining Diacritical Marks
+     $1AB0 ..  $1AFF,   // Extended
+     $1DC0 ..  $1DFF,   // Supplement
+     $200D,             // Zero Width Joiner (for emoji sequences: family, professions, couple with heart...)
+     $20D0 ..  $20FF,   // Symbols
+     $FE0E,             // Variation Selector-15 (text style for visual emojis)
+     $FE0F,             // Variation Selector-16 (emoji style for text emojis)
+     $FE20 ..  $FE2F,   // Half Marks
+    $1F3FB .. $1F3FF,   // Emoji Skin Tones
+    $E0020 .. $E007F,   // Tag characters (for regional flags)
+    $E0100 .. $E01EF:   // Variation Selectors Supplement (for ideographs)
+      Result := True;
+  else
+    Result := False;
+  end;
+  // Weleave aside Arabic, Hebrew, Cyrillic and many other regional diacritic combiners for now
+end;
+
+// NextGraphemePosition
+//
+function NextGraphemePosition(const aStr: String; aStartPos: Integer): Integer;
+var
+  lStrLen, lCurrentPos, lNextPos: Integer;
+  lCurrentCP, lNextCP: Cardinal;
+  lSeenZWJ: Boolean;
+begin
+  if aStartPos <= 0 then
+    Exit(0);
+
+  lStrLen := Length(aStr);
+  if aStartPos > lStrLen then
+    Exit(lStrLen + 1);
+
+  lCurrentPos := aStartPos;
+  lCurrentCP := GetCodePoint(aStr, lCurrentPos);
+  Result := lCurrentPos;
+
+  if IsRegionalIndicator(lCurrentCP) and (Result <= lStrLen) then begin
+    lNextPos := Result;
+    lNextCP := GetCodePoint(aStr, lNextPos);
+    if IsRegionalIndicator(lNextCP) then
+      Result := lNextPos;
+    Exit;
+  end;
+
+  lSeenZWJ := False;
+  while Result <= lStrLen do begin
+    lCurrentPos := Result;
+    lCurrentCP := GetCodePoint(aStr, lCurrentPos);
+    if lCurrentCP = 0 then Exit;
+
+    if lSeenZWJ then begin
+      lSeenZWJ := False;
+      Result := lCurrentPos;
+      continue;
+    end;
+
+    if not IsCombiningCodePoint(lCurrentCP) then Exit;
+
+    lSeenZWJ := (lCurrentCP = $200D);
+    Result := lCurrentPos;
+  end;
+end;
+
+// PrevGraphemePosition
+//
+function PrevGraphemePosition(const aStr: String; aStartPos: Integer): Integer;
+var
+  lLen, i: Integer;
+begin
+  lLen := Length(aStr);
+  Result := -1;
+
+  // Validate input position
+  if (aStartPos <= 1) or (aStartPos > lLen + 1) then Exit;
+
+  // We want to find the grapheme that starts before aStartPos
+  // We'll scan from the beginning using NextGraphemePosition until we find it
+  i := 1;
+  Result := 0;
+
+  while i < aStartPos do begin
+    Result := i;
+    i := NextGraphemePosition(aStr, i);
+    if i = -1 then Break;
+  end;
+
+  // If we reached or passed aStartPos, Result contains the start of previous grapheme
+  // If we didn't reach aStartPos, something went wrong
+  if i < aStartPos then Result := -1;
+end;
+
+// GetGraphemeStarts
+//
+function GetGraphemeStarts(const aStr: String): TArray<Integer>;
+var
+  lLen, lPos, lNextPos: Integer;
+  lNbGraphemes: Integer;
+begin
+  lLen := Length(aStr);
+  if lLen = 0 then Exit(nil);
+
+  SetLength(Result, lLen);
+
+  lNbGraphemes := 0;
+  lPos := 1;
+  while lPos <= lLen do
+  begin
+    Result[lNbGraphemes] := lPos;
+    Inc(lNbGraphemes);
+
+    // Use NextGraphemePosition to find the next grapheme
+    lNextPos := NextGraphemePosition(aStr, lPos);
+
+    // Sanity check against infinite loops
+    Assert(lNextPos > lPos);
+
+    lPos := lNextPos;
+  end;
+
+  SetLength(Result, lNbGraphemes);
+end;
+
+// FindGraphemeByRenderPosition
+//
+function FindGraphemeByRenderPosition(const aStr: String; aX: Single; const aMeasurer: TRenderedTextWidthMeasurer): Integer;
+var
+  lStrLen: Integer;
+  lGraphemeStarts: TArray<Integer>;
+  lLeft, lRight, lMid: Integer;
+  lLeftWidth, lRightWidth, lMidWidth: Single;
+begin
+  lStrLen := Length(aStr);
+  if (aStr = '') or (aX <= 0) then
+    Exit(0);
+
+  lRightWidth := aMeasurer(aStr);
+
+  // Handle positions beyond the string width
+  if aX >= lRightWidth then
+    Exit(lStrLen);
+
+  // Special case for single character strings
+  if lStrLen = 1 then
+    Exit(Ord(2 * aX >= lRightWidth));
+
+  lGraphemeStarts := GetGraphemeStarts(aStr);
+
+  lLeft := 0;
+  lRight := High(lGraphemeStarts)+1;
+  lLeftWidth := 0;
+
+  // Binary search to find the closest position
+  while lRight - lLeft > 1 do begin
+    lMid := (lLeft + lRight) shr 1;
+    lMidWidth := aMeasurer(Copy(aStr, 1, lGraphemeStarts[lMid] - 1));
+
+    if lMidWidth <= aX then begin
+      lLeft := lMid;
+      lLeftWidth := lMidWidth;
+    end else begin
+      lRight := lMid;
+      lRightWidth := lMidWidth;
+    end;
+  end;
+
+  // Determine which boundary position is closer
+  if (aX - lLeftWidth) * 2 <= (lRightWidth - lLeftWidth) then
+    Result := lLeft
+  else
+    Result := lRight;
+
+  if Result > 0 then
+    Result := lGraphemeStarts[Result-1];
+end;
+
+end.
+

+ 352 - 0
src/wasm/fresnel.usermedia.pp

@@ -0,0 +1,352 @@
+{
+    This file is part of the Fresnel Library.
+    Copyright (c) 2024 by the FPC & Lazarus teams.
+
+    Browser media enumeration classes for Fresnel
+
+    See the file COPYING.modifiedLGPL.txt, 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 fresnel.usermedia;
+{$mode objfpc}
+{$modeswitch advancedrecords}
+{$h+}
+interface
+
+uses
+  {$IFDEF FPC_DOTTEDUNITS}
+  System.Classes, System.SysUtils, System.IniFiles
+  {$ELSE}
+  Classes, SysUtils, IniFiles
+  {$ENDIF}
+  , fresnel.wasm.shared
+  ;
+
+type
+  TFresnelUserMediaKind = (
+    fumkUnknown,
+    fumkVideoInput,
+    fumkAudioInput,
+    fumkAudioOutput
+  );
+
+  TFresnelUserMedia = record
+  private
+    FDeviceID : String;
+    FGroupID : String;
+    FKind : TFresnelUserMediaKind;
+    FKindString : String;
+    FLabel : String;
+
+  public
+    property DeviceID : String read FDeviceID;
+    property GroupID : String read FGroupID;
+    property Kind : TFresnelUserMediaKind read FKind;
+    property KindString : String read FKindString;
+    property &Label : String read FLabel;
+  end;
+  PFresnelUserMedia = ^TFresnelUserMedia;
+
+  TFresnelUserMediaDynArray = array of TFresnelUserMedia;
+
+  { TFresnelUserMedias }
+
+  TFresnelUserMedias = class
+    private
+      FList : TFresnelUserMediaDynArray;
+
+    protected
+      function GetUserMedia(index : Integer) : TFresnelUserMedia;
+      function GetKind(index : Integer) : TFresnelUserMediaKind;
+      function GetDeviceID(index : Integer) : String;
+      function GetGroupID(index : Integer) : String;
+      function GetKindString(index : Integer) : String;
+      function GetLabel(index : Integer) : String;
+
+    public
+      procedure LoadFromIniFileData(const iniFileData : String);
+
+      property UserMedia[index : Integer] : TFresnelUserMedia read GetUserMedia;
+      property DeviceID[index : Integer] : String read GetDeviceID;
+      property GroupID[index : Integer] : String read GetGroupID;
+      property Kind[index : Integer] : TFresnelUserMediaKind read GetKind;
+      property KindString[index : Integer] : String read GetKindString;
+      property &Label[index : Integer] : String read GetLabel;
+
+      function Count : Integer;
+
+      function GetMediaByDeviceID(const aDeviceID : String) : TFresnelUserMedia;
+      function EnumerateByKind(aKind : TFresnelUserMediaKind) : TFresnelUserMediaDynArray;
+  end;
+
+  TOnUserMediaCaptureFrameEvent = procedure (aTimeStamp : Double; const aDeviceID : String; aImageBitmapID : Integer) of object;
+
+  TUserMediaCaptureOption = (*flags*) (
+    // Asks to schedule an animation frame (if there isn't one scheduled already)
+    // right when a user media frame is notified, under the assumptions that user media
+    // frame will be reflected visually and a repaint will be requested
+    // (This can reduce paint latency and avoid frame drops)
+    umcoRequestAnimationFrame = cUserMediaCaptureOption_RequestAnimationFrame,
+
+    // Process the frame through Selfie Segmentation and apply blur to the background
+    umcoSelfieSegmentationBlur = cUserMediaCaptureOption_SelfieSegmentationBlur
+  );
+  TUserMediaCaptureOptions = set of TUserMediaCaptureOption;
+
+procedure StartUserMediaCapture(const aDeviceID : String; aOnFrame : TOnUserMediaCaptureFrameEvent;
+                                aResolutionWidth, aResolutionHeight : Integer;
+                                aOptions : TUserMediaCaptureOptions);
+procedure StopUserMediaCapture(const aDeviceID : String);
+
+// ------------------------------------------------------------------
+// ------------------------------------------------------------------
+// ------------------------------------------------------------------
+implementation
+// ------------------------------------------------------------------
+// ------------------------------------------------------------------
+// ------------------------------------------------------------------
+
+uses
+  fresnel.wasm.api;
+
+type
+  TUserMediaCapture = class
+    DeviceID : String;
+    OnFrame : TOnUserMediaCaptureFrameEvent;
+    VideoID : TVideoElementID;
+  end;
+
+var
+  vUserMediaCaptures : array of TUserMediaCapture;
+
+// DoOnFresnelUserMediaFrame
+//
+procedure DoOnFresnelUserMediaFrame(aTimeStamp : Double; aVideoID : TVideoElementID; aImageBitmapID : Integer);
+var
+  lCapture : TUserMediaCapture;
+  i : Integer;
+begin
+  //__fresnel_console_log(Format('DoOnFresnelUserMediaFrame %.1f %d %d', [ aTimeStamp, aVideoID.Vid, aImageBitmapID ]));
+  for i := 0 to High(vUserMediaCaptures) do
+  begin
+    lCapture := vUserMediaCaptures[i];
+    if lCapture.VideoID.Vid  = aVideoID.Vid then
+    begin
+      if Assigned(lCapture.OnFrame) then
+        lCapture.OnFrame(aTimeStamp, lCapture.DeviceID, aImageBitmapID);
+      Exit;
+    end;
+  end;
+end;
+
+// StartUserMediaCapture
+//
+procedure StartUserMediaCapture(
+  const aDeviceID: String; aOnFrame: TOnUserMediaCaptureFrameEvent;
+  aResolutionWidth, aResolutionHeight : Integer;
+  aOptions : TUserMediaCaptureOptions
+  );
+var
+  i : Integer;
+  lCapture : TUserMediaCapture;
+  lError : TCanvasError;
+  lOptionsValue : Integer;
+  lOption : TUserMediaCaptureOption;
+begin
+  // lazy initialization
+  if not Assigned(OnFresnelUserMediaFrame) then
+    OnFresnelUserMediaFrame := @DoOnFresnelUserMediaFrame;
+
+  // check if deviceID is already captured
+  for i := 0 to High(vUserMediaCaptures) do
+    if vUserMediaCaptures[i].DeviceID = aDeviceID then
+      raise Exception.CreateFmt('StartUserMediaCapture DeviceID "%s" already captured', [ aDeviceID ]);
+
+  lCapture := TUserMediaCapture.Create;
+  lCapture.DeviceID := aDeviceID;
+  lCapture.OnFrame := aOnFrame;
+
+  i := Length(vUserMediaCaptures);
+  SetLength(vUserMediaCaptures, i + 1);
+  vUserMediaCaptures[i] := lCapture;
+
+  lOptionsValue := 0;
+  for lOption := Low(TUserMediaCaptureOption) to High(TUserMediaCaptureOption) do
+    if lOption in aOptions then
+      inc(lOptionsValue,Ord(lOption));
+
+  lError := __fresnel_usermedia_startcapture(
+    Pointer(aDeviceID), Length(aDeviceID),
+    PByte(@lCapture.VideoID),
+    aResolutionWidth, aResolutionHeight,
+    lOptionsValue
+  );
+  if lError <> EWASMEVENT_SUCCESS then
+    WriteLn('StartUserMediaCapture failed ', lError);
+end;
+
+// StopUserMediaCapture
+//
+procedure StopUserMediaCapture(const aDeviceID: String);
+var
+  i : Integer;
+  lCapture : TUserMediaCapture;
+  lError : TCanvasError;
+begin
+  lCapture := nil;
+  for i := 0 to High(vUserMediaCaptures) do
+  begin
+    if vUserMediaCaptures[i].DeviceID = aDeviceID then
+    begin
+      lCapture := vUserMediaCaptures[i];
+      Delete(vUserMediaCaptures, i, 1);
+      Break;
+    end;
+  end;
+
+  lError := __fresnel_usermedia_stopcapture(lCapture.VideoID.Vid);
+  if lError <> EWASMEVENT_SUCCESS then
+    WriteLn('StopUserMediaCapture failed ', lError);
+
+  lCapture.Free;
+end;
+
+{ TFresnelUserMedias }
+
+// GetUserMedia
+//
+function TFresnelUserMedias.GetUserMedia(index: Integer): TFresnelUserMedia;
+begin
+  Result := FList[index];
+end;
+
+// GetKind
+//
+function TFresnelUserMedias.GetKind(index: Integer): TFresnelUserMediaKind;
+begin
+  Result := FList[index].Kind;
+end;
+
+// GetDeviceID
+//
+function TFresnelUserMedias.GetDeviceID(index: Integer): String;
+begin
+  Result := FList[index].DeviceID;
+end;
+
+// GetGroupID
+//
+function TFresnelUserMedias.GetGroupID(index: Integer): String;
+begin
+  Result := FList[index].GroupID;
+end;
+
+// GetKindString
+//
+function TFresnelUserMedias.GetKindString(index: Integer): String;
+begin
+  Result := FList[index].KindString;
+end;
+
+// GetLabel
+//
+function TFresnelUserMedias.GetLabel(index: Integer): String;
+begin
+  Result := FList[index].&Label;
+end;
+
+// LoadFromIniFileData
+//
+procedure TFresnelUserMedias.LoadFromIniFileData(const iniFileData: String);
+var
+  lStream : TStringStream;
+  lIniFile : TIniFile;
+  lSections : TStringList;
+  lSection : String;
+  lMedia : PFresnelUserMedia;
+  i : Integer;
+begin
+  lStream := TStringStream.Create(iniFileData);
+  try
+    lIniFile := TIniFile.Create(lStream);
+    try
+      lSections := TStringList.Create;
+      try
+        lIniFile.ReadSections(lSections);
+        SetLength(FList, lSections.Count);
+        for i := 0 to lSections.Count-1 do
+        begin
+          lSection := lSections[i];
+          lMedia := @FList[i];
+          lMedia^.FDeviceID := lIniFile.ReadString(lSection, 'deviceId', '');
+          lMedia^.FGroupID := lIniFile.ReadString(lSection, 'groupId', '');
+          lMedia^.FKindString := lIniFile.ReadString(lSection, 'kind', '');
+          lMedia^.FLabel := lIniFile.ReadString(lSection, 'label', '');
+          if lMedia^.FKindString = 'videoinput' then
+            lMedia^.FKind := fumkVideoInput
+          else if lMedia^.FKindString = 'audioinput' then
+            lMedia^.FKind := fumkAudioInput
+          else if lMedia^.FKindString = 'audiooutput' then
+            lMedia^.FKind := fumkAudioOutput;
+        end;
+      finally
+        FreeAndNil(lSections);
+      end;
+    finally
+      FreeAndNil(lIniFile);
+    end;
+  finally
+    FreeAndNil(lStream);
+  end;
+end;
+
+// Count
+//
+function TFresnelUserMedias.Count: Integer;
+begin
+  Result := Length(FList);
+end;
+
+// GetMediaByDeviceID
+//
+function TFresnelUserMedias.GetMediaByDeviceID(const aDeviceID : String) : TFresnelUserMedia;
+var
+  i : Integer;
+begin
+  for i := 0 to High(FList) do
+  begin
+    if FList[i].DeviceID = aDeviceID then
+      Exit(FList[i]);
+  end;
+  raise Exception.CreateFmt('GetMediaByDeviceID no device of ID "%s"', [ aDeviceID ])
+end;
+
+// EnumerateByKind
+//
+function TFresnelUserMedias.EnumerateByKind(aKind : TFresnelUserMediaKind) : TFresnelUserMediaDynArray;
+var
+  i, n : Integer;
+begin
+  n := 0;
+  for i := 0 to High(FList) do
+    if FList[i].Kind = aKind then
+      Inc(n);
+  SetLength(Result, n);
+  n := 0;
+  for i := 0 to High(FList) do
+  begin
+    if FList[i].Kind = aKind then
+    begin
+      Result[n] := FList[i];
+      Inc(n);
+    end;
+  end;
+end;
+
+end.
+

+ 292 - 104
src/wasm/fresnel.wasm.api.pp

@@ -13,84 +13,112 @@
 
  **********************************************************************}
 
-
 unit fresnel.wasm.api;
 
 {$mode objfpc}{$H+}
 
 // Define this if you want to remove logging code.
-{ $DEFINE NOFRESNELLOG}
+{$DEFINE NOFRESNELLOG}
 
 interface
 
 uses fresnel.wasm.shared;
 
+type
+  TFresnelWindowCanvasID = LongInt;
+  TFresnelOffscreenCanvasID = LongInt;
+  TFresnelVideoID = LongInt;
+
+
 { ---------------------------------------------------------------------
   Canvas API
   ---------------------------------------------------------------------}
 
-function __fresnel_canvas_allocate(
-  SizeX : Longint;
-  SizeY : Longint;
-  aID: PCanvasID
-): TCanvasError; external 'fresnel_api' name 'canvas_allocate';
+function __fresnel_canvas_allocate_window(
+  aSizeX : LongInt;
+  aSizeY : LongInt;
+  aID : PWindowCanvasID;
+  aDevicePixelRatio : PFresnelFloat;
+  aPopup : Boolean
+): TCanvasError; external 'fresnel_api' name 'canvas_allocate_window';
+
+function __fresnel_canvas_deallocate_window(
+  aID: TFresnelWindowCanvasID
+): TCanvasError; external 'fresnel_api' name 'canvas_deallocate_window';
 
 function __fresnel_canvas_allocate_offscreen(
-  SizeX : Longint;
-  SizeY : Longint;
+  aSizeX : Longint;
+  aSizeY : Longint;
+  aScale : TFresnelFloat;
   aImageData : PByte;
-  aID: PCanvasID
+  aID: PWindowCanvasID
 ): TCanvasError; external 'fresnel_api' name 'canvas_allocate_offscreen';
 
-
-
-function __fresnel_canvas_deallocate(
-  aID: TCanvasID
-): TCanvasError; external 'fresnel_api' name 'canvas_deallocate';
-
-
-function __fresnel_canvas_getbyid(
-  PElementID : PByte;
-  Len : Longint;
-  aID: PCanvasID
-): TCanvasError; external 'fresnel_api' name 'canvas_getbyid';
-
-
-function __fresnel_canvas_getsizes(
-  aID : TCanvasID;
-  aWidth: PFresnelFloat;
-  aHeight: PFresnelFloat
-): TCanvasError; external 'fresnel_api' name 'canvas_getsizes';
-
-function __fresnel_canvas_setsizes(
-  aID : TCanvasID;
-  aWidth: TFresnelFloat;
-  aHeight: TFresnelFloat
-): TCanvasError; external 'fresnel_api' name 'canvas_setsizes';
+function __fresnel_canvas_deallocate_offscreen(
+  aID: TFresnelWindowCanvasID
+): TCanvasError; external 'fresnel_api' name 'canvas_deallocate_offscreen';
+
+function __fresnel_canvas_resize_offscreen(
+  aID: TFresnelWindowCanvasID;
+  aSizeX : Longint;
+  aSizeY : Longint;
+  aScale : TFresnelFloat
+): TCanvasError; external 'fresnel_api' name 'canvas_resize_offscreen';
+
+function __fresnel_window_show_hide(
+  aID: TFresnelWindowCanvasID;
+  aShow : Boolean;
+  aParentID: TFresnelWindowCanvasID
+): TCanvasError; external 'fresnel_api' name 'window_show_hide';
+
+function __fresnel_canvas_draw_offscreen_on_window(
+  aWindowID: TFresnelWindowCanvasID;
+  aCanvasID: TFresnelOffscreenCanvasID
+): TCanvasError; external 'fresnel_api' name 'canvas_draw_offscreen_on_window';
+
+function __fresnel_canvas_getrect(
+  aID : TFresnelWindowCanvasID;
+  aRectF : PFresnelFloat
+): TCanvasError; external 'fresnel_api' name 'canvas_getrect';
+
+function __fresnel_canvas_setrect(
+  aID : TFresnelWindowCanvasID;
+  aLeft, aTop, aRight, aBottom : TFresnelFloat
+): TCanvasError; external 'fresnel_api' name 'canvas_setrect';
+
+function __fresnel_canvas_getsize(
+  aID : TFresnelWindowCanvasID;
+  aPointF: PFresnelFloat
+): TCanvasError; external 'fresnel_api' name 'canvas_getsize';
+
+function __fresnel_canvas_setsize(
+  aID : TFresnelWindowCanvasID;
+  aWidth, aHeight: TFresnelFloat
+): TCanvasError; external 'fresnel_api' name 'canvas_setsize';
 
 
 function __fresnel_canvas_moveto(
-  aID : TCanvasID;
+  aID : TFresnelOffscreenCanvasID;
   X : TFresnelFloat;
   Y : TFresnelFloat
 ):  TCanvasError; external 'fresnel_api' name 'canvas_moveto';
 
 function __fresnel_canvas_lineto(
-  aID : TCanvasID;
+  aID : TFresnelOffscreenCanvasID;
   X : TFresnelFloat;
   Y : TFresnelFloat
 ):  TCanvasError; external 'fresnel_api' name 'canvas_lineto';
 
 function __fresnel_canvas_stroke(
-  aID : TCanvasID
+  aID : TFresnelOffscreenCanvasID
 ):  TCanvasError; external 'fresnel_api' name 'canvas_stroke';
 
 function __fresnel_canvas_beginpath(
-  aID : TCanvasID
+  aID : TFresnelOffscreenCanvasID
 ):  TCanvasError; external 'fresnel_api' name 'canvas_beginpath';
 
 function __fresnel_canvas_arc(
-  aID : TCanvasID;
+  aID : TFresnelOffscreenCanvasID;
   X : TFresnelFloat;
   Y : TFresnelFloat;
   RadiusX : TFresnelFloat;
@@ -103,7 +131,7 @@ function __fresnel_canvas_arc(
 
 
 function __fresnel_canvas_fillrect(
-  aID : TCanvasID;
+  aID : TFresnelOffscreenCanvasID;
   X : TFresnelFloat;
   Y : TFresnelFloat;
   Width : TFresnelFloat;
@@ -111,7 +139,7 @@ function __fresnel_canvas_fillrect(
 ):  TCanvasError; external 'fresnel_api' name 'canvas_fillrect';
 
 function __fresnel_canvas_strokerect(
-  aID : TCanvasID;
+  aID : TFresnelOffscreenCanvasID;
   X : TFresnelFloat;
   Y : TFresnelFloat;
   Width : TFresnelFloat;
@@ -119,21 +147,21 @@ function __fresnel_canvas_strokerect(
 ):  TCanvasError; external 'fresnel_api' name 'canvas_strokerect';
 
 function __fresnel_canvas_roundrect(
-  aID : TCanvasID;
+  aID : TFresnelOffscreenCanvasID;
   aFlags : longint;
   aData : PCanvasRoundRectData
 ):  TCanvasError; external 'fresnel_api' name 'canvas_roundrect';
 
 function __fresnel_canvas_clearrect(
-  aID : TCanvasID;
+  aID : TFresnelOffscreenCanvasID;
   X : TFresnelFloat;
   Y : TFresnelFloat;
-  Width : Longint;
-  Height : Longint
+  Width : TFresnelFloat;
+  Height : TFresnelFloat
 ):  TCanvasError; external 'fresnel_api' name 'canvas_clearrect';
 
 function __fresnel_canvas_stroketext(
-  aID : TCanvasID;
+  aID : TFresnelOffscreenCanvasID;
   X : TFresnelFloat;
   Y : TFresnelFloat;
   aText : PByte;
@@ -141,32 +169,30 @@ function __fresnel_canvas_stroketext(
 ):  TCanvasError; external 'fresnel_api' name 'canvas_stroketext';
 
 function __fresnel_canvas_filltext(
-  aID : TCanvasID;
-  X : TFresnelFloat;
-  Y : TFresnelFloat;
+  aID : TFresnelOffscreenCanvasID;
+  aX : TFresnelFloat;
+  aY : TFresnelFloat;
   aText : PByte;
-  aTextLen : Longint
+  aTextLen : Longint;
+  aOpacity : TFresnelFloat
 ):  TCanvasError; external 'fresnel_api' name 'canvas_filltext';
 
 function __fresnel_canvas_set_fillstyle(
-  aID : TCanvasID;
+  aID : TFresnelOffscreenCanvasID;
   aRed : Longint;
   aGreen: Longint;
   aBlue : Longint;
   aAlpha : Longint
 ):  TCanvasError; external 'fresnel_api' name 'canvas_set_fillstyle';
 
-function __fresnel_canvas_clear(
-  aID : TCanvasID;
-  aRed : Longint;
-  aGreen: Longint;
-  aBlue : Longint;
-  aAlpha : Longint
-):  TCanvasError; external 'fresnel_api' name 'canvas_clear';
-
+function __fresnel_canvas_set_fillstyle_string(
+  aID : TFresnelOffscreenCanvasID;
+  aTextPtr : TWasmPointer;
+  atextLen : LongInt
+):  TCanvasError; external 'fresnel_api' name 'canvas_set_fillstyle_string';
 
 function __fresnel_canvas_set_strokestyle(
-  aID : TCanvasID;
+  aID : TFresnelOffscreenCanvasID;
   aRed : Longint;
   aGreen: Longint;
   aBlue : Longint;
@@ -174,45 +200,46 @@ function __fresnel_canvas_set_strokestyle(
 ):  TCanvasError; external 'fresnel_api' name 'canvas_set_strokestyle';
 
 function __fresnel_canvas_set_linewidth(
-  aID : TCanvasID;
+  aID : TFresnelOffscreenCanvasID;
   aWidth : TCanvasLineWidth
 ):  TCanvasError; external 'fresnel_api' name 'canvas_set_linewidth';
 
 function __fresnel_canvas_set_linecap(
-  aID : TCanvasID;
+  aID : TFresnelOffscreenCanvasID;
   aWidth : TCanvasLinecap
 ):  TCanvasError; external 'fresnel_api' name 'canvas_set_linecap';
 
 function __fresnel_canvas_set_linejoin(
-  aID : TCanvasID;
+  aID : TFresnelOffscreenCanvasID;
   aWidth : TCanvasLineJoin
 ):  TCanvasError; external 'fresnel_api' name 'canvas_set_linejoin';
 
 function __fresnel_canvas_set_linemiterlimit(
-  aID : TCanvasID;
+  aID : TFresnelOffscreenCanvasID;
   aWidth : TCanvasLineMiterLimit
 ):  TCanvasError; external 'fresnel_api' name 'canvas_set_linemiterlimit';
 
 function __fresnel_canvas_set_textbaseline(
-  aID : TCanvasID;
+  aID : TFresnelOffscreenCanvasID;
   aWidth : TCanvasTextBaseLine
 ):  TCanvasError; external 'fresnel_api' name 'canvas_set_textbaseline';
 
 
-function __fresnel_canvas_set_linedash(  aID : TCanvasID;
+function __fresnel_canvas_set_linedash(
+  aID : TFresnelOffscreenCanvasID;
   aOffset : TFresnelFLoat;
   aPatternCount : longint;
   aPattern : PLineDashPatternData
 ):  TCanvasError; external 'fresnel_api' name 'canvas_set_linedash';
 
 function __fresnel_canvas_set_font(
-  aID : TCanvasID;
+  aID : TFresnelOffscreenCanvasID;
   aFontName : PByte;
   aFontNameLen : Longint
 ):  TCanvasError; external 'fresnel_api' name 'canvas_set_font';
 
 function __fresnel_canvas_measure_text(
-  aID : TCanvasID;
+  aID : TFresnelOffscreenCanvasID;
   aText : PByte;
   aTextLen : Longint;
   aWidth : PFresnelFLoat;
@@ -220,7 +247,7 @@ function __fresnel_canvas_measure_text(
 ):  TCanvasError; deprecated 'use float versions instead';
 
 function __fresnel_canvas_measure_text(
-  aID : TCanvasID;
+  aID : TFresnelOffscreenCanvasID;
   aText : PByte;
   aTextLen : Longint;
   Out aWidth,aHeight,aAscender,aDescender : TFresnelFloat
@@ -228,32 +255,35 @@ function __fresnel_canvas_measure_text(
 
 
 function __fresnel_canvas_measure_text(
-  aID : TCanvasID;
+  aID : TFresnelOffscreenCanvasID;
   aText : PByte;
   aTextLen : Longint;
   aData : PCanvasMeasureTextData
 ):  TCanvasError; external 'fresnel_api' name 'canvas_measure_text';
 
 
-function __fresnel_canvas_set_textshadow_params (aID : TCanvasID;
+function __fresnel_canvas_set_textshadow_params (
+    aID : TFresnelOffscreenCanvasID;
     aOffsetX,aOffsetY,aRadius : TFresnelFLoat;
     aRed,aGreen,aBlue,aAlpha : Longint
 ):  TCanvasError; external 'fresnel_api' name 'canvas_set_textshadow_params';
 
-function __fresnel_canvas_linear_gradient_fillstyle(aID : TCanvasID;
+function __fresnel_canvas_linear_gradient_fillstyle(
+    aID : TFresnelOffscreenCanvasID;
     aStartX,aStartY,aEndX,aEndY : TFresnelFLoat;
     aColorPointCount : longint;
     aColorPoints : PGradientColorPoints
 ):  TCanvasError; external 'fresnel_api' name 'canvas_linear_gradient_fillstyle';
 
-function __fresnel_canvas_image_fillstyle(aID : TCanvasID;
+function __fresnel_canvas_image_fillstyle(
+    aID : TFresnelOffscreenCanvasID;
     aFlags,aImageWidth,aImageHeight : Longint;
     aImageData : PByte
 ):  TCanvasError; external 'fresnel_api' name 'canvas_image_fillstyle';
 
 // Image in RGBA
 function __fresnel_canvas_draw_image(
-  aID : TCanvasID;
+  aID : TFresnelOffscreenCanvasID;
   aX : TFresnelFLoat;
   aY : TFresnelFLoat;
   aWidth : TFresnelFLoat;
@@ -264,13 +294,36 @@ function __fresnel_canvas_draw_image(
 ):  TCanvasError; external 'fresnel_api' name 'canvas_draw_image';
 
 function __fresnel_canvas_draw_image_ex(
-  aID : TCanvasID;
+  aID : TFresnelOffscreenCanvasID;
   aDrawData : PFresnelFloat;
   aImageData : PByte
 ):  TCanvasError; external 'fresnel_api' name 'canvas_draw_image_ex';
 
+function __fresnel_canvas_draw_image_from_canvas(
+  aID : TFresnelOffscreenCanvasID;
+  aDrawData : PFresnelFloat;
+  aSourceCanvas : TFresnelOffscreenCanvasID;
+  aOpacity : TFresnelFloat
+):  TCanvasError; external 'fresnel_api' name 'canvas_draw_image_from_canvas';
+
+function __fresnel_canvas_draw_imagebitmap(
+  aID : TFresnelOffscreenCanvasID;
+  aDrawData : PFresnelFloat;
+  aImageBitmapID : Integer;
+  aOpacity : TFresnelFloat
+):  TCanvasError; external 'fresnel_api' name 'canvas_draw_imagebitmap';
+
+function  __fresnel_canvas_release_imagebitmap(
+  aImageBitmapID : Integer
+):  TCanvasError; external 'fresnel_api' name 'canvas_release_imagebitmap';
+
+function __fresnel_canvas_imagebitmap_getsize(
+  aImageBitmapID : Integer;
+  aSizePtr : TWasmPointer
+):  TCanvasError; external 'fresnel_api' name 'canvas_imagebitmap_getsize';
+
 function __fresnel_canvas_point_in_path(
-  aID : TCanvasID;
+  aID : TFresnelOffscreenCanvasID;
   aX : TFresnelFLoat;
   aY : TFresnelFLoat;
   aPointCount : Longint;
@@ -279,7 +332,7 @@ function __fresnel_canvas_point_in_path(
 ):  TCanvasError; external 'fresnel_api' name 'canvas_point_in_path';
 
 function __fresnel_canvas_draw_path(
-  aID : TCanvasID;
+  aID : TFresnelOffscreenCanvasID;
   aFlags : Longint;
   aPointCount : Integer;
   aPointData : PFresnelFloat
@@ -287,8 +340,7 @@ function __fresnel_canvas_draw_path(
 
 
 function __fresnel_canvas_set_transform(
- aID : TCanvasID;
- Flags : Longint;
+ aID : TFresnelOffscreenCanvasID;
  m11,m12,m21,m22,m31,m32 : TFresnelFLoat) : TCanvasError; external 'fresnel_api' name 'canvas_set_transform';
 
 function __fresnel_canvas_get_viewport_sizes(
@@ -296,38 +348,59 @@ function __fresnel_canvas_get_viewport_sizes(
  aWidth,aHeight : PFresnelFLoat) : TCanvasError; external 'fresnel_api' name 'canvas_get_viewport_sizes';
 
 function __fresnel_canvas_set_title(
-  aID : TCanvasID;
+  aID : TFresnelWindowCanvasID;
   aTitle : PByte;
   aTitleLen : Longint
 ):  TCanvasError; external 'fresnel_api' name 'canvas_set_title';
 
 function __fresnel_canvas_save_state(
-  aID : TCanvasID;
-  Flags : Longint
+  aID : TFresnelOffscreenCanvasID
 ):  TCanvasError; external 'fresnel_api' name 'canvas_save_state';
 
 function __fresnel_canvas_restore_state(
-  aID : TCanvasID;
-  Flags : Longint
+  aID : TFresnelOffscreenCanvasID
 ):  TCanvasError; external 'fresnel_api' name 'canvas_restore_state';
 
+function __fresnel_canvas_restore_and_save_state(
+  aID : TFresnelOffscreenCanvasID
+):  TCanvasError; external 'fresnel_api' name 'canvas_restore_and_save_state';
+
 function __fresnel_canvas_clip_add_rect(
-  aID : TCanvasID;
+  aID : TFresnelOffscreenCanvasID;
   X : TFresnelFloat;
   Y : TFresnelFloat;
   Width : TFresnelFloat;
   Height : TFresnelFloat
 ):  TCanvasError; external 'fresnel_api' name 'canvas_clip_add_rect';
 
+function __fresnel_canvas_clip_add_polygon(
+  aID : TFresnelOffscreenCanvasID;
+  APolygonData : TWasmPointer; APolygonCount : Integer;
+  AClipQuadData : TWasmPointer; ANbClipQuads : Integer
+):  TCanvasError; external 'fresnel_api' name 'canvas_clip_add_polygon';
+
+{ ---------------------------------------------------------------------
+  Cursor API
+  ---------------------------------------------------------------------}
+
+function __fresnel_cursor_set(
+  aTextUTF16 : TWasmPointer;
+  aUTF16Size : LongInt
+):  TCanvasError; external 'fresnel_api' name 'cursor_set';
 
 { ---------------------------------------------------------------------
   Timer API
   ---------------------------------------------------------------------}
 
 function __fresnel_timer_allocate(ainterval : longint; userdata: pointer) : TTimerID; external 'fresnel_api' name 'timer_allocate';
-
 procedure __fresnel_timer_deallocate(timerid: TTimerID); external 'fresnel_api' name 'timer_deallocate';
 
+{ ---------------------------------------------------------------------
+  RequestAnimationFrame API
+  ---------------------------------------------------------------------}
+
+procedure __fresnel_request_animation_frame(userdata: pointer); external 'fresnel_api' name 'request_animation_frame';
+
 { ---------------------------------------------------------------------
   Event API
   ---------------------------------------------------------------------}
@@ -335,9 +408,9 @@ procedure __fresnel_timer_deallocate(timerid: TTimerID); external 'fresnel_api'
 // note that the events are for a single canvas !
 
 function __fresnel_event_get(
-  aID : PCanvasID;
-  aMsg : PCanvasMessageID;
-  aData : PCanvasMessageData
+  aID : PWindowCanvasID;
+  aMsg : PWindowMessageID;
+  aData : PWindowMessageData
 ):  TCanvasError; external 'fresnel_api' name 'event_get';
 
 function __fresnel_event_count(
@@ -349,6 +422,8 @@ function __fresnel_event_set_special_keymap(
   aCount : Longint
 ):  TCanvasError; external 'fresnel_api' name 'event_set_special_keymap';
 
+procedure __fresnel_wake_main_thread(); external 'fresnel_api' name 'wake_main_thread';
+
 Type
 
   TFresnelLogLevel = (fllTrace, fllDebug, fllInfo, fllWarning, fllError, fllCritical);
@@ -359,7 +434,10 @@ Type
   TFresnelTimerTickEvent = Procedure (aTimerID : TTimerID; userdata : pointer; var aContinue : Boolean);
   TFresnelLogHook = procedure (const Msg : string) of object;
   TFresnelLogLevelHook = procedure (Level : TFresnelLogLevel; const Msg : string) of object;
-  TFresnelMenuClickEvent = procedure(aMenuID : TMenuID; aData : Pointer) of object;
+  TFresnelMenuClickEvent = procedure (aMenuID : TMenuID; aData : Pointer) of object;
+  TFresnelAnimationFrameEvent = procedure (aUserData : Pointer) of object;
+  TFresnelUserMediaEnumeratedEvent = procedure(aUTF16Size : Integer; aUserData : Pointer) of object;
+  TFresnelUserMediaFrameEvent = procedure (aTimeStamp : Double; aVideoID : TVideoElementID; aImageBitmapID : Integer);
 
 { ---------------------------------------------------------------------
   Menu API
@@ -367,7 +445,7 @@ Type
 
 
 function __fresnel_menu_add_item(
-  aID : TCanvasID;
+  aID : TFresnelWindowCanvasID;
   aParent : TMenuID;
   aCaption : PByte;
   aCaptionLen : Longint;
@@ -378,32 +456,92 @@ function __fresnel_menu_add_item(
 ) : TCanvasError; external 'fresnel_api' name 'menu_add_item';
 
 function __fresnel_menu_remove_item(
-  aID : TCanvasID;
+  aID : TFresnelWindowCanvasID;
   aMenuID : TMenuID
 ) : TCanvasError; external 'fresnel_api' name 'menu_remove_item';
 
 function __fresnel_menu_update_item(
-  aID : TCanvasID;
+  aID : TFresnelWindowCanvasID;
   aMenuID : TMenuID;
   aFlags : longint;
   aShortCut : Longint
 ) : TCanvasError; external 'fresnel_api' name 'menu_update_item';
 
+{ ---------------------------------------------------------------------
+  Ckipboard API
+  ---------------------------------------------------------------------}
+
+function __fresnel_read_clipboard_text(
+  aUTF16Size : TWasmPointer;
+  aDataUTF16 : TWasmPointer
+) : TCanvasError; external 'fresnel_api' name 'clipboard_read_text';
+
+function __fresnel_write_clipboard_text(
+  aTextUTF16 : TWasmPointer;
+  aUTF16Size : LongInt
+) : TCanvasError; external 'fresnel_api' name 'clipboard_write_text';
+
+{ ---------------------------------------------------------------------
+  UserMedia API
+  ---------------------------------------------------------------------}
+
+function __fresnel_usermedia_enumerate(
+  aUserData : TWasmPointer
+) : TCanvasError; external 'fresnel_api' name 'usermedia_enumerate';
+
+function __fresnel_usermedia_getenumerated(
+  aUTF16Size : TWasmPointer;
+  aDataUTF16 : TWasmPointer
+) : TCanvasError; external 'fresnel_api' name 'usermedia_getenumerated';
+
+function __fresnel_usermedia_startcapture(
+  aDeviceID_UTF16 : TWasmPointer; aDeviceID_UTF16Size : Integer;
+  aVideoID : TWasmPointer;
+  aResolutionWidth, aResolutionHeight : Integer;
+  aOptions : Integer
+) : TCanvasError; external 'fresnel_api' name 'usermedia_startcapture';
+
+function __fresnel_usermedia_stopcapture(
+  aVideoID : TFresnelVideoID
+) : TCanvasError; external 'fresnel_api' name 'usermedia_stopcapture';
+
+function __fresnel_usermedia_iscapturing(
+  aVideoID : TFresnelVideoID
+) : TCanvasError; external 'fresnel_api' name 'usermedia_iscapturing';
+
+{ ---------------------------------------------------------------------
+  Debug API
+  ---------------------------------------------------------------------}
+
+// synchronous and unconditional console.log()
+procedure __fresnel_console_log(
+  aTextUTF16 : TWasmPointer;
+  aUTF16Size : LongInt
+); external 'fresnel_api' name 'console_log';
+procedure __fresnel_console_log(const msg : String);
 
 var
   OnFresnelWasmTick : TFresnelTickEvent;
   OnFresnelProcessMessage : TFresnelProcessMessageEvent;
+  OnFresnelMainThreadWake : TProcedure;
   OnFresnelTimerTick : TFresnelTimerTickEvent;
   OnFresnelLog : TFresnelLogHook deprecated 'Use OnFresnelLogLevel';
   OnFresnelLogLevel : TFresnelLogLevelHook;
   OnFresnelMenuClick : TFresnelMenuClickEvent;
+  OnFresnelAnimationFrame : TFresnelAnimationFrameEvent;
+  OnFresnelUserMediaEnumerated : TFresnelUserMediaEnumeratedEvent;
+  OnFresnelUserMediaFrame : TFresnelUserMediaFrameEvent;
 
 { Exported functions }
 
-procedure __fresnel_tick (aCurrent,aPrevious : double);
-procedure __fresnel_process_message (aCurrent,aPrevious : double);
+procedure __fresnel_tick (aCurrent,aPrevious : LongInt);
+procedure __fresnel_process_message (aCurrent, aPrevious : LongInt);
+procedure __fresnel_main_thread_wake();
+
 function __fresnel_timer_tick(timerid: TTimerID; userdata : pointer) : boolean;
 procedure __fresnel_menu_click(menuid: TMenuID; userdata : pointer);
+procedure __fresnel_animation_frame(userData : Pointer);
+procedure __fresnel_usermedia_enumerated(aUTF16Size : LongInt; aUserData : Pointer);
 
 
 procedure __fresnel_log(aLevel : TFresnelLogLevel; Const Msg : string);
@@ -428,7 +566,12 @@ begin
   Result:=Round(len*FresnelScaleFactor);
 end;
 
-function __fresnel_canvas_measure_text(aID: TCanvasID; aText: PByte; aTextLen: Longint; aWidth: PFresnelFloat; aHeight: PFresnelFloat
+function __fresnel_canvas_measure_text(
+  aID: TFresnelOffscreenCanvasID;
+  aText: PByte;
+  aTextLen: Longint;
+  aWidth: PFresnelFloat;
+  aHeight: PFresnelFloat
   ): TCanvasError;
 
 var
@@ -444,8 +587,12 @@ begin
     end;
 end;
 
-function __fresnel_canvas_measure_text(aID: TCanvasID; aText: PByte; aTextLen: Longint; out aWidth, aHeight, aAscender,
-  aDescender: Single): TCanvasError;
+function __fresnel_canvas_measure_text(
+  aID: TFresnelOffscreenCanvasID;
+  aText: PByte;
+  aTextLen: Longint;
+  out aWidth, aHeight, aAscender, aDescender: Single
+  ): TCanvasError;
 var
   Data : TCanvasMeasureTextData;
 
@@ -461,18 +608,25 @@ begin
     end;
 end;
 
-procedure __fresnel_tick (aCurrent,aPrevious : double);
+procedure __fresnel_tick (aCurrent,aPrevious : LongInt);
 
 begin
   if assigned(OnFresnelWasmTick) then
     OnFresnelWasmTick(aCurrent,aPrevious);
 end;
 
-procedure __fresnel_process_message (aCurrent,aPrevious : double);
+// __fresnel_process_message
+//
+procedure __fresnel_process_message(aCurrent,aPrevious : LongInt);
+begin
+  if Assigned(OnFresnelProcessMessage) then
+    OnFresnelProcessMessage(aCurrent, aPrevious);
+end;
 
+procedure __fresnel_main_thread_wake();
 begin
-  if assigned(OnFresnelProcessMessage) then
-    OnFresnelProcessMessage(aCurrent,aPrevious);
+  if Assigned(OnFresnelMainThreadWake) then
+    OnFresnelMainThreadWake();
 end;
 
 procedure __fresnel_log(aLevel : TFresnelLogLevel; Const Msg : string);
@@ -526,12 +680,46 @@ begin
     OnFresnelMenuClick(menuid,userdata)
 end;
 
+// __fresnel_animation_frame
+//
+procedure __fresnel_animation_frame(userData : Pointer);
+begin
+  if Assigned(OnFresnelAnimationFrame) then
+    OnFresnelAnimationFrame(userData);
+end;
+
+// __fresnel_usermedia_enumerated
+//
+procedure __fresnel_usermedia_enumerated(aUTF16Size: LongInt; aUserData: Pointer);
+begin
+  if Assigned(OnFresnelUserMediaEnumerated) then
+    OnFresnelUserMediaEnumerated(aUTF16Size, aUserData);
+end;
+
+// __fresnel_usermedia_frame
+//
+procedure __fresnel_usermedia_frame(aTimeStamp : TFresnelFloat; aVideoID : TVideoElementID; aImageBitmapID : Integer);
+begin
+  if Assigned(OnFresnelUserMediaFrame) then
+    OnFresnelUserMediaFrame(aTimeStamp, aVideoID, aImageBitmapID);
+end;
+
+// __fresnel_console_log (String)
+//
+procedure __fresnel_console_log(const msg : String);
+begin
+  __fresnel_console_log(PByte(PWideChar(msg)), Length(msg));
+end;
 
 exports
   __fresnel_process_message,
+  __fresnel_main_thread_wake,
   __fresnel_timer_tick,
   __fresnel_menu_click,
-  __fresnel_tick;
+  __fresnel_tick,
+  __fresnel_animation_frame,
+  __fresnel_usermedia_enumerated,
+  __fresnel_usermedia_frame;
 
 end.
 

+ 78 - 61
src/wasm/fresnel.wasm.app.pp

@@ -21,7 +21,8 @@ interface
 
 uses
   Classes, SysUtils, CustApp, Fresnel.Forms, Fresnel.Classes, Fresnel.WidgetSet,
-  System.UITypes, fresnel.Events, fresnel.wasm.shared, fresnel.wasm.render;
+  System.UITypes, fresnel.Events, fresnel.wasm.shared, fresnel.wasm.render, fresnel.wasm.font,
+  fresnel.app;
 
 Type
   EWasmFresnel = class(EFresnel);
@@ -31,8 +32,12 @@ Type
 
   TFresnelWasmForm = class(TFresnelWSForm)
   private
-    FCanvasID: TCanvasID;
+    FWidth,
+    FHeight : TFResnelFloat;
+    FWindowID : TWindowCanvasID;
+    FCanvasID: TOffscreenCanvasID;
     FForm: TFresnelCustomForm;
+    FPixelRatio : TFresnelFloat;
   protected
     procedure SetForm(aForm : TFresnelCustomForm);
     function GetCaption: TFresnelCaption; override;
@@ -48,7 +53,8 @@ Type
     function GetClientSize: TFresnelPoint; override;
     Procedure InitForm(aForm : TFresnelCustomForm);
     procedure InvalidateRect(const aRect: TFresnelRect); override;
-    property CanvasID : TCanvasID read FCanvasID;
+    property CanvasID : TOffscreenCanvasID read FCanvasID;
+    property WindowID : TWindowCanvasID read FWindowID;
     property form : TFresnelCustomForm Read FForm;
     property Renderer : TWasmFresnelRenderer Read GetFresnelRenderer;
   end;
@@ -58,28 +64,29 @@ Type
   TFresnelWasmWidgetSet = class(TFresnelWidgetSet)
   Private
     FForms : TFPList;
+    FFontEngine: TFresnelWasmFontEngine;
     function GetWasmForm(aIndex : Cardinal): TFresnelWasmForm;
     function GetWasmFormCount: Cardinal;
     // Event handling
-    procedure HandleFresnelEnterEvent(aForm: TFresnelWasmForm; Data: PCanvasMessageData);
-    procedure HandleFresnelKeyDownEvent(aForm: TFresnelWasmForm; Data: PCanvasMessageData);
-    procedure HandleFresnelKeyUpEvent(aForm: TFresnelWasmForm; Data: PCanvasMessageData);
-    procedure HandleFresnelLeaveEvent(aForm: TFresnelWasmForm; Data: PCanvasMessageData);
-    procedure HandleFresnelMouseClickEvent(aForm: TFresnelWasmForm; Data: PCanvasMessageData);
-    procedure HandleFresnelMouseDoubleClickEvent(aForm: TFresnelWasmForm; Data: PCanvasMessageData);
-    procedure HandleFresnelMouseDownEvent(aForm: TFresnelWasmForm; Data: PCanvasMessageData);
-    procedure HandleFresnelMouseMoveEvent(aForm: TFresnelWasmForm; Data: PCanvasMessageData);
-    procedure HandleFresnelMouseScrollEvent(aForm: TFresnelWasmForm; Data: PCanvasMessageData);
-    procedure HandleFresnelMouseUpEvent(aForm: TFresnelWasmForm; Data: PCanvasMessageData);
-    procedure HandleFresnelEvents(aForm: TFresnelWasmForm; Msg: TCanvasMessageID; Data: PCanvasMessageData);
-    class procedure InitMouseXYEvent(out EvtInit: TFresnelMouseEventInit; Data: PCanvasMessageData);
+    procedure HandleFresnelEnterEvent(aForm: TFresnelWasmForm; Data: PWindowMessageData);
+    procedure HandleFresnelKeyDownEvent(aForm: TFresnelWasmForm; Data: PWindowMessageData);
+    procedure HandleFresnelKeyUpEvent(aForm: TFresnelWasmForm; Data: PWindowMessageData);
+    procedure HandleFresnelLeaveEvent(aForm: TFresnelWasmForm; Data: PWindowMessageData);
+    procedure HandleFresnelMouseClickEvent(aForm: TFresnelWasmForm; Data: PWindowMessageData);
+    procedure HandleFresnelMouseDoubleClickEvent(aForm: TFresnelWasmForm; Data: PWindowMessageData);
+    procedure HandleFresnelMouseDownEvent(aForm: TFresnelWasmForm; Data: PWindowMessageData);
+    procedure HandleFresnelMouseMoveEvent(aForm: TFresnelWasmForm; Data: PWindowMessageData);
+    procedure HandleFresnelMouseScrollEvent(aForm: TFresnelWasmForm; Data: PWindowMessageData);
+    procedure HandleFresnelMouseUpEvent(aForm: TFresnelWasmForm; Data: PWindowMessageData);
+    procedure HandleFresnelEvents(aForm: TFresnelWasmForm; Msg: TWindowMessageID; Data: PWindowMessageData);
+    class procedure InitMouseXYEvent(out EvtInit: TFresnelMouseEventInit; Data: PWindowMessageData);
   public
     Constructor Create(AOwner: TComponent); override;
     Destructor Destroy; override;
     procedure AppProcessMessages; override;
     procedure AppTerminate; override;
     procedure AppWaitMessage; override;
-    Function FindFormByCanvasId(ID : TCanvasID) : TFresnelWasmForm;
+    Function FindFormByWindowId(ID : TWindowCanvasID) : TFresnelWasmForm;
     procedure CreateWSForm(aFresnelForm: TFresnelComponent); override;
     Property WasmForms[aIndex : Cardinal] : TFresnelWasmForm Read GetWasmForm;
     Property WasmFormCount : Cardinal Read GetWasmFormCount;
@@ -87,7 +94,7 @@ Type
 
   { TFresnelWasmApplication }
 
-  TFresnelWasmApplication = class(TFresnelBaseApplication)
+  TFresnelWasmApplication = class(TFresnelApplication)
   private
     FLastTick: Int64;
     FPrevTick: Int64;
@@ -96,7 +103,6 @@ Type
   protected
     procedure DoTick(aCurrent, aPrevious: Double); virtual;
     Procedure DoLog(EventType : TEventType; const Msg : String);  override;
-    procedure CreateWidgetSet; virtual;
     procedure SetTickHook; virtual;
     procedure DoRun; override;
   public
@@ -111,7 +117,10 @@ Procedure DoneWasmApplication;
 
 implementation
 
-uses fresnel.Images, fresnel.wasm.font, fresnel.wasm.api;
+uses fresnel.dom, fresnel.Images, fresnel.wasm.api;
+
+var
+  WasmWidgetSet : TFresnelWasmWidgetSet;
 
 { TFresnelWasmForm }
 
@@ -136,10 +145,10 @@ var
 
 begin
   Result:=Default(TFresnelRect);
-  if __fresnel_canvas_getsizes(CanvasID,@aWidth,@aHeight)=ECANVAS_SUCCESS then
+//  if __fresnel_canvas_getsizes(CanvasID,@aWidth,@aHeight)=ECANVAS_SUCCESS then
     begin
-    Result.Right:=aWidth;
-    Result.Bottom:=aHeight;
+    Result.Right:=FWidth;
+    Result.Bottom:=FHeight;
     end;
 end;
 
@@ -151,17 +160,18 @@ end;
 
 procedure TFresnelWasmForm.SetCaption(AValue: TFresnelCaption);
 begin
-  FLLog(etWarning,'TFresnelWasmForm.SetCaption(''%s'') not implemented',[aValue]);
+  __fresnel_canvas_set_title(FWindowID.Win,PByte(aValue),Length(aValue));
 end;
 
 procedure TFresnelWasmForm.SetFormBounds(const AValue: TFresnelRect);
 begin
+  __fresnel_canvas_setsize(FWindowID.Win,aValue.Width,aValue.Width);
   FLLog(etWarning,'TFresnelWasmForm.SetFormBounds(''%s'') not implemented',[aValue.ToString]);
 end;
 
 procedure TFresnelWasmForm.SetVisible(const AValue: boolean);
 begin
-  FLLog(etWarning,'TFresnelWasmForm.SetVisible(%b) not implemented',[aValue]);
+  __fresnel_window_show_hide(FWindowID.Win,aValue,0);
 end;
 
 function TFresnelWasmForm.GetFresnelRenderer: TWasmFresnelRenderer;
@@ -201,26 +211,35 @@ begin
   FLLog(etDebug,'InitForm(%s) ',[aForm.ClassName]);
   SetForm(aForm);
   aForm.WSForm:=Self;
-  aWidth:=Round(aForm.Width);
-  if aWidth=0 then
-    aWidth:=640;
-  aHeight:=Round(aForm.Height);
-  if aHeight=0 then
-    aHeight:=480;
-  if __fresnel_canvas_allocate(aWidth,aHeight,@FCanvasID)<>ECANVAS_SUCCESS then
-     Raise EWasmFresnel.Create('Failed to allocate canvas');
+  FWidth:=Round(aForm.Width);
+  if FWidth=0 then
+    FWidth:=640;
+  FHeight:=Round(aForm.Height);
+  if FHeight=0 then
+    FHeight:=480;
+  aWidth:=Round(FWidth);
+  aHeight:=Round(FHeight);
+  Writeln('Addr : ',ptrint(@FWindowID));
+  if __fresnel_canvas_allocate_window(aWidth,aHeight,@FWindowID.win,@FPixelRatio,False)<>ECANVAS_SUCCESS then
+     Raise EWasmFresnel.Create('Failed to allocate window');
+  Writeln('Got window ID : ',FWindowID.Win);
+  if __fresnel_canvas_allocate_offscreen(aWidth,aHeight,FPixelRatio,Nil,@FCanvasID.Cnv)<>ECANVAS_SUCCESS then
+     Raise EWasmFresnel.Create('Failed to allocate window canvas');
+  Writeln('Got canvas ID : ',FCanvasID.Cnv);
+  FCanvasID.cnv:=FwindowID.win;
   Renderer.Canvas:=FCanvasID;
-  Form.WSDraw;
   aFontEngine:=TFresnelWasmFontEngine.Create(Self);
   aFontEngine.CanvasID:=Self.CanvasID;
   aForm.FontEngine:=aFontEngine;
-
+  Form.WSDraw;
+  __fresnel_canvas_draw_offscreen_on_window(FWindowID.Win,FCanvasID.Cnv);
 end;
 
 procedure TFresnelWasmForm.InvalidateRect(const aRect: TFresnelRect);
 begin
   FLLog(etDebug,'InvalidateRect(%s)',[aRect.ToString]);
   Form.WSDraw;
+  __fresnel_canvas_draw_offscreen_on_window(FWindowID.Win,FCanvasID.Cnv);
 end;
 
 { TFresnelWasmWidgetSet }
@@ -240,6 +259,9 @@ begin
   inherited Create(AOwner);
   Options:=[wsClick,wsDoubleClick];
   FForms:=TFPList.Create;
+  FFontEngine:=TFresnelWasmFontEngine.Create(nil);
+  Writeln('Setting TFresnelFontEngine.WSEngine');
+  TFresnelFontEngine.WSEngine:=FFontEngine;
 end;
 
 
@@ -261,7 +283,7 @@ begin
       Include(Result,S);
 end;
 
-class procedure TFresnelWasmWidgetSet.InitMouseXYEvent(out EvtInit: TFresnelMouseEventInit; Data : PCanvasMessageData);
+class procedure TFresnelWasmWidgetSet.InitMouseXYEvent(out EvtInit: TFresnelMouseEventInit; Data : PWindowMessageData);
 
 var
   Shift : TShiftState;
@@ -289,7 +311,7 @@ end;
 
 
 
-procedure TFresnelWasmWidgetSet.HandleFresnelMouseMoveEvent(aForm: TFresnelWasmForm; Data: PCanvasMessageData);
+procedure TFresnelWasmWidgetSet.HandleFresnelMouseMoveEvent(aForm: TFresnelWasmForm; Data: PWindowMessageData);
 
 var
   Init : TFresnelMouseEventInit;
@@ -300,7 +322,7 @@ begin
 end;
 
 
-Procedure TFresnelWasmWidgetSet.HandleFresnelMouseDownEvent(aForm: TFresnelWasmForm; Data: PCanvasMessageData);
+Procedure TFresnelWasmWidgetSet.HandleFresnelMouseDownEvent(aForm: TFresnelWasmForm; Data: PWindowMessageData);
 
 var
   Init : TFresnelMouseEventInit;
@@ -311,7 +333,7 @@ begin
 end;
 
 
-procedure TFresnelWasmWidgetSet.HandleFresnelMouseUpEvent(aForm: TFresnelWasmForm; Data: PCanvasMessageData);
+procedure TFresnelWasmWidgetSet.HandleFresnelMouseUpEvent(aForm: TFresnelWasmForm; Data: PWindowMessageData);
 
 var
   Init : TFresnelMouseEventInit;
@@ -322,7 +344,7 @@ begin
 end;
 
 
-procedure TFresnelWasmWidgetSet.HandleFresnelMouseScrollEvent(aForm: TFresnelWasmForm; Data: PCanvasMessageData);
+procedure TFresnelWasmWidgetSet.HandleFresnelMouseScrollEvent(aForm: TFresnelWasmForm; Data: PWindowMessageData);
 
 var
   Init : TFresnelMouseEventInit;
@@ -333,7 +355,7 @@ begin
 end;
 
 
-procedure TFresnelWasmWidgetSet.HandleFresnelMouseClickEvent(aForm: TFresnelWasmForm; Data: PCanvasMessageData);
+procedure TFresnelWasmWidgetSet.HandleFresnelMouseClickEvent(aForm: TFresnelWasmForm; Data: PWindowMessageData);
 
 var
   Init : TFresnelMouseEventInit;
@@ -344,7 +366,7 @@ begin
 end;
 
 
-Procedure TFresnelWasmWidgetSet.HandleFresnelMouseDoubleClickEvent(aForm: TFresnelWasmForm; Data: PCanvasMessageData);
+Procedure TFresnelWasmWidgetSet.HandleFresnelMouseDoubleClickEvent(aForm: TFresnelWasmForm; Data: PWindowMessageData);
 
 var
   Init : TFresnelMouseEventInit;
@@ -354,33 +376,33 @@ begin
 end;
 
 
-procedure TFresnelWasmWidgetSet.HandleFresnelEnterEvent(aForm: TFresnelWasmForm; Data: PCanvasMessageData);
+procedure TFresnelWasmWidgetSet.HandleFresnelEnterEvent(aForm: TFresnelWasmForm; Data: PWindowMessageData);
 
 begin
   FLLog(etWarning,'TFresnelWasmWidgetSet.HandleFresnelEnterEvent not implemented');
 end;
 
 
-procedure TFresnelWasmWidgetSet.HandleFresnelLeaveEvent(aForm: TFresnelWasmForm; Data: PCanvasMessageData);
+procedure TFresnelWasmWidgetSet.HandleFresnelLeaveEvent(aForm: TFresnelWasmForm; Data: PWindowMessageData);
 
 begin
   FLLog(etWarning,'TFresnelWasmWidgetSet.HandleFresnelLeaveEvent not implemented');
 end;
 
 
-Procedure TFresnelWasmWidgetSet.HandleFresnelKeyUpEvent(aForm: TFresnelWasmForm; Data: PCanvasMessageData);
+Procedure TFresnelWasmWidgetSet.HandleFresnelKeyUpEvent(aForm: TFresnelWasmForm; Data: PWindowMessageData);
 
 begin
   FLLog(etWarning,'TFresnelWasmWidgetSet.HandleFresnelKeyEvent not implemented');
 end;
 
-Procedure TFresnelWasmWidgetSet.HandleFresnelKeyDownEvent(aForm: TFresnelWasmForm; Data: PCanvasMessageData);
+Procedure TFresnelWasmWidgetSet.HandleFresnelKeyDownEvent(aForm: TFresnelWasmForm; Data: PWindowMessageData);
 
 begin
   FLLog(etWarning,'TFresnelWasmWidgetSet.HandleFresnelKeyEvent not implemented');
 end;
 
-procedure TFresnelWasmWidgetSet.HandleFresnelEvents(aForm: TFresnelWasmForm; Msg: TCanvasMessageID; Data: PCanvasMessageData);
+procedure TFresnelWasmWidgetSet.HandleFresnelEvents(aForm: TFresnelWasmForm; Msg: TWindowMessageID; Data: PWindowMessageData);
 
 begin
   Case Msg of
@@ -403,18 +425,18 @@ end;
 procedure TFresnelWasmWidgetSet.AppProcessMessages;
 
 var
-  Msg : TCanvasMessageID;
-  canvasID : TCanvasID;
-  MsgData : TCanvasMessageData;
+  Msg : TWindowMessageID;
+  WindowID : TWindowCanvasID;
+  MsgData : TWindowMessageData;
   F : TFresnelWasmForm;
   E : TFresnelEvent;
 
 begin
-  While __fresnel_event_get(@CanvasID,@Msg,@MsgData)=EWASMEVENT_SUCCESS do
+  While __fresnel_event_get(@WindowID,@Msg,@MsgData)=EWASMEVENT_SUCCESS do
     begin
-    F:=FindFormByCanvasId(CanvasID);
+    F:=FindFormByWindowId(WindowID);
     if not Assigned(F) then
-      FLLog(etWarning,'Got message with canvas ID %d, no matching form found',[CanvasID])
+      FLLog(etWarning,'Got message with canvas ID %d, no matching form found',[WindowID.Win])
     else
       HandleFresnelEvents(F,Msg,@MsgData);
     end;
@@ -430,7 +452,7 @@ begin
 
 end;
 
-function TFresnelWasmWidgetSet.FindFormByCanvasId(ID: TCanvasID): TFresnelWasmForm;
+function TFresnelWasmWidgetSet.FindFormByWindowId(ID: TWindowCanvasID): TFresnelWasmForm;
 
 var
   I : Integer;
@@ -442,7 +464,7 @@ begin
   While (I>=0) and (Result=Nil) do
     begin
     Result:=TFresnelWasmForm(FForms[i]);
-    If Result.CanvasID<>ID then
+    If Result.WindowID.Win<>ID.Win then
       Result:=Nil;
     Dec(I);
     end;
@@ -484,11 +506,6 @@ begin
   AbortRun;
 end;
 
-procedure TFresnelWasmApplication.CreateWidgetSet;
-begin
-  TFresnelWasmWidgetSet.Create(Nil);
-end;
-
 procedure TFresnelWasmApplication.HandleProcessMessages(aCurrent, aPrevious: Double);
 
 begin
@@ -530,7 +547,6 @@ end;
 constructor TFresnelWasmApplication.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
-  CreateWidgetSet;
   SetTickHook;
 end;
 
@@ -543,8 +559,9 @@ end;
 procedure InitWasmApplication;
 
 begin
+  WasmWidgetset:=TFresnelWasmWidgetSet.Create(Nil);
+  FresnelApplicationClass:=TFresnelWasmApplication;
   ImagesConfig.ImageClass:=TWASMImage;
-  TFresnelWasmApplication.Create(Nil);
 end;
 
 procedure DoneWasmApplication;

+ 8 - 7
src/wasm/fresnel.wasm.font.pp

@@ -61,9 +61,9 @@ Type
 
   TFresnelWasmFontEngine = class(TFresnelFontEngine)
   private
-    FCanvasID: TCanvasID;
+    FCanvasID: TOffscreenCanvasID;
     FFonts: TAvlTree; // tree of TFresnelLCLFont sorted with CompareFresnelWasmFont
-    FLastFontName : String; // Last used font.
+    FLastFontName : UnicodeString; // Last used font.
     function MaybeSetFont(aFont: TFresnelWasmFont): Boolean;
   public
     constructor Create(AOwner: TComponent); override;
@@ -73,7 +73,7 @@ Type
     function TextSize(aFont: TFresnelWasmFont; const aText: string): TPoint; virtual;
     function TextSizeMaxWidth(aFont: TFresnelWasmFont; const aText: string; MaxWidth: integer): TPoint; virtual;
     Function FontToHTML(aFont : TFresnelWasmFont) : String;
-    property CanvasID: TCanvasID read FCanvasID write FCanvasID;
+    property CanvasID: TOffscreenCanvasID read FCanvasID write FCanvasID;
   end;
 
 implementation
@@ -277,24 +277,25 @@ end;
 function TFresnelWasmFontEngine.MaybeSetFont(aFont: TFresnelWasmFont) : Boolean;
 
 var
-  aFontName : UTF8String;
+  aFontName : UnicodeString;
 
 begin
   aFontName:=FontToHTML(aFont);
   Result:=aFontName<>FLastFontName;
   if Result then
-    if __fresnel_canvas_set_font(CanvasID,PByte(aFontName),Length(aFontName))<>ECANVAS_SUCCESS then
+    if __fresnel_canvas_set_font(CanvasID.cnv,PByte(aFontName),Length(aFontName))<>ECANVAS_SUCCESS then
       FLLog(etError,'Failed to set font name to '+aFontName);
 end;
 
 function TFresnelWasmFontEngine.TextSize(aFont: TFresnelWasmFont; const aText: string): TPoint;
 var
   aWidth,aHeight : Longint;
-
+  aUnicodeText : UnicodeString;
 begin
 {$IFDEF DEBUGWASMFONT} FLLog('Enter TFresnelWasmFontEngine.TextSize');{$ENDIF}
   MaybeSetFont(aFont);
-  if __fresnel_canvas_measure_text(CanvasID,PByte(aText),Length(aText),@aWidth,@aHeight)<>ECANVAS_SUCCESS then
+  aUnicodeText:=UTF8Decode(aText);
+  if __fresnel_canvas_measure_text(CanvasID.Cnv,PByte(aUnicodeText),Length(aUnicodeText),@aWidth,@aHeight)<>ECANVAS_SUCCESS then
     begin
     aWidth:=Length(aText)*10;
     aHeight:=12;

+ 38 - 33
src/wasm/fresnel.wasm.render.pp

@@ -28,7 +28,7 @@ Type
 
   TWasmFresnelRenderer = Class(TFresnelRenderer)
   private
-    FCanvas: TCanvasID;
+    FCanvas: TOffscreenCanvasID;
     FFillReset : Boolean;
     FLastFillColor : TFPColor;
     FLastStrokeColor : TFPColor;
@@ -40,7 +40,10 @@ Type
     procedure DoFillRect(const aColor: TFPColor; const aRect: TFresnelRect; CheckFill: Boolean);
     procedure DoRoundRect(const aColor: TFPColor; const aRect: TFresnelRoundRect; Flags: Integer);
     // renderer methods
+    procedure DrawElBackground(El: TFresnelElement; Params: TBorderAndBackground); override;
+    procedure DrawElBorder(El: TFresnelElement; Params: TBorderAndBackground); override;
     procedure SetGradientFillStyle(aGradient : TFresnelCSSLinearGradient);
+  public
     procedure RoundRect(const aColor: TFPColor; const aRect: TFresnelRoundRect; Fill : Boolean); override;
     procedure FillRect(const aColor: TFPColor; const aRect: TFresnelRect); override;
     procedure Line(const aColor: TFPColor; const x1, y1, x2, y2: TFresnelLength); override;
@@ -48,14 +51,11 @@ Type
       const aFont: IFresnelFont; const aColor: TFPColor;
       const aText: string); override;
     procedure DrawImage(const aLeft, aTop, aWidth, aHeight: TFresnelLength; const aImage: TFPCustomImage); override;
-    procedure DrawElBackground(El: TFresnelElement; Params: TBorderAndBackground); override;
-    procedure DrawElBorder(El: TFresnelElement; Params: TBorderAndBackground); override;
     procedure Save; override;
     procedure Restore; override;
     procedure ClipRect(const aRect: TFresnelRect); override;
-  public
     constructor Create(AOwner: TComponent); override;
-    property Canvas: TCanvasID read FCanvas write FCanvas;
+    property Canvas: TOffscreenCanvasID read FCanvas write FCanvas;
   end;
 
   { TWASMImage }
@@ -75,12 +75,13 @@ function TWasmFresnelRenderer.CheckFillColor(aColor : TFPColor) : Boolean;
 
 begin
   Result:=not (aColor=FLastFillColor) or FFillReset;
+  Result:=True;
   if Result then
     begin
     With aColor do
       begin
       FLLog(etDebug,'Fill color (%d, %d, %d - %d)',[Red,Green,Blue,Alpha]);
-      __fresnel_canvas_set_fillstyle(Canvas,Red,Green,Blue,Alpha);
+      __fresnel_canvas_set_fillstyle(Canvas.Cnv,Red,Green,Blue,Alpha);
       end;
     FLastFillColor:=aColor;
     FFillReset:=False;
@@ -90,13 +91,14 @@ end;
 function TWasmFresnelRenderer.CheckStrokeColor(aColor : TFPColor) : Boolean;
 
 begin
+  Result:=True;
   Result:=not (aColor=FLastStrokeColor);
   if Result then
     begin
     With aColor do
       begin
       FLLog(etDebug,'Stroke color (%d, %d, %d - %d)',[Red,Green,Blue,Alpha]);
-      __fresnel_canvas_set_strokestyle(Canvas,Red,Green,Blue,Alpha);
+      __fresnel_canvas_set_strokestyle(Canvas.Cnv,Red,Green,Blue,Alpha);
       end;
     FLastStrokeColor:=aColor;
     end;
@@ -136,7 +138,7 @@ begin
     P.Percentage:=100;
     Colors[1]:=P;
     end;
-  __fresnel_canvas_linear_gradient_fillstyle(Canvas,aX1,aY1,aX2,aY2,Length(Colors),PGradientColorPoints(Colors));
+  __fresnel_canvas_linear_gradient_fillstyle(Canvas.Cnv,aX1,aY1,aX2,aY2,Length(Colors),PGradientColorPoints(Colors));
   FFillReset:=True;
 end;
 
@@ -157,14 +159,14 @@ var
 
 begin
   CheckStrokeColor(aColor);
-  FLLog(etDebug,'RoundRect(%d,{%s})',[Canvas,aRect.ToString]);
+  FLLog(etDebug,'RoundRect(%d,{%s})',[Canvas.Cnv,aRect.ToString]);
   Idx:=0;
   AddP(aRect.Box.TopLeft,True);
   AddP(aRect.Box.BottomRight,True);
   For Corner in TFresnelCSSCorner do
     AddP(aRect.Radii[Corner]);
-  if __fresnel_canvas_roundrect(Canvas,Flags,@RR)<>ECANVAS_SUCCESS then
-    FLLog(etError,'failed to draw round rectangle on canvas %d',[Canvas]);
+  if __fresnel_canvas_roundrect(Canvas.Cnv,Flags,@RR)<>ECANVAS_SUCCESS then
+    FLLog(etError,'failed to draw round rectangle on canvas %d',[Canvas.cnv]);
 end;
 
 procedure TWasmFresnelRenderer.RoundRect(const aColor: TFPColor; const aRect: TFresnelRoundRect; Fill: Boolean);
@@ -192,8 +194,8 @@ begin
   Result:=aFontName<>FLastFontName;
   if Result then
     begin
-    if __fresnel_canvas_set_font(Canvas,PByte(aFontName),Length(aFontName))<>ECANVAS_SUCCESS then
-      FLLog(etError,'failed to set canvas %d font to "%s"',[Canvas,aFontName]);
+    if __fresnel_canvas_set_font(Canvas.Cnv,PByte(aFontName),Length(aFontName))<>ECANVAS_SUCCESS then
+      FLLog(etError,'failed to set canvas %d font to "%s"',[Canvas.Cnv,aFontName]);
     FLastFontName:=aFontName;
     end;
 end;
@@ -203,8 +205,8 @@ procedure TWasmFresnelRenderer.DoFillRect(const aColor: TFPColor; const aRect: T
 begin
   if CheckFill then
     CheckFillColor(aColor);
-  FLLog(etDebug,'__fresnel_canvas_fillrect(%d,%d,%d,%d,%d)',[Canvas,aRect.Left+Origin.X,aRect.Top+Origin.Y,aRect.Width,aRect.Height]);
-  __fresnel_canvas_fillrect(Canvas,(aRect.Left+Origin.X),(aRect.Top+Origin.Y),(aRect.Width),(aRect.Height));
+  FLLog(etDebug,'__fresnel_canvas_fillrect(%d,%f,%f,%f,%f)',[Canvas.Cnv,aRect.Left+Origin.X,aRect.Top+Origin.Y,aRect.Width,aRect.Height]);
+  __fresnel_canvas_fillrect(Canvas.Cnv,(aRect.Left+Origin.X),(aRect.Top+Origin.Y),(aRect.Width),(aRect.Height));
 end;
 
 procedure TWasmFresnelRenderer.FillRect(const aColor: TFPColor; const aRect: TFresnelRect);
@@ -216,11 +218,12 @@ procedure TWasmFresnelRenderer.Line(const aColor: TFPColor; const x1, y1, x2, y2
 
 begin
   CheckStrokeColor(aColor);
-  __fresnel_canvas_set_linewidth(Canvas,200);
-  __fresnel_canvas_beginpath(Canvas);
-  __fresnel_canvas_moveto(Canvas, (x1+Origin.X), (y1+Origin.Y));
-  __fresnel_canvas_lineto(Canvas, (x2+Origin.X), (y2+Origin.Y));
-  __fresnel_canvas_stroke(Canvas);
+  FLLog(etDebug,'Drawing line (%g,%g)-(%g,%g)',[x1,y1,x2,y2]);
+  __fresnel_canvas_set_linewidth(Canvas.Cnv,2);
+  __fresnel_canvas_beginpath(Canvas.cnv);
+  __fresnel_canvas_moveto(Canvas.Cnv, (x1+Origin.X), (y1+Origin.Y));
+  __fresnel_canvas_lineto(Canvas.Cnv, (x2+Origin.X), (y2+Origin.Y));
+  __fresnel_canvas_stroke(Canvas.cnv);
 end;
 
 procedure TWasmFresnelRenderer.TextOut(const aLeft, aTop: TFresnelLength; const aFont: IFresnelFont; const aColor: TFPColor;
@@ -229,30 +232,32 @@ procedure TWasmFresnelRenderer.TextOut(const aLeft, aTop: TFresnelLength; const
 var
   I,Count : integer;
   aShadow : PFresnelTextShadow;
+  lText : UnicodeString;
 
 begin
   CheckFillColor(aColor);
   CheckFont(aFont);
   Count:=TextShadowCount;
+  lText:=UTF8decode(aText);
   if Count=0 then
     begin
     // X,Y,Radius,r,g,b,a)
-    if __fresnel_canvas_set_textshadow_params(Canvas,0,0,0,0,0,0,0)<>ECANVAS_SUCCESS then
-      FLLog(etError,'failed to clear shadow params for text "%s"',[Canvas,aText]);
-    if __fresnel_canvas_filltext(Canvas,(aLeft+Origin.X),(aTop+Origin.Y),PByte(aText),Length(aText))<>ECANVAS_SUCCESS then
-      FLLog(etError,'failed to draw canvas %d text "%s"',[Canvas,aText]);
+    if __fresnel_canvas_set_textshadow_params(Canvas.Cnv,0,0,0,0,0,0,0)<>ECANVAS_SUCCESS then
+      FLLog(etError,'failed to clear shadow params for text "%s"',[Canvas.Cnv,aText]);
+    if __fresnel_canvas_filltext(Canvas.Cnv,(aLeft+Origin.X),(aTop+Origin.Y),PByte(lText),Length(lText),1)<>ECANVAS_SUCCESS then
+      FLLog(etError,'failed to draw canvas %d text "%s"',[Canvas.Cnv,aText]);
     end
   else
     for I:=0 to TextShadowCount-1 do
       begin
       aShadow:=Self.TextShadow[I];
       With aShadow^ do
-        if __fresnel_canvas_set_textshadow_params(Canvas,(Offset.X),(Offset.Y),Radius,Color.Red,Color.Green,Color.Blue,Color.Alpha)<>ECANVAS_SUCCESS then
-          FLLog(etError,'failed to set shadow params for text "%s"',[Canvas,aText]);
-      if __fresnel_canvas_filltext(Canvas,(aLeft+Origin.X),(aTop+Origin.Y),PByte(aText),Length(aText))<>ECANVAS_SUCCESS then
-        FLLog(etError,'failed to draw canvas %d text "%s"',[Canvas,aText]);
-      if __fresnel_canvas_set_textshadow_params(Canvas,0,0,0,0,0,0,0)<>ECANVAS_SUCCESS then
-        FLLog(etError,'failed to clear shadow params for text "%s"',[Canvas,aText]);
+        if __fresnel_canvas_set_textshadow_params(Canvas.Cnv,(Offset.X),(Offset.Y),Radius,Color.Red,Color.Green,Color.Blue,Color.Alpha)<>ECANVAS_SUCCESS then
+          FLLog(etError,'failed to set shadow params for text "%s"',[Canvas.Cnv,aText]);
+      if __fresnel_canvas_filltext(Canvas.Cnv,(aLeft+Origin.X),(aTop+Origin.Y),PByte(lText),Length(lText),1)<>ECANVAS_SUCCESS then
+        FLLog(etError,'failed to draw canvas %d text "%s"',[Canvas.Cnv,aText]);
+      if __fresnel_canvas_set_textshadow_params(Canvas.Cnv,0,0,0,0,0,0,0)<>ECANVAS_SUCCESS then
+        FLLog(etError,'failed to clear shadow params for text "%s"',[Canvas.Cnv,aText]);
       end;
 end;
 
@@ -269,7 +274,7 @@ begin
   try
     if Img<>aImage then
       Img.Assign(aImage);
-    __fresnel_canvas_draw_image(Canvas,
+    __fresnel_canvas_draw_image(Canvas.Cnv,
                                 aLeft+Origin.X,
                                 aTop+Origin.Y,
                                 aWidth,
@@ -297,7 +302,7 @@ begin
   end else if Params.BackgroundColorFP.Alpha>alphaTransparent then
   begin
     //FLLog(etDebug,'TFresnelRenderer.DrawElBorder drawing background %s',[El.GetPath]);
-    __fresnel_canvas_set_linewidth(Canvas,Params.Width[ffsLeft]);
+    __fresnel_canvas_set_linewidth(Canvas.Cnv,Params.Width[ffsLeft]);
     if Params.HasRadius then
       RoundRect(Params.BackgroundColorFP,Params.BoundingBox,True)
     else
@@ -319,7 +324,7 @@ begin
     Inherited DrawElBorder(El,Params)
   else if Params.SameBorderWidth then
     begin
-    __fresnel_canvas_set_linewidth(Canvas,Params.Width[ffsLeft]);
+    __fresnel_canvas_set_linewidth(Canvas.Cnv,Params.Width[ffsLeft]);
     BB:=Params.BoundingBox;
     With Params do
       begin

+ 146 - 41
src/wasm/fresnel.wasm.shared.pp

@@ -29,7 +29,7 @@ uses
   {$ENDIF}
 
 const
-  CanvasMsgSize = 4;
+  WindowMsgSize = 4;
   CanvasMeasureTextSize = 4;
   FresnelScaleFactor = 100;
 
@@ -42,7 +42,63 @@ Type
   TFresnelFloatArray = Array of TFresnelFloat;
 
   TCanvasError = longint;
-  TCanvasID = longint;
+
+  { TWindowCanvasID }
+
+  // ID for a Canvas that exists in the DOM and corresponds to a Window
+  {$ifdef PAS2JS}
+  // using Int16 here to work around type helper limitation
+  // (type helper is bound to the unaliased type, so we need a different type than for TOffscreenCanvasID)
+  TWindowCanvasID = Int16;
+  {$else}
+  TWindowCanvasID = record
+    Win : LongInt;
+  end;
+  {$endif}
+
+  TWindowCanvasIDHelper = {$ifdef PAS2JS}type{$else}record{$endif} helper for TWindowCanvasID
+    function ToIDString : String; inline;
+    function ToString : String;
+  end;
+
+  { TOffscreenCanvasID }
+
+  // ID for an OffscreenCanvas that can exist in main thread or webworker
+  {$ifdef PAS2JS}
+  TOffscreenCanvasID = Int32;
+  {$else}
+  TOffscreenCanvasID = record
+    Cnv : LongInt;
+  end;
+  {$endif}
+
+  TOffscreenCanvasIDHelper = {$ifdef PAS2JS}type{$else}record{$endif} helper for TOffscreenCanvasID
+    function ToIDString : String; inline;
+    function ToString : String;
+  end;
+
+  { TVideoElementID }
+  // ID for an OffscreenCanvas that can exist in main thread or webworker
+  {$ifdef PAS2JS}
+  TVideoElementID = Int32;
+  {$else}
+  TVideoElementID = record
+    Vid : LongInt;
+  end;
+  {$endif}
+
+  TVideoElementIDHelper = {$ifdef PAS2JS}type{$else}record{$endif} helper for TVideoElementID
+    function ToIDString : String; inline;
+    function ToString : String;
+  end;
+
+const
+   // not the default value for ID, but the ID of the default canvas
+  // which is used as fallback in text measurer & others
+   cOffscreenCanvasDefaultCanvasID = 1;
+
+type
+
   TCanvasColorComponent = Word; // one of R G B A
   TCanvasColor = longint;
   TCanvasLineWidth = TFresnelFloat;
@@ -53,15 +109,15 @@ Type
   TMenuID = longint;
 
 
-  TCanvasMessageID = longint;
-  TCanvasMessageParam = longint;
-  TCanvasMessageData = Array[0..CanvasMsgSize-1] of TCanvasMessageParam;
+  TWindowMessageID = longint;
+  TWindowMessageParam = longint;
+  TWindowMessageData = array [0..WindowMsgSize-1] of TWindowMessageParam;
 
   TCanvasMeasureTextParam = TFresnelFloat;
-  TCanvasMeasureTextData = Array[0..CanvasMeasureTextSize] of TCanvasMeasureTextParam;
+  TCanvasMeasureTextData = array [0..CanvasMeasureTextSize] of TCanvasMeasureTextParam;
 
   TLineDashPattern = TFresnelFloat;
-  TLineDashPatternData = Array of TLineDashPattern;
+  TLineDashPatternData = array of TLineDashPattern;
 
   {$IFDEF PAS2JS}
   UTF8String = String;
@@ -79,18 +135,19 @@ Type
   end;
   TGradientColorPoints = Array of TGradientColorPoint;
 
-  { TCanvasMessageDataHelper }
+  { TWindowMessageDataHelper }
 
-  TCanvasMessageDataHelper = type helper for TCanvasMessageData
-    Function ToString : UTF8String;
+  TWindowMessageDataHelper = type helper for TWindowMessageData
+    function ToString : UTF8String;
   end;
 
   {$IFNDEF PAS2JS}
   PFresnelFloat = ^TFresnelFloat;
-  PCanvasID = ^TCanvasID;
+  PWindowCanvasID = ^TWindowCanvasID;
+  POffscreenCanvasID = ^TOffscreenCanvasID;
   PCanvasColor = ^TCanvasColor;
-  PCanvasMessageID = ^TCanvasMessageID;
-  PCanvasMessageData = ^TCanvasMessageData;
+  PWindowMessageID = ^TWindowMessageID;
+  PWindowMessageData = ^TWindowMessageData;
   PCanvasMeasureTextData = ^TCanvasMeasureTextData;
   PCanvasRoundRectData = ^TCanvasRoundRectData;
   PGradientColorPoints = ^TGradientColorPoint;
@@ -114,12 +171,17 @@ Type
   {$ENDIF}
 
 Const
-  ECANVAS_SUCCESS      = 0;
-  ECANVAS_NOCANVAS     = 1;
-  ECANVAS_INVALIDPATH  = 2;
-  ECANVAS_INVALIDPARAM = 3;
-  ECANVAS_NOMENUSUPPORT = 4;
-  ECANVAS_UNSPECIFIED  = -1;
+  ECANVAS_SUCCESS       =  0;
+  ECANVAS_NOWINDOW      = 10;
+  ECANVAS_NOCANVAS      = 11;
+  ECANVAS_NOIMAGEBITMAP = 12;
+  ECANVAS_NOVIDEO       = 13;
+  ECANVAS_INVALIDPATH   = 20;
+  ECANVAS_INVALIDPARAM  = 21;
+  ECANVAS_NOMENUSUPPORT = 22;
+  ECANVAS_OFFSCREEN     = 30;
+  ECANVAS_EXCEPTION     = 40;
+  ECANVAS_UNSPECIFIED   = -1;
 
   CANVAS_LINECAP_BUTT   = 0;
   CANVAS_LINECAP_ROUND  = 1;
@@ -129,10 +191,12 @@ Const
   CANVAS_LINEJOIN_BEVEL = 1;
   CANVAS_LINEJOIN_MITER = 2;
 
-  EWASMEVENT_SUCCESS  = 0;
-  EWASMEVENT_NOEVENT = 1;
-  EWASMEVENT_NOCANVAS = 2;
-  EWASMEVENT_ERROR    = 3;
+  EWASMEVENT_SUCCESS     = 0;
+  EWASMEVENT_NOEVENT     = 1;
+  EWASMEVENT_NOCANVAS    = 2;
+  EWASMEVENT_BUFFER_SIZE = 3;
+  EWASMEVENT_TRY_AGAIN   = 4;
+  EWASMEVENT_ERROR       = 5;
 
   // Key state, Based on TShiftStateEnum
   WASM_KEYSTATE_SHIFT   = 1 shl Ord(ssShift);
@@ -141,6 +205,7 @@ Const
   WASM_KEYSTATE_LEFT    = 1 shl Ord(ssLeft);
   WASM_KEYSTATE_RIGHT   = 1 shl Ord(ssRight);
   WASM_KEYSTATE_MIDDLE  = 1 shl Ord(ssMiddle);
+  WASM_KEYSTATE_DOUBLE  = 1 shl Ord(ssDouble);
   WASM_KEYSTATE_META    = 1 shl Ord(ssMeta);
   WASM_KEYSTATE_SUPER   = 1 shl Ord(ssSuper);
   WASM_KEYSTATE_HYPER   = 1 shl Ord(ssHyper);
@@ -175,13 +240,19 @@ Const
   WASMSG_MOUSESCROLL = 4; // Params[0]= X, [1]=Y, [2]=State
   WASMSG_CLICK       = 5; // Params[0]= X, [1]=Y, [2]=State
   WASMSG_WHEELY      = 6; // Params[0]= X, [1]=Y, [2]=State [3]=Distance
-  WASMSG_DBLCLICK    = 7;
+  WASMSG_DBLCLICK    = 7; // Params[0]= X, [1]=Y, [2]=State
   WASMSG_ENTER       = 8;
   WASMSG_LEAVE       = 9;
   WASMSG_KEYDOWN     = 10;
   WASMSG_KEYUP       = 11;
   WASMSG_ACTIVATE    = 12;
   WASMSG_DEACTIVATE  = 13;
+  WASMSG_RESIZE      = 14; // Params[0]= X, [1]=Y, [2]=PixelRatio*1000 (XY in virtual pixels)
+
+  // brodcast messages are sent from this ID up,
+  // they are dispatched to all windows from topmost down
+  // if one window handles it, broadcasting stops there
+  WASMSG_BROADCAST   = 1000;
 
   // Roundrect flags
   ROUNDRECT_FLAG_FILL         = 1;
@@ -218,9 +289,6 @@ Const
   DRAWIMAGE_IMAGEWIDTH  = 8;
   DRAWIMAGE_IMAGEHEIGHT = 9;
 
-  // Set_transform_flags
-  TRANSFORM_RESET = 1;
-
   // Flags for Arc
   ARC_FILL   = 1;
   ARC_ROTATE = 2;
@@ -248,14 +316,15 @@ Const
   TEXTBASELINE_IDEOGRAPHIC = 4;
   TEXTBASELINE_BOTTOM      = 5;
 
-  // Save/Restore
-  STATE_FLAGS_RESTORE_PROPS = 1;
-
   // Menu flags
   MENU_FLAGS_INVISIBLE = 1;
   MENU_FLAGS_CHECKED = 2;
   MENU_FLAGS_RADIO   = 4;
 
+  // User Media flags
+  cUserMediaCaptureOption_RequestAnimationFrame = 1;
+  cUserMediaCaptureOption_SelfieSegmentationBlur = 2;
+
 Function LineCapToString(aCap: TCanvasLineCap) : String;
 Function LineJoinToString(aJoin: TCanvasLineJoin) : String;
 Function TextBaseLineToString(aBaseLine : TCanvasTextBaseLine) : String;
@@ -320,27 +389,63 @@ begin
   end;
 end;
 
+{ TWindowCanvasIDHelper }
+
+function TWindowCanvasIDHelper.ToIDString: String;
+begin
+  Result := IntToStr({$ifdef PAS2JS}Self{$else}Win{$endif});
+end;
+
+function TWindowCanvasIDHelper.ToString: String;
+begin
+  Result := 'Window' + ToIDString;
+end;
+
+{ TOffscreenCanvasIDHelper }
+
+function TOffscreenCanvasIDHelper.ToIDString: String;
+begin
+  Result := IntToStr({$ifdef PAS2JS}Self{$else}Cnv{$endif});
+end;
+
+function TOffscreenCanvasIDHelper.ToString: String;
+begin
+  Result := 'Canvas' + ToIDString;
+end;
+
+{ TVideoElementIDHelper }
+
+function TVideoElementIDHelper.ToIDString: String;
+begin
+  Result := IntToStr({$ifdef PAS2JS}Self{$else}Vid{$endif});
+end;
+
+function TVideoElementIDHelper.ToString: String;
+begin
+  Result := 'Video' + ToIDString;
+end;
+
 { TGradientColorPoint }
 
 function TGradientColorPoint.ToString: string;
 begin
-  Result:=Format('{%g%% (r:%d, g:%d, b:%d / %d)}',[Percentage/100,Red,Green,Blue,Alpha]);
+  Result := String(Format('{%g%% (r:%d, g:%d, b:%d / %d)}',[Percentage/100,Red,Green,Blue,Alpha]));
 end;
 
-{ TCanvasMessageDataHelper }
-
-function TCanvasMessageDataHelper.ToString: UTF8String;
+{ TWindowMessageDataHelper }
 
+function TWindowMessageDataHelper.ToString: UTF8String;
 var
   I : Integer;
+  buffer : String;
 begin
-  Result:=IntToStr(Self[0]);
-  For I:=1 to CanvasMsgSize-1 do
-    begin
-    Result:=Result+',';
-    Result:=Result+IntToStr(Self[I])
-    end;
-  Result:='['+Result+']';
+  buffer  := IntToStr(Self[0]);
+  For I:=1 to WindowMsgSize-1 do
+  begin
+    buffer :=buffer +',';
+    buffer :=buffer +IntToStr(Self[I])
+  end;
+  Result := UTF8String('['+buffer +']');
 end;
 
 end.

+ 0 - 0
src/wasm/fresnelwasm.pas → src/wasm/fresnelwasm.pp