paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-08-20 09:39:02 +02:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'main' of ssh://gitlab.com/freepascal.org/fpc/pas2js into main

Browse Source
This commit is contained in:
mattias 2022-02-13 10:18:48 +01:00
commit 048d11fb3c
11 changed files with 513 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler

@ -1 +1 @@
Subproject commit 8f083f6342ab8d193d5dc0ae2205bad4b1d7bab9 Subproject commit 3c91a7c01ea16f5fc9239b21636d4127faacaf31

22
demo/library/demo_libraries.lpg Normal file
View File

@ -0,0 +1,22 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectGroup FileVersion="2">
<Targets>
<Target FileName="main.lpi">
<BuildModes>
<Mode Name="Default"/>
</BuildModes>
</Target>
<Target FileName="modules/canvas.lpi">
<BuildModes>
<Mode Name="Default"/>
</BuildModes>
</Target>
<Target FileName="modules/square.lpi">
<BuildModes>
<Mode Name="Default"/>
</BuildModes>
</Target>
</Targets>
</ProjectGroup>
</CONFIG>

17
demo/library/index.html Normal file
View File

@ -0,0 +1,17 @@
<!DOCTYPE html>
<html lang="en-US">
<head>
<meta charset="utf-8">
<title>Basic Pas2JS library example</title>
<style>
canvas {
border: 1px solid black;
}
</style>
<script type="module" src="main.js"></script>
</head>
<body>
</body>
</html>

89
demo/library/main.lpi Normal file
View File

@ -0,0 +1,89 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
<Runnable Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<Title Value="main"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<CustomData Count="3">
<Item0 Name="MaintainHTML" Value="1"/>
<Item1 Name="PasJSWebBrowserProject" Value="1"/>
<Item2 Name="RunAtReady" Value="1"/>
</CustomData>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<Units>
<Unit>
<Filename Value="main.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="index.html"/>
<IsPartOfProject Value="True"/>
<CustomData Count="1">
<Item0 Name="PasJSIsProjectHTMLFile" Value="1"/>
</CustomData>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target FileExt=".js">
<Filename Value="main"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="js"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<AllowLabel Value="False"/>
<CPPInline Value="False"/>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<TargetOS Value="browser"/>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
<UseLineInfoUnit Value="False"/>
</Debugging>
</Linking>
<Other>
<CustomOptions Value="-Jeutf-8 -Jirtl.js -Jc -Jminclude -Tmodule"/>
<CompilerPath Value="$(pas2js)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

44
demo/library/main.lpr Normal file
View File

@ -0,0 +1,44 @@
program main;
{$mode objfpc}
uses js, web;
{$linklib ./modules/canvas.js canvas}
{$linklib ./modules/square.js square}
Type
TCreateCanvasResult = record
ctx : TJSCanvasRenderingContext2D;
id : string;
end;
Function create(aID : String; aParent : TJSElement; aWidth,aHeight : integer) : TCreateCanvasResult; external name 'canvas.create';
Function createReportList(aID : String) : string ; external name 'canvas.createReportList';
Type
TDrawSquare = record
length,x,y : NativeInt;
color : string;
end;
function draw(aCTX : TJSCanvasRenderingContext2D; aLength,aX,aY : NativeInt; aColor : String) : TDrawSquare; external name 'square.draw';
Function randomSquare (aCTX : TJSCanvasRenderingContext2D) : TDrawSquare; external name 'square.randomSquare';
procedure reportArea (aLength : NativeInt; aListID : string); external name 'square.reportArea';
procedure reportPerimeter (aLength : NativeInt; aListID : string); external name 'square.reportPerimeter';
var
myCanvas : TCreateCanvasResult;
reportList : String;
square1,square2 : TDrawSquare;
begin
myCanvas:=create('myCanvas', document.body, 480, 320);
ReportList:= createReportList(myCanvas.id);
square1:=draw(myCanvas.ctx, 50, 50, 100, 'blue');
reportArea(square1.length, reportList);
reportPerimeter(square1.length, reportList);
square2:=randomSquare(myCanvas.ctx);
reportArea(square2.length, reportList);
reportPerimeter(square2.length, reportList);
end.

90
demo/library/modules/canvas.lpi Normal file
View File

@ -0,0 +1,90 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
<Runnable Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<Title Value="canvas"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<CustomData Count="1">
<Item0 Name="PasJSWebBrowserProject" Value="1"/>
</CustomData>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<Units>
<Unit>
<Filename Value="canvas.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="ucanvas.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uCanvas"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target FileExt=".js">
<Filename Value="canvas.js" ApplyConventions="False"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<AllowLabel Value="False"/>
<CPPInline Value="False"/>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<TargetOS Value="browser"/>
<Optimizations>
<OptimizationLevel Value="0"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
<UseLineInfoUnit Value="False"/>
</Debugging>
<Options>
<ExecutableType Value="Library"/>
</Options>
</Linking>
<Other>
<CustomOptions Value="-Jeutf-8 -Jirtl.js -Jc -Jminclude -O-"/>
<CompilerPath Value="$(pas2js)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

14
demo/library/modules/canvas.lpr Normal file
View File

@ -0,0 +1,14 @@
library canvas;
{$mode objfpc}
uses
web, ucanvas;
exports
create,
createReportList;
begin
// Your code here
end.

82
demo/library/modules/square.lpi Normal file
View File

@ -0,0 +1,82 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
<Runnable Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<Title Value="square"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<CustomData Count="1">
<Item0 Name="PasJSWebBrowserProject" Value="1"/>
</CustomData>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<Units>
<Unit>
<Filename Value="square.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="square.js" ApplyConventions="False"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<AllowLabel Value="False"/>
<CPPInline Value="False"/>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<TargetOS Value="browser"/>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
<UseLineInfoUnit Value="False"/>
</Debugging>
<Options>
<ExecutableType Value="Library"/>
</Options>
</Linking>
<Other>
<CustomOptions Value="-Jeutf-8 -Jirtl.js -Jc -Jminclude -O-"/>
<CompilerPath Value="$(pas2js)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

71
demo/library/modules/square.lpr Normal file
View File

@ -0,0 +1,71 @@
library square;
{$mode objfpc}
uses
SysUtils,JS, Web;
Type
TDrawSquare = record
length,x,y : NativeInt;
color : string;
end;
function draw(aCTX : TJSCanvasRenderingContext2D; aLength,aX,aY : NativeInt; aColor : String) : TDrawSquare;
begin
aCtx.fillStyle:=aColor;
aCtx.fillRect(aX, aY, aLength, aLength);
Result.length:=alength;
Result.x:=aX;
Result.y:=aY;
Result.color:=aColor;
end;
Function randomSquare (aCTX : TJSCanvasRenderingContext2D) : TDrawSquare;
var
x,y,l : Integer;
col : string;
begin
Col:=format('rgb(%d,%d,%d)',[Random(256),Random(256),Random(256)]);
X:=Random(481);
Y:=Random(320);
L:=10+Random(9);
Result:=Draw(aCtx,l,x,y,col);
end;
procedure reportArea (aLength : NativeInt; aListID : string);
Var
aItem,aList : TJSHTMLElement;
begin
aItem:=TJSHTMLElement(document.createElement('li'));
aItem.textContent:=Format('Square area is %dpx squared.',[aLength*aLength]);
aList:=TJSHTMLElement(document.getElementById(aListID));
alist.appendChild(aItem);
end;
procedure reportPerimeter (aLength : NativeInt; aListID : string);
Var
aItem,aList : TJSHTMLElement;
begin
aItem:=TJSHTMLElement(document.createElement('li'));
aItem.textContent:=Format('Square perimeter is %dpx.',[aLength*4]);
aList:=TJSHTMLElement(document.getElementById(aListID));
alist.appendChild(aItem);
end;
exports
draw,
randomSquare,
reportArea,
reportPerimeter;
begin
// Your code here
end.

55
demo/library/modules/ucanvas.pas Normal file
View File

@ -0,0 +1,55 @@
unit uCanvas;
{$mode ObjFPC}
interface
uses
web;
Type
TCreateCanvasResult = record
ctx : TJSCanvasRenderingContext2D;
id : string;
end;
Function create(aID : String; aParent : TJSElement; aWidth,aHeight : integer) : TCreateCanvasResult;
Function createReportList(aID : String) : string ;
Implementation
Function create(aID : String; aParent : TJSElement; aWidth,aHeight : integer) : TCreateCanvasResult;
Var
divWrapper : TJSHTMLElement;
canvasElem : TJSHTMLCanvasElement;
begin
divWrapper:=TJSHTMLElement(document.createElement('div'));
canvasElem:=TJSHTMLCanvasElement(document.createElement('canvas'));
aParent.appendChild(divWrapper);
divWrapper.appendChild(canvasElem);
divWrapper.id:=aid;
canvasElem.width := awidth;
canvasElem.height := aheight;
Result.ctx:=TJSCanvasRenderingContext2D(canvasElem.getContext('2d'));
Result.ID:=aID;
end;
Function createReportList(aID : String) : string ;
Var
aWrapper,aList : TJSHTMLElement;
begin
alist:=TJSHTMLElement(document.createElement('ul'));
alist.id:=aId + '-reporter';
aWrapper:=TJSHTMLElement(document.getElementById(aId));
aWrapper.appendChild(aList);
Result:=aList.id;
end;
end.

38
packages/rtl/sysutils.pas
View File

@ -93,6 +93,7 @@ type
class var InitLocaleHandler : TLocaleInitCallback; class var InitLocaleHandler : TLocaleInitCallback;
class function Create: TFormatSettings; overload; static; class function Create: TFormatSettings; overload; static;
class function Create(const ALocale: string): TFormatSettings; overload; static; class function Create(const ALocale: string): TFormatSettings; overload; static;
class function Invariant: TFormatSettings; static;
end; end;
@ -4960,11 +4961,6 @@ begin
Result:='0'+Result; Result:='0'+Result;
end; end;
{ TFormatSettings }
{ TFormatSettings } { TFormatSettings }
class function TFormatSettings.Create: TFormatSettings; class function TFormatSettings.Create: TFormatSettings;
@ -4972,11 +4968,8 @@ begin
Result := Create(GetJSLocale); Result := Create(GetJSLocale);
end; end;
class function TFormatSettings.Create(const ALocale: String): TFormatSettings;
class function TFormatSettings.Create(const ALocale: string): TFormatSettings;
begin begin
Result.LongDayNames:=DefaultLongDayNames; Result.LongDayNames:=DefaultLongDayNames;
Result.ShortDayNames:=DefaultShortDayNames; Result.ShortDayNames:=DefaultShortDayNames;
Result.ShortMonthNames:=DefaultShortMonthNames; Result.ShortMonthNames:=DefaultShortMonthNames;
@ -4998,10 +4991,35 @@ begin
Result.NegCurrFormat:=0; Result.NegCurrFormat:=0;
Result.CurrencyDecimals:=2; Result.CurrencyDecimals:=2;
Result.CurrencyString:='$'; Result.CurrencyString:='$';
If Assigned(TFormatSettings.InitLocaleHandler) then
if Assigned(TFormatSettings.InitLocaleHandler) then
TFormatSettings.InitLocaleHandler(UpperCase(aLocale),Result); TFormatSettings.InitLocaleHandler(UpperCase(aLocale),Result);
end; end;
class function TFormatSettings.Invariant: TFormatSettings;
begin
Result.CurrencyString := #$00A4;
Result.CurrencyFormat := 0;
Result.CurrencyDecimals := 2;
Result.DateSeparator := '/';
Result.TimeSeparator := ':';
Result.ShortDateFormat := 'MM/dd/yyyy';
Result.LongDateFormat := 'dddd, dd MMMMM yyyy HH:mm:ss';
Result.TimeAMString := 'AM';
Result.TimePMString := 'PM';
Result.ShortTimeFormat := 'HH:mm';
Result.LongTimeFormat := 'HH:mm:ss';
Result.ShortMonthNames := DefaultShortMonthNames;
Result.ShortMonthNames := DefaultShortMonthNames;
Result.LongMonthNames := DefaultLongMonthNames;
Result.ShortDayNames := DefaultShortDayNames;
Result.LongDayNames := DefaultLongDayNames;
Result.ThousandSeparator := ',';
Result.DecimalSeparator := '.';
Result.TwoDigitYearCenturyWindow := 50;
Result.NegCurrFormat := 0;
end;
class function TFormatSettings.GetJSLocale: string; assembler; class function TFormatSettings.GetJSLocale: string; assembler;
asm asm
return Intl.DateTimeFormat().resolvedOptions().locale return Intl.DateTimeFormat().resolvedOptions().locale