Стартовый пул

bgrabitmap/test/bgralape/basic_functions.inc

@@ -0,0 +1,284 @@
+procedure MyGetScanLine{$i lape.func}
+begin
+  PBGRAPixel(Result^) := target.ScanLine[PInt32(Params^[0])^];
+  WillInvalidateBitmap(targetIndex);
+end;
+
+procedure MyGetBitmapWidth{$i lape.func}
+begin
+  Int32(Result^) := target.Width;
+end;
+
+procedure MyGetBitmapHeight{$i lape.func}
+begin
+  Int32(Result^) := target.Height;
+end;
+
+procedure MyPtInClipRect{$i lape.func}
+begin
+  LongBool(Result^) := target.PtInClipRect(PInt32(Params^[0])^,PInt32(Params^[1])^);
+end;
+
+procedure MyPtInRectPointFirst{$i lape.func}
+type PPoint = ^TPoint;
+  PRect = ^TRect;
+begin
+  LongBool(Result^) := PtInRect(PPoint(Params^[0])^,PRect(Params^[1])^);
+end;
+
+procedure MyPtInRectPointLast{$i lape.func}
+type PPoint = ^TPoint;
+  PRect = ^TRect;
+begin
+  LongBool(Result^) := PtInRect(PPoint(Params^[1])^,PRect(Params^[0])^);
+end;
+
+procedure MyGetClipRect{$i lape.func}
+begin
+  TRect(Result^) := target.ClipRect;
+end;
+
+procedure MySetClipRect{$i lape.proc}
+type PRect = ^TRect;
+begin
+  target.ClipRect := PRect(Params^[0])^;
+end;
+
+procedure MySetNoClip{$i lape.proc}
+begin
+  target.NoClip;
+end;
+
+procedure MyBGRA3{$i lape.func}
+begin
+  TBGRAPixel(Result^) := BGRA(PByte(Params^[0])^,PByte(Params^[1])^,PByte(Params^[2])^);
+end;
+
+procedure MyBGRA4{$i lape.func}
+begin
+  TBGRAPixel(Result^) := BGRA(PByte(Params^[0])^,PByte(Params^[1])^,PByte(Params^[2])^,PByte(Params^[3])^);
+end;
+
+procedure MySetPixel{$i lape.proc}
+begin
+  target.SetPixel(PInt32(Params^[0])^,PInt32(Params^[1])^,PBGRAPixel(Params^[2])^);
+end;
+
+procedure MyNormalPixel{$i lape.proc}
+begin
+  target.DrawPixel(PInt32(Params^[0])^,PInt32(Params^[1])^,PBGRAPixel(Params^[2])^);
+end;
+
+procedure MyLinearPixel{$i lape.proc}
+begin
+  target.FastBlendPixel(PInt32(Params^[0])^,PInt32(Params^[1])^,PBGRAPixel(Params^[2])^);
+end;
+
+procedure MyXorPixel{$i lape.proc}
+begin
+  target.XorPixel(PInt32(Params^[0])^,PInt32(Params^[1])^,PBGRAPixel(Params^[2])^);
+end;
+
+procedure MyErasePixel{$i lape.proc}
+begin
+  target.ErasePixel(PInt32(Params^[0])^,PInt32(Params^[1])^,PByte(Params^[2])^);
+end;
+
+procedure MyDrawPixel{$i lape.proc}
+begin
+  case TDrawMode(PInt32(Params^[3])^) of
+  dmSet: target.SetPixel(PInt32(Params^[0])^,PInt32(Params^[1])^,PBGRAPixel(Params^[2])^);
+  dmSetExceptTransparent: if PBGRAPixel(Params^[2])^.alpha = 255 then target.SetPixel(PInt32(Params^[0])^,PInt32(Params^[1])^,PBGRAPixel(Params^[2])^);
+  dmLinearBlend: target.FastBlendPixel(PInt32(Params^[0])^,PInt32(Params^[1])^,PBGRAPixel(Params^[2])^);
+  dmDrawWithTransparency: target.DrawPixel(PInt32(Params^[0])^,PInt32(Params^[1])^,PBGRAPixel(Params^[2])^);
+  dmXor: target.XorPixel(PInt32(Params^[0])^,PInt32(Params^[1])^,PBGRAPixel(Params^[2])^);
+  end;
+end;
+
+procedure MyAlphaPixel{$i lape.proc}
+begin
+  target.AlphaPixel(PInt32(Params^[0])^,PInt32(Params^[1])^,PByte(Params^[2])^);
+end;
+
+procedure MyGetPixel{$i lape.func}
+begin
+  TBGRAPixel(Result^) := target.GetPixel(PInt32(Params^[0])^,PInt32(Params^[1])^);
+end;
+
+procedure MyGetPixelSingle{$i lape.func}
+begin
+  TBGRAPixel(Result^) := target.GetPixel(PSingle(Params^[0])^,PSingle(Params^[1])^);
+end;
+
+procedure MyGetPixelSingleCycleX{$i lape.func}
+begin
+  TBGRAPixel(Result^) := target.GetPixelCycle(PSingle(Params^[0])^,PSingle(Params^[1])^,rfLinear,true,false);
+end;
+
+procedure MyGetPixelSingleCycleY{$i lape.func}
+begin
+  TBGRAPixel(Result^) := target.GetPixelCycle(PSingle(Params^[0])^,PSingle(Params^[1])^,rfLinear,false,true);
+end;
+
+procedure MyGetPixelSingleCycleXY{$i lape.func}
+begin
+  TBGRAPixel(Result^) := target.GetPixelCycle(PSingle(Params^[0])^,PSingle(Params^[1])^,rfLinear,true,true);
+end;
+
+procedure MyFill{$i lape.proc}
+begin
+  target.Fill(PBGRAPixel(Params^[0])^);
+end;
+
+procedure MyAlphaFill{$i lape.proc}
+begin
+  target.AlphaFill(PByte(Params^[0])^);
+end;
+
+procedure MyPutImage{$i lape.proc}
+begin
+  target.PutImage(PInt32(Params^[0])^,PInt32(Params^[1])^, GetBitmap(PInt32(Params^[2])^), TDrawMode(PInt32(Params^[3])^), PByte(Params^[4])^);
+end;
+
+procedure MyNewBitmap{$i lape.func}
+var idx: integer;
+  bmp: TBGRABitmap;
+begin
+  bmp := TBGRABitmap.Create(PInt32(Params^[0])^,PInt32(Params^[1])^);
+  idx := NewBitmapEntry;
+  Int32(result^) := idx;
+  bitmaps[idx].Bitmap := bmp;
+  bitmaps[idx].Registered := false;
+end;
+
+procedure MyNewBitmapFromColor{$i lape.func}
+var idx: integer;
+  bmp: TBGRABitmap;
+begin
+  bmp := TBGRABitmap.Create(PInt32(Params^[0])^,PInt32(Params^[1])^,PBGRAPixel(Params^[2])^);
+  idx := NewBitmapEntry;
+  Int32(result^) := idx;
+  bitmaps[idx].Bitmap := bmp;
+  bitmaps[idx].Registered := false;
+end;
+
+procedure MyNewBitmapFromFile{$i lape.func}
+var idx: integer;
+  bmp: TBGRABitmap;
+begin
+  bmp := TBGRABitmap.Create(PlpString(Params^[0])^,true);
+  idx := NewBitmapEntry;
+  Int32(result^) := idx;
+  bitmaps[idx].Bitmap := bmp;
+  bitmaps[idx].Registered := false;
+end;
+
+procedure MySelectedBitmap{$i lape.func}
+begin
+  Int32(result^) := targetIndex;
+end;
+
+procedure MyFreeBitmap{$i lape.proc}
+var idx: integer;
+begin
+  idx := PInt32(Params^[0])^;
+  if idx = targetIndex then
+    raise exception.Create('You cannot free the active bitmap');
+  FreeBitmap(idx);
+end;
+
+procedure MyLockBitmap{$i lape.proc}
+var idx: integer;
+begin
+  idx := PInt32(Params^[0])^;
+  if (idx >= 0) and (idx < length(bitmaps)) then
+    inc(bitmaps[idx].LockedCount);
+end;
+
+procedure MyUnlockBitmap{$i lape.proc}
+var idx: integer;
+begin
+  idx := PInt32(Params^[0])^;
+  if (idx >= 0) and (idx < length(bitmaps)) then
+  begin
+    if bitmaps[idx].LockedCount <= 0 then
+      raise exception.Create('Bitmap is not locked');
+    dec(bitmaps[idx].LockedCount);
+  end;
+end;
+
+procedure MySelectBitmap{$i lape.proc}
+var idx: integer;
+begin
+  idx := PInt32(Params^[0])^;
+  SetTargetBitmap(idx);
+end;
+
+procedure MySetBitmapSize{$i lape.proc}
+begin
+  if (targetIndex >= 0) and (targetIndex < length(bitmaps)) then
+  begin
+    if (bitmaps[targetIndex].LockedCount <> 0) then
+      raise exception.Create('Bitmap is locked');
+    target.SetSize(PInt32(Params^[0])^,PInt32(Params^[1])^);
+  end;
+end;
+
+procedure MyAssignBitmap{$i lape.proc}
+begin
+  target.Assign(GetBitmap(PInt32(Params^[0])^));
+end;
+
+procedure MyDuplicateBitmap{$i lape.func}
+var copy: TBGRABitmap;
+  srcIdx,idx: integer;
+begin
+  srcIdx := PInt32(Params^[0])^;
+  copy := GetBitmap(srcIdx).Duplicate;
+  idx := NewBitmapEntry;
+  bitmaps[idx].Bitmap := copy;
+  bitmaps[idx].Invalidated := false;
+  bitmaps[idx].Registered := false;
+  Int32(result^) := idx;
+end;
+
+procedure RegisterBasicFunctions(Compiler: TLapeCompiler);
+begin
+  Compiler.addGlobalFunc('function GetScanLine(y: Int32) : PBGRAPixel;', @MyGetScanline);
+  Compiler.addGlobalFunc('function BitmapWidth : Int32;', @MyGetBitmapWidth);
+  Compiler.addGlobalFunc('function BitmapHeight : Int32;', @MyGetBitmapHeight);
+  Compiler.addGlobalFunc('procedure FillBitmap(c: TBGRAPixel);', @MyFill);
+  Compiler.addGlobalFunc('procedure FillBitmapAlpha(alpha: byte);', @MyAlphaFill);
+  Compiler.addGlobalFunc('function BGRA(red,green,blue,alpha: byte): TBGRAPixel;', @MyBGRA4);
+  Compiler.addGlobalFunc('function BGRA(red,green,blue: byte): TBGRAPixel; overload;', @MyBGRA3);
+  Compiler.addGlobalFunc('function PtInClipRect(x, y: Int32): LongBool;', @MyPtInClipRect);
+  Compiler.addGlobalFunc('function GetClipRect: TRect;', @MyGetClipRect);
+  Compiler.addGlobalFunc('procedure SetClipRect(ARect: TRect);', @MySetClipRect);
+  Compiler.addGlobalFunc('function PtInRect(const APoint: TPoint; const ARect: TRect): LongBool;', @MyPtInRectPointFirst);
+  Compiler.addGlobalFunc('function PtInRect(const ARect: TRect; const APoint: TPoint): LongBool; overload;', @MyPtInRectPointLast);
+  Compiler.addGlobalFunc('procedure NoClip;', @MySetNoClip);
+  Compiler.addGlobalFunc('procedure SetPixel(x,y: Int32; c: TBGRAPixel);', @MySetPixel);
+  Compiler.addGlobalFunc('procedure NormalPixel(x,y: Int32; c: TBGRAPixel);', @MyNormalPixel);
+  Compiler.addGlobalFunc('procedure LinearPixel(x,y: Int32; c: TBGRAPixel);', @MyLinearPixel);
+  Compiler.addGlobalFunc('procedure XorPixel(x,y: Int32; c: TBGRAPixel);', @MyXorPixel);
+  Compiler.addGlobalFunc('procedure ErasePixel(x,y: Int32; alpha: byte);', @MyErasePixel);
+  Compiler.addGlobalFunc('procedure AlphaPixel(x,y: Int32; alpha: byte);', @MyAlphaPixel);
+  Compiler.addGlobalFunc('procedure _DrawPixel(x,y: Int32; c: TBGRAPixel; ADrawMode: Int32);', @MyDrawPixel);
+  Compiler.addGlobalFunc('function GetPixel(x,y: Int32): TBGRAPixel;', @MyGetPixel);
+  Compiler.addGlobalFunc('function GetPixel(x,y: single): TBGRAPixel; overload;', @MyGetPixelSingle);
+  Compiler.addGlobalFunc('function GetPixelCycle(x,y: single): TBGRAPixel; overload;', @MyGetPixelSingleCycleXY);
+  Compiler.addGlobalFunc('function GetPixelCycleX(x,y: single): TBGRAPixel; overload;', @MyGetPixelSingleCycleX);
+  Compiler.addGlobalFunc('function GetPixelCycleY(x,y: single): TBGRAPixel; overload;', @MyGetPixelSingleCycleY);
+  Compiler.addGlobalFunc('function CreateBitmap(width,height: Int32): TBGRABitmap;', @MyNewBitmap);
+  Compiler.addGlobalFunc('function CreateBitmap(width,height: Int32; c: TBGRAPixel): TBGRABitmap; overload;', @MyNewBitmapFromColor);
+  Compiler.addGlobalFunc('function CreateBitmap(filename: string): TBGRABitmap; overload;', @MyNewBitmapFromFile);
+  Compiler.addGlobalFunc('function SelectedBitmap: TBGRABitmap;', @MySelectedBitmap);
+  Compiler.addGlobalFunc('procedure TBGRABitmap.Free;', @MyFreeBitmap);
+  Compiler.addGlobalFunc('procedure TBGRABitmap.Select;', @MySelectBitmap);
+  Compiler.addGlobalFunc('procedure _PutImage(x,y: Int32; bmp: TBGRABitmap; ADrawMode: Int32; alpha: byte);', @MyPutImage);
+  Compiler.addGlobalFunc('procedure TBGRABitmap._Lock;', @MyLockBitmap);
+  Compiler.addGlobalFunc('procedure TBGRABitmap._Unlock;', @MyUnlockBitmap);
+  Compiler.addGlobalFunc('procedure AssignBitmap(bmp: TBGRABitmap);', @MyAssignBitmap);
+  Compiler.addGlobalFunc('procedure SetBitmapSize(width,height: integer);', @MySetBitmapSize);
+  Compiler.addGlobalFunc('function TBGRABitmap.Duplicate: TBGRABitmap;', @MyDuplicateBitmap);
+end;

bgrabitmap/test/bgralape/basic_geometry_functions.inc

@@ -0,0 +1,298 @@
+procedure MyFillRect{$i lape.proc}
+begin
+  target.FillRect(PInt32(Params^[0])^,PInt32(Params^[1])^,PInt32(Params^[2])^,PInt32(Params^[3])^,PBGRAPixel(Params^[4])^,TDrawMode(PInt32(Params^[5])^));
+end;
+
+procedure MyRectangle{$i lape.proc}
+begin
+  target.Rectangle(PInt32(Params^[0])^,PInt32(Params^[1])^,PInt32(Params^[2])^,PInt32(Params^[3])^,PBGRAPixel(Params^[4])^,TDrawMode(PInt32(Params^[5])^));
+end;
+
+procedure MyRectangleWithFill{$i lape.proc}
+begin
+  target.Rectangle(PInt32(Params^[0])^,PInt32(Params^[1])^,PInt32(Params^[2])^,PInt32(Params^[3])^,PBGRAPixel(Params^[4])^,PBGRAPixel(Params^[5])^,TDrawMode(PInt32(Params^[6])^));
+end;
+
+
+function GetSortedRect(x1,y1,x2,y2: integer): TRect;
+begin
+  if x1 > x2 then
+  begin
+    result.left := x2;
+    result.right := x1;
+  end else
+  begin
+    result.left := x1;
+    result.right := x2;
+  end;
+  if y1 > y2 then
+  begin
+    result.top := y2;
+    result.bottom := y1;
+  end else
+  begin
+    result.top := y1;
+    result.bottom := y2;
+  end;
+end;
+
+procedure MyFillRoundRect{$i lape.proc}
+var dm: TDrawMode;
+begin
+  dm := TDrawMode(PInt32(Params^[7])^);
+  if (dm in[dmDrawWithTransparency,dmLinearBlend]) and PLongBool(Params^[8])^ then
+  begin
+    target.LinearAntialiasing:= (dm=dmLinearBlend);
+    with GetSortedRect(PInt32(Params^[0])^,PInt32(Params^[1])^,PInt32(Params^[2])^,PInt32(Params^[3])^) do
+     target.FillRoundRectAntialias(Left-0.5,top-0.5,right-0.5,bottom-0.5,PSingle(Params^[4])^,PSingle(Params^[5])^,PBGRAPixel(Params^[6])^,[]);
+    target.LinearAntialiasing:= false;
+  end
+  else
+    target.FillRoundRect(PInt32(Params^[0])^,PInt32(Params^[1])^,PInt32(Params^[2])^,PInt32(Params^[3])^,round(PSingle(Params^[4])^*2),round(PSingle(Params^[5])^*2),PBGRAPixel(Params^[6])^,dm);
+end;
+
+procedure MyRoundRect{$i lape.proc}
+var dm: TDrawMode;
+begin
+  dm := TDrawMode(PInt32(Params^[7])^);
+  if (dm in[dmDrawWithTransparency,dmLinearBlend]) and PLongBool(Params^[8])^ then
+  begin
+    target.LinearAntialiasing:= (dm=dmLinearBlend);
+    with GetSortedRect(PInt32(Params^[0])^,PInt32(Params^[1])^,PInt32(Params^[2])^,PInt32(Params^[3])^) do
+     if (right>left) and (bottom>top) then
+     target.RoundRectAntialias(Left,top,right-1,bottom-1,PSingle(Params^[4])^,PSingle(Params^[5])^,PBGRAPixel(Params^[6])^,1,[]);
+    target.LinearAntialiasing:= false;
+  end
+  else
+    target.RoundRect(PInt32(Params^[0])^,PInt32(Params^[1])^,PInt32(Params^[2])^,PInt32(Params^[3])^,round(PSingle(Params^[4])^*2),round(PSingle(Params^[5])^*2),PBGRAPixel(Params^[6])^,dm);
+end;
+
+procedure MyRoundRectWithFill{$i lape.proc}
+var dm: TDrawMode;
+begin
+  dm := TDrawMode(PInt32(Params^[8])^);
+  if (dm in[dmDrawWithTransparency,dmLinearBlend]) and PLongBool(Params^[9])^ then
+  begin
+    target.LinearAntialiasing:= (dm=dmLinearBlend);
+    with GetSortedRect(PInt32(Params^[0])^,PInt32(Params^[1])^,PInt32(Params^[2])^,PInt32(Params^[3])^) do
+     if (right>left) and (bottom>top) then
+     target.RoundRectAntialias(Left,top,right-1,bottom-1,PSingle(Params^[4])^,PSingle(Params^[5])^,PBGRAPixel(Params^[6])^,1,PBGRAPixel(Params^[7])^,[]);
+    target.LinearAntialiasing:= false;
+  end
+  else
+    target.RoundRect(PInt32(Params^[0])^,PInt32(Params^[1])^,PInt32(Params^[2])^,PInt32(Params^[3])^,round(PSingle(Params^[4])^*2),round(PSingle(Params^[5])^*2),PBGRAPixel(Params^[6])^,PBGRAPixel(Params^[7])^,dm);
+end;
+
+
+
+procedure MyFillEllipseInRect{$i lape.proc}
+var dm: TDrawMode;
+begin
+  dm := TDrawMode(PInt32(Params^[5])^);
+  if (dm in[dmDrawWithTransparency,dmLinearBlend]) and PLongBool(Params^[6])^ then
+  begin
+    target.LinearAntialiasing:= (dm=dmLinearBlend);
+    with GetSortedRect(PInt32(Params^[0])^,PInt32(Params^[1])^,PInt32(Params^[2])^,PInt32(Params^[3])^) do
+     target.FillEllipseAntialias((Left+right)*0.5-0.5,(top+bottom)*0.5-0.5,(right-left)*0.5,(bottom-top)*0.5,PBGRAPixel(Params^[4])^);
+    target.LinearAntialiasing:= false;
+  end
+  else
+    target.FillEllipseInRect(rect(PInt32(Params^[0])^,PInt32(Params^[1])^,PInt32(Params^[2])^,PInt32(Params^[3])^),PBGRAPixel(Params^[4])^,dm);
+end;
+
+procedure MyEllipseInRect{$i lape.proc}
+var dm: TDrawMode;
+begin
+  dm := TDrawMode(PInt32(Params^[5])^);
+  if (dm in[dmDrawWithTransparency,dmLinearBlend]) and PLongBool(Params^[6])^ then
+  begin
+    target.LinearAntialiasing:= (dm=dmLinearBlend);
+    with GetSortedRect(PInt32(Params^[0])^,PInt32(Params^[1])^,PInt32(Params^[2])^,PInt32(Params^[3])^) do
+     if (right>left) and (bottom>top) then
+     target.EllipseAntialias((Left+right)*0.5-0.5,(top+bottom)*0.5-0.5,(right-left-1)*0.5,(bottom-top-1)*0.5,PBGRAPixel(Params^[4])^,1);
+    target.LinearAntialiasing:= false;
+  end
+  else
+    target.EllipseInRect(rect(PInt32(Params^[0])^,PInt32(Params^[1])^,PInt32(Params^[2])^,PInt32(Params^[3])^),PBGRAPixel(Params^[4])^,dm);
+end;
+
+procedure MyEllipseInRectWithFill{$i lape.proc}
+var dm: TDrawMode;
+begin
+  dm := TDrawMode(PInt32(Params^[6])^);
+  if (dm in[dmDrawWithTransparency,dmLinearBlend]) and PLongBool(Params^[7])^ then
+  begin
+    target.LinearAntialiasing:= (dm=dmLinearBlend);
+    with GetSortedRect(PInt32(Params^[0])^,PInt32(Params^[1])^,PInt32(Params^[2])^,PInt32(Params^[3])^) do
+     if (right>left) and (bottom>top) then
+     target.EllipseAntialias((Left+right)*0.5-0.5,(top+bottom)*0.5-0.5,(right-left-1)*0.5,(bottom-top-1)*0.5,PBGRAPixel(Params^[4])^,1,PBGRAPixel(Params^[5])^);
+    target.LinearAntialiasing:= false;
+  end
+  else
+    target.EllipseInRect(rect(PInt32(Params^[0])^,PInt32(Params^[1])^,PInt32(Params^[2])^,PInt32(Params^[3])^),PBGRAPixel(Params^[4])^,PBGRAPixel(Params^[5])^,dm);
+end;
+
+
+
+
+procedure MyDrawLine{$i lape.proc}
+var dm: TDrawMode;
+begin
+  dm := TDrawMode(PInt32(Params^[5])^);
+  if (dm in[dmDrawWithTransparency,dmLinearBlend]) and PLongBool(Params^[6])^ then
+  begin
+    target.LinearAntialiasing:= (dm=dmLinearBlend);
+    target.DrawLineAntialias(PInt32(Params^[0])^,PInt32(Params^[1])^,PInt32(Params^[2])^,PInt32(Params^[3])^,PBGRAPixel(Params^[4])^,true);
+    target.LinearAntialiasing:= false;
+  end
+  else
+    target.DrawLine(PInt32(Params^[0])^,PInt32(Params^[1])^,PInt32(Params^[2])^,PInt32(Params^[3])^,PBGRAPixel(Params^[4])^,true,dm);
+end;
+
+procedure MyEraseLine{$i lape.proc}
+begin
+  if PLongBool(Params^[5])^ then
+    target.EraseLineAntialias(PInt32(Params^[0])^,PInt32(Params^[1])^,PInt32(Params^[2])^,PInt32(Params^[3])^,PByte(Params^[4])^,true)
+  else
+    target.EraseLine(PInt32(Params^[0])^,PInt32(Params^[1])^,PInt32(Params^[2])^,PInt32(Params^[3])^,PByte(Params^[4])^,true);
+end;
+
+
+
+procedure MyDrawPolyLine{$i lape.proc}
+type
+  ArrayOfTPoint = array of TPoint;
+  PArrayOfTPoint = ^ArrayOfTPoint;
+var
+  pts: PArrayOfTPoint;
+  dm: TDrawMode;
+begin
+  pts := Params^[0];
+  dm := TDrawMode(PInt32(Params^[2])^);
+  if (dm in[dmDrawWithTransparency,dmLinearBlend]) and PLongBool(Params^[3])^ then
+  begin
+    target.LinearAntialiasing:= (dm=dmLinearBlend);
+    target.DrawPolyLineAntialias(pts^,PBGRAPixel(Params^[1])^,true);
+    target.LinearAntialiasing:= false;
+  end
+  else
+    target.DrawPolyLine(pts^,PBGRAPixel(Params^[1])^,true,dm);
+end;
+
+procedure MyErasePolyLine{$i lape.proc}
+type
+  ArrayOfTPoint = array of TPoint;
+  PArrayOfTPoint = ^ArrayOfTPoint;
+var
+  pts: PArrayOfTPoint;
+begin
+  pts := Params^[0];
+  if PLongBool(Params^[2])^ then
+    target.ErasePolyLineAntialias(pts^,PByte(Params^[1])^,true)
+  else
+    target.ErasePolyLine(pts^,PByte(Params^[1])^,true);
+end;
+
+procedure MyErasePolygonOutline{$i lape.proc}
+type
+  ArrayOfTPoint = array of TPoint;
+  PArrayOfTPoint = ^ArrayOfTPoint;
+var
+  pts: PArrayOfTPoint;
+begin
+  pts := Params^[0];
+  if PLongBool(Params^[2])^ then
+    target.ErasePolygonOutlineAntialias(pts^,PByte(Params^[1])^)
+  else
+    target.ErasePolygonOutline(pts^,PByte(Params^[1])^);
+end;
+
+procedure MyDrawPolygon{$i lape.proc}
+type
+  ArrayOfTPoint = array of TPoint;
+  PArrayOfTPoint = ^ArrayOfTPoint;
+var
+  pts: PArrayOfTPoint;
+  dm: TDrawMode;
+begin
+  pts := Params^[0];
+  dm := TDrawMode(PInt32(Params^[2])^);
+  if (dm in[dmDrawWithTransparency,dmLinearBlend]) and PLongBool(Params^[3])^ then
+  begin
+    target.LinearAntialiasing:= (dm=dmLinearBlend);
+    target.DrawPolygonAntialias(pts^,PBGRAPixel(Params^[1])^);
+    target.LinearAntialiasing:= false;
+  end
+  else
+    target.DrawPolygon(pts^,PBGRAPixel(Params^[1])^,dm);
+end;
+
+procedure MyFillPoly{$i lape.proc}
+type
+  ArrayOfTPoint = array of TPoint;
+  PArrayOfTPoint = ^ArrayOfTPoint;
+var
+  pts: PArrayOfTPoint;
+  ptsF: ArrayOfTPointF;
+  dm: TDrawMode;
+  i: integer;
+begin
+  pts := Params^[0];
+  setlength(ptsF, length(pts^));
+  for i := 0 to high(pts^) do
+    with pts^[i] do
+      ptsF[i] := PointF(x,y);
+  dm := TDrawMode(PInt32(Params^[2])^);
+  if (dm in[dmDrawWithTransparency,dmLinearBlend]) and PLongBool(Params^[3])^ then
+  begin
+    target.LinearAntialiasing:= (dm=dmLinearBlend);
+    target.FillPolyAntialias(ptsF,PBGRAPixel(Params^[1])^);
+    target.LinearAntialiasing:= false;
+  end
+  else
+    target.FillPoly(ptsF,PBGRAPixel(Params^[1])^,dm);
+end;
+
+procedure MyErasePoly{$i lape.proc}
+type
+  ArrayOfTPoint = array of TPoint;
+  PArrayOfTPoint = ^ArrayOfTPoint;
+var
+  pts: PArrayOfTPoint;
+  ptsF: ArrayOfTPointF;
+  i: integer;
+begin
+  pts := Params^[0];
+  setlength(ptsF, length(pts^));
+  for i := 0 to high(pts^) do
+    with pts^[i] do
+      ptsF[i] := PointF(x,y);
+  if PLongBool(Params^[2])^ then
+    target.ErasePolyAntialias(ptsF,PByte(Params^[1])^)
+  else
+    target.ErasePoly(ptsF,PByte(Params^[1])^);
+end;
+
+procedure RegisterBasicGeometryFunctions(Compiler: TLapeCompiler);
+begin
+  Compiler.addGlobalFunc('procedure _FillRect(left, top, right, bottom: Int32; c: TBGRAPixel; ADrawMode: Int32);', @MyFillRect);
+  Compiler.addGlobalFunc('procedure _Rectangle(left, top, right, bottom: Int32; c: TBGRAPixel; ADrawMode: Int32);', @MyRectangle);
+  Compiler.addGlobalFunc('procedure _RectangleWithFill(left, top, right, bottom: Int32; c,fillcolor: TBGRAPixel; ADrawMode: Int32); overload;', @MyRectangleWithFill);
+
+  Compiler.addGlobalFunc('procedure _FillRoundRect(left, top, right, bottom: Int32; rx,ry: single; c: TBGRAPixel; ADrawMode: Int32; AA: LongBool);', @MyFillRoundRect);
+  Compiler.addGlobalFunc('procedure _RoundRect(left, top, right, bottom: Int32; rx,ry: single; c: TBGRAPixel; ADrawMode: Int32; AA: LongBool);', @MyRoundRect);
+  Compiler.addGlobalFunc('procedure _RoundRectWithFill(left, top, right, bottom: Int32; rx,ry: single; c,fillcolor: TBGRAPixel; ADrawMode: Int32; AA: LongBool); overload;', @MyRoundRectWithFill);
+
+  Compiler.addGlobalFunc('procedure _FillEllipseInRect(left, top, right, bottom: Int32; c: TBGRAPixel; ADrawMode: Int32; AA: LongBool);', @MyFillEllipseInRect);
+  Compiler.addGlobalFunc('procedure _EllipseInRect(left, top, right, bottom: Int32; c: TBGRAPixel; ADrawMode: Int32; AA: LongBool);', @MyEllipseInRect);
+  Compiler.addGlobalFunc('procedure _EllipseInRectWithFill(left, top, right, bottom: Int32; c,fillcolor: TBGRAPixel; ADrawMode: Int32; AA: LongBool); overload;', @MyEllipseInRectWithFill);
+
+  Compiler.addGlobalFunc('procedure _DrawLine(x1,y1,x2,y2: Int32; c: TBGRAPixel; ADrawMode: Int32; AA: LongBool);', @MyDrawLine);
+  Compiler.addGlobalFunc('procedure _EraseLine(x1,y1,x2,y2: Int32; alpha: byte; AA: LongBool);', @MyEraseLine);
+  Compiler.addGlobalFunc('procedure _DrawPolyLine(const points: array of TPoint; c: TBGRAPixel; ADrawMode: Int32; AA: LongBool);', @MyDrawPolyLine);
+  Compiler.addGlobalFunc('procedure _ErasePolyLine(const points: array of TPoint; alpha: byte; AA: LongBool);', @MyErasePolyLine);
+  Compiler.addGlobalFunc('procedure _DrawPolygon(const points: array of TPoint; c: TBGRAPixel; ADrawMode: Int32; AA: LongBool);', @MyDrawPolygon);
+  Compiler.addGlobalFunc('procedure _ErasePolygonOutline(const points: array of TPoint; alpha: byte; AA: LongBool);', @MyErasePolygonOutline);
+  Compiler.addGlobalFunc('procedure _FillPoly(const points: array of TPoint; c: TBGRAPixel; ADrawMode: Int32; AA: LongBool);', @MyFillPoly);
+  Compiler.addGlobalFunc('procedure _ErasePoly(const points: array of TPoint; alpha: byte; AA: LongBool);', @MyErasePoly);
+end;

bgrabitmap/test/bgralape/bgralapesys.pas

@@ -0,0 +1,562 @@
+{ This file contains definitions used in Lape scripts
+  written using the script language }
+
+type
+  TBGRAPixel = packed record blue,green,red,alpha: byte; end;
+  PBGRAPixel = ^TBGRAPixel;
+  TExpandedPixel = packed record red, green, blue, alpha: word; end;
+  THSLAPixel = packed record hue, saturation, lightness, alpha: word; end;
+  TGSBAPixel = THSLAPixel;
+  TDrawMode = (dmSet,dmSetExceptTransparent,dmLinearBlend,dmDrawWithTransparency,dmXor);
+  TForEachPixelProc = procedure(x,y: Int32; var APixel: TBGRAPixel);
+  TFontStyle = (fsBold, fsItalic, fsStrikeOut, fsUnderline);
+  TFontStyles = set of TFontStyle;
+  TTextAlignment = (taLeft, taRight, taCenter);
+  TTextLayout = (tlTop, tlCenter, tlBottom);
+  TRect = record Left,Top,Right,Bottom : Int32; end;
+  TPoint = record x,y: Int32; end;
+  TPointF = record x,y: single; end;
+  TBGRABitmap = record _Handle: Int32; end;
+
+implementation
+
+//synonyms
+const  
+  taLeftJustify = taLeft;
+  taRightJustify = taRight;
+  dmNormal = dmDrawWithTransparency;
+  dmLinear = dmLinearBlend;
+  dmFastBlend = dmLinearBlend;
+
+const 
+  CSSTransparent : TBGRAPixel = [0,0,0,0];
+  CSSWhite : TBGRAPixel = [255,255,255,255];
+  CSSBlack : TBGRAPixel = [0,0,0,255];
+  
+  //Red colors
+  CSSIndianRed: TBGRAPixel = [92,92,205,255];
+  CSSLightCoral: TBGRAPixel = [128,128,240,255];
+  CSSSalmon: TBGRAPixel = [114,128,250,255];
+  CSSDarkSalmon: TBGRAPixel = [122,150,233,255];
+  CSSRed: TBGRAPixel = [0,0,255,255];
+  CSSCrimson: TBGRAPixel = [60,20,220,255];
+  CSSFireBrick: TBGRAPixel = [34,34,178,255];
+  CSSDarkRed: TBGRAPixel = [0,0,139,255];
+
+  //Pink colors
+  CSSPink: TBGRAPixel = [203,192,255,255];
+  CSSLightPink: TBGRAPixel = [193,182,255,255];
+  CSSHotPink: TBGRAPixel = [180,105,255,255];
+  CSSDeepPink: TBGRAPixel = [147,20,255,255];
+  CSSMediumVioletRed: TBGRAPixel = [133,21,199,255];
+  CSSPaleVioletRed: TBGRAPixel = [147,112,219,255];
+
+  //Orange colors
+  CSSLightSalmon: TBGRAPixel = [122,160,255,255];
+  CSSCoral: TBGRAPixel = [80,127,255,255];
+  CSSTomato: TBGRAPixel = [71,99,255,255];
+  CSSOrangeRed: TBGRAPixel = [0,69,255,255];
+  CSSDarkOrange: TBGRAPixel = [0,140,255,255];
+  CSSOrange: TBGRAPixel = [0,165,255,255];
+
+  //Yellow colors
+  CSSGold: TBGRAPixel = [0,215,255,255];
+  CSSYellow: TBGRAPixel = [0,255,255,255];
+  CSSLightYellow: TBGRAPixel = [224,255,255,255];
+  CSSLemonChiffon: TBGRAPixel = [205,250,255,255];
+  CSSLightGoldenrodYellow: TBGRAPixel = [210,250,250,255];
+  CSSPapayaWhip: TBGRAPixel = [213,239,255,255];
+  CSSMoccasin: TBGRAPixel = [181,228,255,255];
+  CSSPeachPuff: TBGRAPixel = [185,218,255,255];
+  CSSPaleGoldenrod: TBGRAPixel = [170,232,238,255];
+  CSSKhaki: TBGRAPixel = [140,230,240,255];
+  CSSDarkKhaki: TBGRAPixel = [107,183,189,255];
+
+  //Purple colors
+  CSSLavender: TBGRAPixel = [250,230,230,255];
+  CSSThistle: TBGRAPixel = [216,191,216,255];
+  CSSPlum: TBGRAPixel = [221,160,221,255];
+  CSSViolet: TBGRAPixel = [238,130,238,255];
+  CSSOrchid: TBGRAPixel = [214,112,218,255];
+  CSSFuchsia: TBGRAPixel = [255,0,255,255];
+  CSSMagenta: TBGRAPixel = [255,0,255,255];
+  CSSMediumOrchid: TBGRAPixel = [211,85,186,255];
+  CSSMediumPurple: TBGRAPixel = [219,112,147,255];
+  CSSBlueViolet: TBGRAPixel = [226,43,138,255];
+  CSSDarkViolet: TBGRAPixel = [211,0,148,255];
+  CSSDarkOrchid: TBGRAPixel = [204,50,153,255];
+  CSSDarkMagenta: TBGRAPixel = [139,0,139,255];
+  CSSPurple: TBGRAPixel = [128,0,128,255];
+  CSSIndigo: TBGRAPixel = [130,0,75,255];
+  CSSDarkSlateBlue: TBGRAPixel = [139,61,72,255];
+  CSSSlateBlue: TBGRAPixel = [205,90,106,255];
+  CSSMediumSlateBlue: TBGRAPixel = [238,104,123,255];
+
+  //Green colors
+  CSSGreenYellow: TBGRAPixel = [47,255,173,255];
+  CSSChartreuse: TBGRAPixel = [0,255,127,255];
+  CSSLawnGreen: TBGRAPixel = [0,252,124,255];
+  CSSLime: TBGRAPixel = [0,255,0,255];
+  CSSLimeGreen: TBGRAPixel = [50,205,50,255];
+  CSSPaleGreen: TBGRAPixel = [152,251,152,255];
+  CSSLightGreen: TBGRAPixel = [144,238,144,255];
+  CSSMediumSpringGreen: TBGRAPixel = [154,250,0,255];
+  CSSSpringGreen: TBGRAPixel = [127,255,0,255];
+  CSSMediumSeaGreen: TBGRAPixel = [113,179,60,255];
+  CSSSeaGreen: TBGRAPixel = [87,139,46,255];
+  CSSForestGreen: TBGRAPixel = [34,139,34,255];
+  CSSGreen: TBGRAPixel = [0,128,0,255];
+  CSSDarkGreen: TBGRAPixel = [0,100,0,255];
+  CSSYellowGreen: TBGRAPixel = [50,205,154,255];
+  CSSOliveDrab: TBGRAPixel = [35,142,107,255];
+  CSSOlive: TBGRAPixel = [0,128,128,255];
+  CSSDarkOliveGreen: TBGRAPixel = [47,107,85,255];
+  CSSMediumAquamarine: TBGRAPixel = [170,205,102,255];
+  CSSDarkSeaGreen: TBGRAPixel = [143,188,143,255];
+  CSSLightSeaGreen: TBGRAPixel = [170,178,32,255];
+  CSSDarkCyan: TBGRAPixel = [139,139,0,255];
+  CSSTeal: TBGRAPixel = [128,128,0,255];
+
+  //Blue/Cyan colors
+  CSSAqua: TBGRAPixel = [255,255,0,255];
+  CSSCyan: TBGRAPixel = [255,255,0,255];
+  CSSLightCyan: TBGRAPixel = [255,255,224,255];
+  CSSPaleTurquoise: TBGRAPixel = [238,238,175,255];
+  CSSAquamarine: TBGRAPixel = [212,255,127,255];
+  CSSTurquoise: TBGRAPixel = [208,224,64,255];
+  CSSMediumTurquoise: TBGRAPixel = [204,209,72,255];
+  CSSDarkTurquoise: TBGRAPixel = [209,206,0,255];
+  CSSCadetBlue: TBGRAPixel = [160,158,95,255];
+  CSSSteelBlue: TBGRAPixel = [180,130,70,255];
+  CSSLightSteelBlue: TBGRAPixel = [222,196,176,255];
+  CSSPowderBlue: TBGRAPixel = [230,224,176,255];
+  CSSLightBlue: TBGRAPixel = [230,216,173,255];
+  CSSSkyBlue: TBGRAPixel = [235,206,135,255];
+  CSSLightSkyBlue: TBGRAPixel = [250,206,135,255];
+  CSSDeepSkyBlue: TBGRAPixel = [255,191,0,255];
+  CSSDodgerBlue: TBGRAPixel = [255,144,30,255];
+  CSSCornflowerBlue: TBGRAPixel = [237,149,100,255];
+  CSSRoyalBlue: TBGRAPixel = [255,105,65,255];
+  CSSBlue: TBGRAPixel = [255,0,0,255];
+  CSSMediumBlue: TBGRAPixel = [205,0,0,255];
+  CSSDarkBlue: TBGRAPixel = [139,0,0,255];
+  CSSNavy: TBGRAPixel = [128,0,0,255];
+  CSSMidnightBlue: TBGRAPixel = [112,25,25,255];
+
+  //Brown colors
+  CSSCornsilk: TBGRAPixel = [220,248,255,255];
+  CSSBlanchedAlmond: TBGRAPixel = [205,235,255,255];
+  CSSBisque: TBGRAPixel = [196,228,255,255];
+  CSSNavajoWhite: TBGRAPixel = [173,222,255,255];
+  CSSWheat: TBGRAPixel = [179,222,245,255];
+  CSSBurlyWood: TBGRAPixel = [135,184,222,255];
+  CSSTan: TBGRAPixel = [140,180,210,255];
+  CSSRosyBrown: TBGRAPixel = [143,143,188,255];
+  CSSSandyBrown: TBGRAPixel = [96,164,244,255];
+  CSSGoldenrod: TBGRAPixel = [32,165,218,255];
+  CSSDarkGoldenrod: TBGRAPixel = [11,134,184,255];
+  CSSPeru: TBGRAPixel = [63,133,205,255];
+  CSSChocolate: TBGRAPixel = [30,105,210,255];
+  CSSSaddleBrown: TBGRAPixel = [19,69,139,255];
+  CSSSienna: TBGRAPixel = [45,82,160,255];
+  CSSBrown: TBGRAPixel = [42,42,165,255];
+  CSSMaroon: TBGRAPixel = [0,0,128,255];
+
+  //White colors
+  CSSSnow: TBGRAPixel = [250,250,255,255];
+  CSSHoneydew: TBGRAPixel = [240,255,250,255];
+  CSSMintCream: TBGRAPixel = [250,255,245,255];
+  CSSAzure: TBGRAPixel = [255,255,240,255];
+  CSSAliceBlue: TBGRAPixel = [255,248,240,255];
+  CSSGhostWhite: TBGRAPixel = [255,248,248,255];
+  CSSWhiteSmoke: TBGRAPixel = [245,245,245,255];
+  CSSSeashell: TBGRAPixel = [255,245,238,255];
+  CSSBeige: TBGRAPixel = [220,245,245,255];
+  CSSOldLace: TBGRAPixel = [230,245,253,255];
+  CSSFloralWhite: TBGRAPixel = [240,250,255,255];
+  CSSIvory: TBGRAPixel = [240,255,255,255];
+  CSSAntiqueWhite: TBGRAPixel = [215,235,250,255];
+  CSSLinen: TBGRAPixel = [230,240,250,255];
+  CSSLavenderBlush: TBGRAPixel = [245,240,255,255];
+  CSSMistyRose: TBGRAPixel = [255,228,255,255];
+
+  //Gray colors
+  CSSGainsboro: TBGRAPixel = [220,220,220,255];
+  CSSLightGray: TBGRAPixel = [211,211,211,255];
+  CSSSilver: TBGRAPixel = [192,192,192,255];
+  CSSDarkGray: TBGRAPixel = [169,169,169,255];
+  CSSGray: TBGRAPixel = [128,128,128,255];
+  CSSDimGray: TBGRAPixel = [105,105,105,255];
+  CSSLightSlateGray: TBGRAPixel = [153,136,119,255];
+  CSSSlateGray: TBGRAPixel = [144,128,112,255];
+  CSSDarkSlateGray: TBGRAPixel = [79,79,47,255];
+
+var
+  FontName: string = 'Arial';
+  FontStyle: TFontStyles;  
+  TextAlignment: TTextAlignment;
+  TextLayout: TTextLayout;
+  DrawMode: TDrawMode = dmDrawWithTransparency;
+  Antialiasing: boolean = true;
+
+function Odd(Value: Int32): boolean;
+begin
+  result := (Value and 1) <> 0;
+end;
+  
+function Even(Value: Int32): boolean;
+begin
+  result := (Value and 1) = 0;
+end;
+  
+procedure TextOut(x, y: single; sUTF8: string; c: TBGRAPixel); override;
+begin
+  _SetFontName(FontName);
+  _SetFontStyle(fsBold in FontStyle, fsItalic in FontStyle, fsStrikeOut in FontStyle, fsUnderline in FontStyle);
+  _SetTextAlignment(Int32(TextAlignment));
+  _SetTextLayout(Int32(TextLayout));
+  inherited(x,y,sUTF8,c);
+end;  
+
+procedure TextOutAngle(x, y, angle: single; sUTF8: string; c: TBGRAPixel); override;
+begin
+  _SetFontName(FontName);
+  _SetFontStyle(fsBold in FontStyle, fsItalic in FontStyle, fsStrikeOut in FontStyle, fsUnderline in FontStyle);
+  _SetTextAlignment(Int32(TextAlignment));
+  _SetTextLayout(Int32(TextLayout));
+  inherited(x,y,angle,sUTF8,c);
+end;  
+  
+procedure TextRect(left,top,right,bottom: Int32; sUTF8: string; c: TBGRAPixel); override;
+begin
+  _SetFontName(FontName);
+  _SetFontStyle(fsBold in FontStyle, fsItalic in FontStyle, fsStrikeOut in FontStyle, fsUnderline in FontStyle);
+  _SetTextAlignment(Int32(TextAlignment));
+  _SetTextLayout(Int32(TextLayout));
+  inherited(left,top,right,bottom,sUTF8,c);
+end;  
+
+procedure TextRect(ARect: TRect; sUTF8: string; c: TBGRAPixel); overload;
+begin
+  TextRect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, sUTF8, c);
+end;
+  
+procedure ForEachPixel(APixelProc: TForEachPixelProc); overload;
+var 
+  x,y,w,h: integer;
+  p: PBGRAPixel;
+  bmp: TBGRABitmap;
+begin
+  w := BitmapWidth;
+  h := BitmapHeight;
+  bmp := SelectedBitmap;
+  bmp._Lock;
+  for y := 0 to h-1 do
+  begin
+    bmp.Select;
+    p := GetScanLine(y);
+	for x := 0 to w-1 do
+	begin
+	  APixelProc(x,y,p^);
+	  inc(p);
+	end;
+  end;
+  bmp._Unlock;
+end;
+
+procedure FillTransparent;
+begin
+  FillBitmap(CSSTransparent);
+end;
+
+function Rect(left,top,right,bottom: Int32): TRect;
+begin
+  result.Left := left;
+  result.Top := top;
+  result.Right := right;
+  result.Bottom := bottom;
+end;
+
+function RectWithSize(left,top,width,height: Int32): TRect;
+begin
+  result.Left := left;
+  result.Top := top;
+  result.Right := left+width;
+  result.Bottom := top+height;
+end;
+
+function Point(x,y: Int32): TPoint;
+begin
+  result.x := x;
+  result.y := y;
+end;
+
+procedure SetClipRect(left,top,right,bottom: Int32); overload;
+begin
+  SetClipRect(rect(left,top,right,bottom));
+end;
+
+procedure DrawPixel(x,y : Int32; c: TBGRAPixel); overload;
+begin
+  _DrawPixel(x,y,c,Int32(DrawMode));
+end;
+
+procedure DrawLine(x1,y1,x2,y2: Int32; c: TBGRAPixel); overload;
+begin
+  _DrawLine(x1,y1,x2,y2, c, Int32(DrawMode), Antialiasing);
+end;  
+
+procedure DrawPolyLine(const points: array of TPoint; c: TBGRAPixel); overload;
+begin
+  _DrawPolyLine(points, c, Int32(DrawMode), Antialiasing);
+end;  
+
+procedure DrawPolygon(const points: array of TPoint; c: TBGRAPixel); overload;
+begin
+  _DrawPolygon(points, c, Int32(DrawMode), Antialiasing);
+end;  
+
+procedure EraseLine(x1,y1,x2,y2: Int32; alpha: byte); overload;
+begin
+  _EraseLine(x1,y1,x2,y2, alpha, Antialiasing);
+end;  
+
+procedure ErasePolyLine(const points: array of TPoint; alpha: byte); overload;
+begin
+  _ErasePolyLine(points, alpha, Antialiasing);
+end;  
+
+procedure ErasePolygonOutline(const points: array of TPoint; alpha: byte); overload;
+begin
+  _ErasePolygonOutline(points, alpha, Antialiasing);
+end;  
+
+
+
+procedure FillRect(left,top,right,bottom: Int32; c: TBGRAPixel); overload;
+begin
+  _FillRect(left,top,right,bottom, c, Int32(DrawMode));
+end;
+
+procedure FillRect(ARect: TRect; c: TBGRAPixel); overload;
+begin
+  _FillRect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, c, Int32(DrawMode));
+end;
+
+procedure Rectangle(left,top,right,bottom: Int32; c: TBGRAPixel); overload;
+begin
+  _Rectangle(left,top,right,bottom, c, Int32(DrawMode));
+end;
+
+procedure Rectangle(ARect: TRect; c: TBGRAPixel); overload;
+begin
+  _Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, c, Int32(DrawMode));
+end;
+
+procedure Rectangle(left,top,right,bottom: Int32; c,fillcolor: TBGRAPixel); overload;
+begin
+  _RectangleWithFill(left,top,right,bottom, c,fillcolor, Int32(DrawMode));
+end;
+
+procedure Rectangle(ARect: TRect; c,fillcolor: TBGRAPixel); overload;
+begin
+  _RectangleWithFill(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, c,fillcolor, Int32(DrawMode));
+end;
+
+
+procedure FillRoundRect(left,top,right,bottom: Int32; rx,ry: single; c: TBGRAPixel); overload;
+begin
+  _FillRoundRect(left,top,right,bottom,rx,ry, c, Int32(DrawMode), Antialiasing);
+end;
+
+procedure FillRoundRect(ARect: TRect; rx,ry: single; c: TBGRAPixel); overload;
+begin
+  _FillRoundRect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom,rx,ry, c, Int32(DrawMode), Antialiasing);
+end;
+
+procedure RoundRect(left,top,right,bottom: Int32; rx,ry: single; c: TBGRAPixel); overload;
+begin
+  _RoundRect(left,top,right,bottom, rx,ry,c, Int32(DrawMode), Antialiasing);
+end;
+
+procedure RoundRect(ARect: TRect; rx,ry: single; c: TBGRAPixel); overload;
+begin
+  _RoundRect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, rx,ry,c, Int32(DrawMode), Antialiasing);
+end;
+
+procedure RoundRect(left,top,right,bottom: Int32; rx,ry: single; c,fillcolor: TBGRAPixel); overload;
+begin
+  _RoundRectWithFill(left,top,right,bottom, rx,ry,c,fillcolor, Int32(DrawMode), Antialiasing);
+end;
+
+procedure RoundRect(ARect: TRect; rx,ry: single; c,fillcolor: TBGRAPixel); overload;
+begin
+  _RoundRectWithFill(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, rx,ry,c,fillcolor, Int32(DrawMode), Antialiasing);
+end;
+
+
+
+procedure FillEllipse(x,y: integer; rx,ry: single; c: TBGRAPixel);
+begin
+  _FillEllipseInRect(round(x-rx+0.5),round(y-ry+0.5),round(x+rx+0.5),round(y+ry+0.5),c, Int32(DrawMode), Antialiasing);
+end;
+
+procedure Ellipse(x,y: integer; rx,ry: single; c: TBGRAPixel);
+begin
+  _EllipseInRect(round(x-rx+0.5),round(y-ry+0.5),round(x+rx+0.5),round(y+ry+0.5),c, Int32(DrawMode), Antialiasing);
+end;
+
+procedure Ellipse(x,y: integer; rx,ry: single; c,fillcolor: TBGRAPixel); overload;
+begin
+  _EllipseInRectWithFill(round(x-rx+0.5),round(y-ry+0.5),round(x+rx+0.5),round(y+ry+0.5),c,fillcolor, Int32(DrawMode), Antialiasing);
+end;
+
+
+procedure PutImage(x,y: integer; bmp: TBGRABitmap; alpha: byte = 255); overload;
+begin
+  _PutImage(x,y, bmp, Int32(DrawMode), alpha);
+end;
+
+function BGRAToGrayscale(c: TBGRAPixel): TBGRAPixel;
+begin
+  result := GrayscaleToBGRA(GetLightness(c));
+  result.alpha := c.alpha;
+end;
+
+function ExpandedToGrayscale(ec: TExpandedPixel): TExpandedPixel;
+begin
+  result := GrayscaleToExpanded(GetLightness(ec));
+  result.alpha := ec.alpha;
+end;
+
+
+function PointF(x, y: single): TPointF;
+begin
+  Result.x := x;
+  Result.y := y;
+end;
+
+function VectEq(const pt1, pt2: TPointF): boolean;
+begin
+  result := (pt1.x = pt2.x) and (pt1.y = pt2.y);
+end;
+
+function VectSub(const pt1, pt2: TPointF): TPointF;
+begin
+  result.x := pt1.x-pt2.x;
+  result.y := pt1.y-pt2.y;
+end;
+
+function VectNeg(const pt2: TPointF): TPointF;
+begin
+  result.x := -pt2.x;
+  result.y := -pt2.y;
+end;
+
+function VectAdd(const pt1, pt2: TPointF): TPointF;
+begin
+  result.x := pt1.x+pt2.x;
+  result.y := pt1.y+pt2.y;
+end;
+
+function VectDot(const pt1, pt2: TPointF): single;
+begin
+  result := pt1.x*pt2.x + pt1.y*pt2.y;
+end;
+
+function VectScale(const pt1: TPointF; factor: single): TPointF;
+begin
+  result.x := pt1.x*factor;
+  result.y := pt1.y*factor;
+end;
+
+function VectScale(factor: single; const pt1: TPointF): TPointF; overload;
+begin
+  result.x := pt1.x*factor;
+  result.y := pt1.y*factor;
+end;
+
+function VectLen(dx, dy: single): single;
+begin
+  result := sqrt(dx*dx+dy*dy);
+end;
+
+function VectLen(v: TPointF): single; overload;
+begin
+  result := sqrt(v.x*v.x+v.y*v.y);
+end;
+
+procedure FillRectF(left, top, right, bottom: single; c: TBGRAPixel);
+begin
+  _FillRectF(left,top,right,bottom,c,Int32(DrawMode),Antialiasing);
+end;
+
+procedure RectangleF(left, top, right, bottom: single; c: TBGRAPixel; w: single);
+begin
+  _RectangleF(left,top,right,bottom,c,w,Int32(DrawMode),Antialiasing);
+end;
+ 
+procedure RectangleF(left, top, right, bottom: single; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel); overload;
+begin
+  _RectangleF(left,top,right,bottom,c,w,fillcolor,Int32(DrawMode),Antialiasing);
+end;
+
+procedure FillRoundRectF(left, top, right, bottom,rx,ry: single; c: TBGRAPixel);
+begin
+  _FillRoundRectF(left,top,right,bottom,rx,ry,c,Int32(DrawMode),Antialiasing);
+end;
+
+procedure RoundRectF(left, top, right, bottom,rx,ry: single; c: TBGRAPixel; w: single);
+begin
+  _RoundRectF(left,top,right,bottom,rx,ry,c,w,Int32(DrawMode),Antialiasing);
+end;
+ 
+procedure RoundRectF(left, top, right, bottom,rx,ry: single; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel); overload;
+begin
+  _RoundRectF(left,top,right,bottom,rx,ry,c,w,fillcolor,Int32(DrawMode),Antialiasing);
+end;
+
+procedure FillEllipseF(x,y,rx,ry: single; c: TBGRAPixel);
+begin
+  _FillEllipseF(x,y,rx,ry,c,Int32(DrawMode),Antialiasing);
+end;
+
+procedure EllipseF(x,y,rx,ry: single; c: TBGRAPixel; w: single);
+begin
+  _EllipseF(x,y,rx,ry,c,w,Int32(DrawMode),Antialiasing);
+end;
+ 
+procedure EllipseF(x,y,rx,ry: single; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel); overload;
+begin
+  _EllipseF(x,y,rx,ry,c,w,fillcolor,Int32(DrawMode),Antialiasing);
+end;
+
+procedure DrawLineF(x1,y1,x2,y2: single; c: TBGRAPixel; w: single);
+begin
+  _DrawLineF(x1,y1,x2,y2,c,w,Int32(DrawMode),Antialiasing);
+end;
+ 
+procedure DrawPolyLineF(const pts: array of TPointF; c: TBGRAPixel; w: single);
+begin
+  _DrawPolyLineF(pts,c,w,Int32(DrawMode),Antialiasing);
+end;
+ 
+procedure DrawPolygonF(const pts: array of TPointF; c: TBGRAPixel; w: single);
+begin
+  _DrawPolygonF(pts,c,w,Int32(DrawMode),Antialiasing);
+end;
+
+procedure DrawPolyLineF(const pts: array of TPointF; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel); overload;
+begin
+  _DrawPolyLineF(pts,c,w,fillcolor,Int32(DrawMode),Antialiasing);
+end;
+ 
+procedure DrawPolygonF(const pts: array of TPointF; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel); overload;
+begin
+  _DrawPolygonF(pts,c,w,fillcolor,Int32(DrawMode),Antialiasing);
+end;
+ 
+procedure FillPolyF(const pts: array of TPointF; c: TBGRAPixel);
+begin
+  _FillPolyF(pts,c,Int32(DrawMode),Antialiasing);
+end;

bgrabitmap/test/bgralape/color_functions.inc

@@ -0,0 +1,222 @@
+procedure MyGammaExpansionValue{$i lape.func}
+begin
+  Word(Result^) := GammaExpansionTab[PByte(Params^[0])^];
+end;
+
+procedure MyGammaExpansionPixel{$i lape.func}
+begin
+  TExpandedPixel(Result^) := GammaExpansion(PBGRAPixel(Params^[0])^);
+end;
+
+procedure MyGammaCompressionValue{$i lape.func}
+begin
+  Byte(Result^) := GammaCompressionTab[PWord(Params^[0])^];
+end;
+
+procedure MyGammaCompressionPixel{$i lape.func}
+type
+  PExpandedPixel = ^TExpandedPixel;
+begin
+  TBGRAPixel(Result^) := GammaCompression(PExpandedPixel(Params^[0])^);
+end;
+
+procedure MyGetIntensityExpanded{$i lape.func}
+type
+  PExpandedPixel = ^TExpandedPixel;
+begin
+  Word(Result^) := GetIntensity(PExpandedPixel(Params^[0])^);
+end;
+
+procedure MySetIntensityExpanded{$i lape.func}
+type
+  PExpandedPixel = ^TExpandedPixel;
+var v: Int32;
+begin
+  v := PInt32(Params^[1])^;
+  if v < 0 then v := 0;
+  if v > 65535 then v := 65535;
+  TExpandedPixel(Result^) := SetIntensity(PExpandedPixel(Params^[0])^, v);
+end;
+
+procedure MyGetIntensityBGRA{$i lape.func}
+begin
+  Word(Result^) := GetIntensity(GammaExpansion(PBGRAPixel(Params^[0])^));
+end;
+
+procedure MySetIntensityBGRA{$i lape.func}
+var v: Int32;
+begin
+  v := PInt32(Params^[1])^;
+  if v < 0 then v := 0;
+  if v > 65535 then v := 65535;
+  TBGRAPixel(Result^) := GammaCompression(SetIntensity(GammaExpansion(PBGRAPixel(Params^[0])^), v));
+end;
+
+
+
+procedure MyGetLightnessExpanded{$i lape.func}
+type
+  PExpandedPixel = ^TExpandedPixel;
+begin
+  Word(Result^) := GetLightness(PExpandedPixel(Params^[0])^);
+end;
+
+procedure MySetLightnessExpanded{$i lape.func}
+type
+  PExpandedPixel = ^TExpandedPixel;
+var v: Int32;
+begin
+  v := PInt32(Params^[1])^;
+  if v < 0 then v := 0;
+  if v > 65535 then v := 65535;
+  TExpandedPixel(Result^) := SetLightness(PExpandedPixel(Params^[0])^, v);
+end;
+
+procedure MyGetLightnessBGRA{$i lape.func}
+begin
+  Word(Result^) := GetLightness(GammaExpansion(PBGRAPixel(Params^[0])^));
+end;
+
+procedure MySetLightnessBGRA{$i lape.func}
+var v: Int32;
+begin
+  v := PInt32(Params^[1])^;
+  if v < 0 then v := 0;
+  if v > 65535 then v := 65535;
+  TBGRAPixel(Result^) := GammaCompression(SetLightness(GammaExpansion(PBGRAPixel(Params^[0])^), v));
+end;
+
+
+procedure MyBGRAToHSLA{$i lape.func}
+begin
+  THSLAPixel(Result^) := BGRAToHSLA(PBGRAPixel(Params^[0])^);
+end;
+
+procedure MyHSLAToBGRA{$i lape.func}
+type PHSLAPixel = ^THSLAPixel;
+begin
+  TBGRAPixel(Result^) := HSLAToBGRA(PHSLAPixel(Params^[0])^);
+end;
+
+procedure MyExpandedToHSLA{$i lape.func}
+type
+  PExpandedPixel = ^TExpandedPixel;
+begin
+  THSLAPixel(Result^) := ExpandedToHSLA(PExpandedPixel(Params^[0])^);
+end;
+
+procedure MyHSLAToExpanded{$i lape.func}
+type PHSLAPixel = ^THSLAPixel;
+begin
+  TExpandedPixel(Result^) := HSLAToExpanded(PHSLAPixel(Params^[0])^);
+end;
+
+
+procedure MyGrayscaleToBGRA{$i lape.func}
+var v: Int32;
+begin
+  v := PInt32(Params^[0])^;
+  if v < 0 then v := 0;
+  if v > 65535 then v := 65535;
+  TBGRAPixel(Result^) := GrayscaleToBGRA(v);
+end;
+
+procedure MyGrayscaleToExpanded{$i lape.func}
+var v: Int32;
+begin
+  v := PInt32(Params^[0])^;
+  if v < 0 then v := 0;
+  if v > 65535 then v := 65535;
+  with TExpandedPixel(Result^) do
+  begin
+    red := v;
+    green := v;
+    blue := v;
+    alpha := 65535;
+  end;
+end;
+
+
+procedure MyBGRAToGSBA{$i lape.func}
+begin
+  TGSBAPixel(Result^) := BGRAToGSBA(PBGRAPixel(Params^[0])^);
+end;
+
+procedure MyGSBAToBGRA{$i lape.func}
+type PGSBAPixel = ^TGSBAPixel;
+begin
+  TBGRAPixel(Result^) := GSBAToBGRA(PGSBAPixel(Params^[0])^);
+end;
+
+procedure MyExpandedToGSBA{$i lape.func}
+type
+  PExpandedPixel = ^TExpandedPixel;
+begin
+  TGSBAPixel(Result^) := ExpandedToGSBA(PExpandedPixel(Params^[0])^);
+end;
+
+procedure MyGSBAToExpanded{$i lape.func}
+type PGSBAPixel = ^TGSBAPixel;
+begin
+  TExpandedPixel(Result^) := GSBAToExpanded(PGSBAPixel(Params^[0])^);
+end;
+
+
+
+procedure MyMergeBGRAArray{$i lape.func}
+type
+  ArrayOfTBGRAPixel = array of TBGRAPixel;
+  PArrayOfTBGRAPixel = ^ArrayOfTBGRAPixel;
+var
+  p: PArrayOfTBGRAPixel;
+begin
+  p := PArrayOfTBGRAPixel(Params^[0]);
+  TBGRAPixel(Result^) := MergeBGRA(p^);
+end;
+
+procedure MyMergeBGRAWithWeight{$i lape.func}
+begin
+  TBGRAPixel(Result^) := MergeBGRA(PBGRAPixel(Params^[0])^,PInt32(Params^[1])^,PBGRAPixel(Params^[2])^,PInt32(Params^[3])^);
+end;
+
+
+procedure MyBGRAToStr{$i lape.func}
+begin
+  lpString(Result^) := BGRAToStr(PBGRAPixel(Params^[0])^,CSSColors);
+end;
+
+procedure MyStrToBGRA{$i lape.func}
+begin
+  TBGRAPixel(Result^) := StrToBGRA(PlpString(Params^[0])^);
+end;
+
+
+procedure RegisterColorFunctions(Compiler: TLapeCompiler);
+begin
+  Compiler.addGlobalFunc('function GammaExpansion(AValue: Byte): Word;', @MyGammaExpansionValue);
+  Compiler.addGlobalFunc('function GammaExpansion(APixel: TBGRAPixel): TExpandedPixel; overload;', @MyGammaExpansionPixel);
+  Compiler.addGlobalFunc('function GammaCompression(AValue: Word): Byte;', @MyGammaCompressionValue);
+  Compiler.addGlobalFunc('function GammaCompression(const APixel: TExpandedPixel): TBGRAPixel; overload;', @MyGammaCompressionPixel);
+  Compiler.addGlobalFunc('function GetIntensity(ec: TExpandedPixel): Word;', @MyGetIntensityExpanded);
+  Compiler.addGlobalFunc('function SetIntensity(ec: TExpandedPixel; AIntensity: Int32): TExpandedPixel;', @MySetIntensityExpanded);
+  Compiler.addGlobalFunc('function GetIntensity(c: TBGRAPixel): Word; overload;', @MyGetIntensityBGRA);
+  Compiler.addGlobalFunc('function SetIntensity(c: TBGRAPixel; AIntensity: Int32): TBGRAPixel; overload;', @MySetIntensityBGRA);
+  Compiler.addGlobalFunc('function GetLightness(ec: TExpandedPixel): Word;', @MyGetLightnessExpanded);
+  Compiler.addGlobalFunc('function SetLightness(ec: TExpandedPixel; ALightness: Int32): TExpandedPixel;', @MySetLightnessExpanded);
+  Compiler.addGlobalFunc('function GetLightness(c: TBGRAPixel): Word; overload;', @MyGetLightnessBGRA);
+  Compiler.addGlobalFunc('function SetLightness(c: TBGRAPixel; ALightness: Int32): TBGRAPixel; overload;', @MySetLightnessBGRA);
+  Compiler.addGlobalFunc('function BGRAToHSLA(c: TBGRAPixel): THSLAPixel;', @MyBGRAToHSLA);
+  Compiler.addGlobalFunc('function ExpandedToHSLA(c: TExpandedPixel): THSLAPixel;', @MyExpandedToHSLA);
+  Compiler.addGlobalFunc('function HSLAToBGRA(c: THSLAPixel): TBGRAPixel;', @MyHSLAToBGRA);
+  Compiler.addGlobalFunc('function HSLAToExpanded(c: THSLAPixel): TExpandedPixel;', @MyHSLAToExpanded);
+  Compiler.addGlobalFunc('function GrayscaleToBGRA(ALightness: Int32): TBGRAPixel;', @MyGrayscaleToBGRA);
+  Compiler.addGlobalFunc('function GrayscaleToExpanded(ALightness: Int32): TExpandedPixel;', @MyGrayscaleToExpanded);
+  Compiler.addGlobalFunc('function BGRAToGSBA(c: TBGRAPixel): TGSBAPixel;', @MyBGRAToGSBA);
+  Compiler.addGlobalFunc('function ExpandedToGSBA(c: TExpandedPixel): TGSBAPixel;', @MyExpandedToGSBA);
+  Compiler.addGlobalFunc('function GSBAToBGRA(c: TGSBAPixel): TBGRAPixel;', @MyGSBAToBGRA);
+  Compiler.addGlobalFunc('function GSBAToExpanded(c: TGSBAPixel): TExpandedPixel;', @MyGSBAToExpanded);
+  Compiler.addGlobalFunc('function MergeBGRA(const colors: array of TBGRAPixel): TBGRAPixel;', @MyMergeBGRAArray);
+  Compiler.addGlobalFunc('function MergeBGRA(c1: TBGRAPixel; w1: Int32; c2: TBGRAPixel; w2: Int32): TBGRAPixel; overload;', @MyMergeBGRAWithWeight);
+  Compiler.addGlobalFunc('function BGRAToStr(c: TBGRAPixel): string;', @MyBGRAToStr);
+  Compiler.addGlobalFunc('function StrToBGRA(s: string): TBGRAPixel;', @MyStrToBGRA);
+end;

bgrabitmap/test/bgralape/extended_geometry_functions.inc

@@ -0,0 +1,358 @@
+procedure MyFillRectF{$i lape.proc}
+var dm: TDrawMode; aa: boolean;
+  x1,y1,x2,y2: single;
+begin
+  dm := TDrawMode(PInt32(Params^[5])^);
+  aa := PLongBool(Params^[6])^;
+  x1 := PSingle(Params^[0])^;
+  y1 := PSingle(Params^[1])^;
+  x2 := PSingle(Params^[2])^;
+  y2 := PSingle(Params^[3])^;
+  if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
+  begin
+    target.LinearAntialiasing:= (dm=dmLinearBlend);
+    target.FillRectAntialias(x1,y1,x2,y2,PBGRAPixel(Params^[4])^);
+    target.LinearAntialiasing:= false;
+  end
+  else
+    target.FillPoly([PointF(x1,y1),PointF(x2,y1),PointF(x2,y2),PointF(x1,y2)],PBGRAPixel(Params^[4])^,dm);
+end;
+
+procedure MyRectangleF{$i lape.proc}
+var dm: TDrawMode; aa: boolean;
+  x1,y1,x2,y2: single;
+begin
+  dm := TDrawMode(PInt32(Params^[6])^);
+  aa := PLongBool(Params^[7])^;
+  x1 := PSingle(Params^[0])^;
+  y1 := PSingle(Params^[1])^;
+  x2 := PSingle(Params^[2])^;
+  y2 := PSingle(Params^[3])^;
+  if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
+  begin
+    target.LinearAntialiasing:= (dm=dmLinearBlend);
+    target.RectangleAntialias(x1,y1,x2,y2,PBGRAPixel(Params^[4])^,PSingle(Params^[5])^);
+    target.LinearAntialiasing:= false;
+  end
+  else
+    target.FillPoly(target.ComputeWidePolygon([PointF(x1,y1),PointF(x2,y1),PointF(x2,y2),PointF(x1,y2)],PSingle(Params^[5])^),PBGRAPixel(Params^[4])^,dm);
+end;
+
+procedure MyRectangleWithFillF{$i lape.proc}
+var dm: TDrawMode; aa: boolean;
+  x1,y1,x2,y2: single;
+  m: TBGRAMultishapeFiller;
+begin
+  dm := TDrawMode(PInt32(Params^[7])^);
+  aa := PLongBool(Params^[8])^;
+  x1 := PSingle(Params^[0])^;
+  y1 := PSingle(Params^[1])^;
+  x2 := PSingle(Params^[2])^;
+  y2 := PSingle(Params^[3])^;
+  if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
+  begin
+    target.LinearAntialiasing:= (dm=dmLinearBlend);
+    target.RectangleAntialias(x1,y1,x2,y2,PBGRAPixel(Params^[4])^,PSingle(Params^[5])^,PBGRAPixel(Params^[6])^);
+    target.LinearAntialiasing:= false;
+  end
+  else
+  begin
+    m := TBGRAMultishapeFiller.Create;
+    m.PolygonOrder:= poLastOnTop;
+    m.Antialiasing := false;
+    m.AddRectangle(x1,y1,x2,y2,PBGRAPixel(Params^[6])^);
+    m.AddPolygon(target.ComputeWidePolygon([PointF(x1,y1),PointF(x2,y1),PointF(x2,y2),PointF(x1,y2)],PSingle(Params^[5])^),PBGRAPixel(Params^[4])^);
+    m.Draw(target, dm);
+    m.Free;
+  end;
+end;
+
+
+
+procedure MyFillRoundRectF{$i lape.proc}
+var dm: TDrawMode; aa: boolean;
+  x1,y1,x2,y2: single;
+  fill: TFillShapeInfo;
+begin
+  dm := TDrawMode(PInt32(Params^[7])^);
+  aa := PLongBool(Params^[8])^;
+  x1 := PSingle(Params^[0])^;
+  y1 := PSingle(Params^[1])^;
+  x2 := PSingle(Params^[2])^;
+  y2 := PSingle(Params^[3])^;
+  if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
+  begin
+    target.LinearAntialiasing:= (dm=dmLinearBlend);
+    target.FillRoundRectAntialias(x1,y1,x2,y2,PSingle(Params^[4])^,PSingle(Params^[5])^,PBGRAPixel(Params^[6])^,[]);
+    target.LinearAntialiasing := false;
+  end
+  else
+  begin
+    fill := TFillRoundRectangleInfo.Create(x1,y1,x2,y2,PSingle(Params^[4])^,PSingle(Params^[5])^,[]);
+    target.FillShape(fill,PBGRAPixel(Params^[6])^,dm);
+    fill.Free;
+  end;
+end;
+
+procedure MyRoundRectF{$i lape.proc}
+var dm: TDrawMode; aa: boolean;
+  x1,y1,x2,y2: single;
+begin
+  dm := TDrawMode(PInt32(Params^[8])^);
+  aa := PLongBool(Params^[9])^;
+  x1 := PSingle(Params^[0])^;
+  y1 := PSingle(Params^[1])^;
+  x2 := PSingle(Params^[2])^;
+  y2 := PSingle(Params^[3])^;
+  if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
+  begin
+    target.LinearAntialiasing:= (dm=dmLinearBlend);
+    target.RoundRectAntialias(x1,y1,x2,y2,PSingle(Params^[4])^,PSingle(Params^[5])^,PBGRAPixel(Params^[6])^,PSingle(Params^[7])^,[]);
+    target.LinearAntialiasing := false;
+  end
+  else
+    target.FillPoly(target.ComputeWidePolygon(target.ComputeRoundRect(x1,y1,x2,y2,PSingle(Params^[4])^,PSingle(Params^[5])^,[]),PSingle(Params^[7])^),PBGRAPixel(Params^[6])^,dm);
+end;
+
+procedure MyRoundRectWithFillF{$i lape.proc}
+var dm: TDrawMode; aa: boolean;
+  x1,y1,x2,y2: single;
+  m: TBGRAMultishapeFiller;
+begin
+  dm := TDrawMode(PInt32(Params^[9])^);
+  aa := PLongBool(Params^[10])^;
+  x1 := PSingle(Params^[0])^;
+  y1 := PSingle(Params^[1])^;
+  x2 := PSingle(Params^[2])^;
+  y2 := PSingle(Params^[3])^;
+  if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
+  begin
+    target.LinearAntialiasing:= (dm=dmLinearBlend);
+    target.RoundRectAntialias(x1,y1,x2,y2,PSingle(Params^[4])^,PSingle(Params^[5])^,PBGRAPixel(Params^[6])^,PSingle(Params^[7])^,PBGRAPixel(Params^[8])^,[]);
+    target.LinearAntialiasing := false;
+  end
+  else
+  begin
+    m := TBGRAMultishapeFiller.Create;
+    m.PolygonOrder:= poLastOnTop;
+    m.Antialiasing := false;
+    m.AddRoundRectangle(x1,y1,x2,y2,PSingle(Params^[4])^,PSingle(Params^[5])^,PBGRAPixel(Params^[8])^);
+    m.AddPolygon(target.ComputeWidePolygon(target.ComputeRoundRect(x1,y1,x2,y2,PSingle(Params^[4])^,PSingle(Params^[5])^,[]),PSingle(Params^[7])^),PBGRAPixel(Params^[6])^);
+    m.Draw(target, dm);
+    m.Free;
+  end;
+end;
+
+
+
+procedure MyFillEllipseF{$i lape.proc}
+var dm: TDrawMode; aa: boolean;
+  x,y,rx,ry: single;
+  fill: TFillShapeInfo;
+begin
+  dm := TDrawMode(PInt32(Params^[5])^);
+  aa := PLongBool(Params^[6])^;
+  x := PSingle(Params^[0])^;
+  y := PSingle(Params^[1])^;
+  rx := PSingle(Params^[2])^;
+  ry := PSingle(Params^[3])^;
+  if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
+  begin
+    target.LinearAntialiasing:= (dm=dmLinearBlend);
+    target.FillEllipseAntialias(x,y,rx,ry,PBGRAPixel(Params^[4])^);
+    target.LinearAntialiasing:= false;
+  end
+  else
+  begin
+    if (rx = 0) or (ry = 0) or (x = EmptySingle) or (y = EmptySingle) then exit;
+    fill := TFillEllipseInfo.Create(x,y,rx,ry);
+    target.FillShape(fill, PBGRAPixel(Params^[4])^,dm);
+    fill.Free;
+  end;
+end;
+
+procedure MyEllipseF{$i lape.proc}
+var dm: TDrawMode; aa: boolean;
+  x,y,rx,ry: single;
+begin
+  dm := TDrawMode(PInt32(Params^[6])^);
+  aa := PLongBool(Params^[7])^;
+  x := PSingle(Params^[0])^;
+  y := PSingle(Params^[1])^;
+  rx := PSingle(Params^[2])^;
+  ry := PSingle(Params^[3])^;
+  if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
+  begin
+    target.LinearAntialiasing:= (dm=dmLinearBlend);
+    target.EllipseAntialias(x,y,rx,ry,PBGRAPixel(Params^[4])^,PSingle(Params^[5])^);
+    target.LinearAntialiasing:= false;
+  end
+  else
+    target.FillPoly(target.ComputeEllipseBorder(x,y,rx,ry,PSingle(Params^[5])^),PBGRAPixel(Params^[4])^,dm);
+end;
+
+procedure MyEllipseWithFillF{$i lape.proc}
+var dm: TDrawMode; aa: boolean;
+  x,y,rx,ry: single;
+  m: TBGRAMultishapeFiller;
+begin
+  dm := TDrawMode(PInt32(Params^[7])^);
+  aa := PLongBool(Params^[8])^;
+  x := PSingle(Params^[0])^;
+  y := PSingle(Params^[1])^;
+  rx := PSingle(Params^[2])^;
+  ry := PSingle(Params^[3])^;
+  if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
+  begin
+    target.LinearAntialiasing:= (dm=dmLinearBlend);
+    target.EllipseAntialias(x,y,rx,ry,PBGRAPixel(Params^[4])^,PSingle(Params^[5])^,PBGRAPixel(Params^[6])^);
+    target.LinearAntialiasing:= false;
+  end
+  else
+  begin
+    m := TBGRAMultishapeFiller.Create;
+    m.PolygonOrder:= poLastOnTop;
+    m.Antialiasing := false;
+    m.AddEllipse(x,y,rx,ry,PBGRAPixel(Params^[6])^);
+    m.AddPolygon(target.ComputeEllipseBorder(x,y,rx,ry,PSingle(Params^[5])^),PBGRAPixel(Params^[4])^);
+    m.Draw(target, dm);
+    m.Free;
+  end;
+end;
+
+
+procedure MyDrawLineF{$i lape.proc}
+var dm: TDrawMode; aa: boolean;
+  x1,y1,x2,y2: single;
+begin
+  dm := TDrawMode(PInt32(Params^[6])^);
+  aa := PLongBool(Params^[7])^;
+  x1 := PSingle(Params^[0])^;
+  y1 := PSingle(Params^[1])^;
+  x2 := PSingle(Params^[2])^;
+  y2 := PSingle(Params^[3])^;
+  if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
+    target.DrawLineAntialias(x1,y1,x2,y2,PBGRAPixel(Params^[4])^,PSingle(Params^[5])^)
+  else
+    target.FillPoly(target.ComputeWidePolyline([PointF(x1,y1),PointF(x2,y2)],PSingle(Params^[5])^),PBGRAPixel(Params^[4])^,dm);
+end;
+
+procedure MyDrawPolyLineF{$i lape.proc}
+type
+  PArrayOfTPointF = ^ArrayOfTPointF;
+var
+  pts: PArrayOfTPointF;
+  dm: TDrawMode; aa: boolean;
+begin
+  pts := Params^[0];
+  dm := TDrawMode(PInt32(Params^[3])^);
+  aa := PLongBool(Params^[4])^;
+  if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
+    target.DrawPolyLineAntialias(pts^,PBGRAPixel(Params^[1])^,PSingle(Params^[2])^)
+  else
+    target.FillPoly(target.ComputeWidePolyline(pts^,PSingle(Params^[2])^),PBGRAPixel(Params^[1])^,dm);
+end;
+
+procedure MyDrawPolygonF{$i lape.proc}
+type
+  PArrayOfTPointF = ^ArrayOfTPointF;
+var
+  pts: PArrayOfTPointF;
+  dm: TDrawMode; aa: boolean;
+begin
+  pts := Params^[0];
+  dm := TDrawMode(PInt32(Params^[3])^);
+  aa := PLongBool(Params^[4])^;
+  if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
+    target.DrawPolygonAntialias(pts^,PBGRAPixel(Params^[1])^,PSingle(Params^[2])^)
+  else
+    target.FillPoly(target.ComputeWidePolygon(pts^,PSingle(Params^[2])^),PBGRAPixel(Params^[1])^,dm);
+end;
+
+procedure MyDrawPolyLineWithFillF{$i lape.proc}
+type
+  PArrayOfTPointF = ^ArrayOfTPointF;
+var
+  pts: PArrayOfTPointF;
+  dm: TDrawMode; aa: boolean;
+  multi: TBGRAMultishapeFiller;
+begin
+  pts := Params^[0];
+  dm := TDrawMode(PInt32(Params^[4])^);
+  aa := PLongBool(Params^[5])^;
+  if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
+    target.DrawPolyLineAntialias(pts^,PBGRAPixel(Params^[1])^,PSingle(Params^[2])^,PBGRAPixel(Params^[3])^)
+  else
+  begin
+    multi := TBGRAMultishapeFiller.Create;
+    multi.PolygonOrder := poLastOnTop;
+    multi.Antialiasing := false;
+    multi.AddPolygon(pts^,PBGRAPixel(Params^[3])^);
+    multi.AddPolygon(target.ComputeWidePolyline(pts^,PSingle(Params^[2])^),PBGRAPixel(Params^[1])^);
+    multi.Draw(target,dm);
+    multi.Free;
+  end;
+end;
+
+procedure MyDrawPolygonWithFillF{$i lape.proc}
+type
+  PArrayOfTPointF = ^ArrayOfTPointF;
+var
+  pts: PArrayOfTPointF;
+  dm: TDrawMode; aa: boolean;
+  multi: TBGRAMultishapeFiller;
+begin
+  pts := Params^[0];
+  dm := TDrawMode(PInt32(Params^[4])^);
+  aa := PLongBool(Params^[5])^;
+  if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
+    target.DrawPolygonAntialias(pts^,PBGRAPixel(Params^[1])^,PSingle(Params^[2])^,PBGRAPixel(Params^[3])^)
+  else
+  begin
+    multi := TBGRAMultishapeFiller.Create;
+    multi.PolygonOrder := poLastOnTop;
+    multi.Antialiasing := false;
+    multi.AddPolygon(pts^,PBGRAPixel(Params^[3])^);
+    multi.AddPolygon(target.ComputeWidePolygon(pts^,PSingle(Params^[2])^),PBGRAPixel(Params^[1])^);
+    multi.Draw(target,dm);
+    multi.Free;
+  end;
+end;
+
+procedure MyFillPolyF{$i lape.proc}
+type
+  PArrayOfTPointF = ^ArrayOfTPointF;
+var
+  pts: PArrayOfTPointF;
+  dm: TDrawMode; aa: boolean;
+begin
+  pts := Params^[0];
+  dm := TDrawMode(PInt32(Params^[2])^);
+  aa := PLongBool(Params^[3])^;
+  if (dm in[dmDrawWithTransparency,dmLinearBlend]) and aa then
+    target.FillPolyAntialias(pts^,PBGRAPixel(Params^[1])^)
+  else
+    target.FillPoly(pts^,PBGRAPixel(Params^[1])^,dm);
+end;
+
+procedure RegisterExtendedGeometryFunctions(Compiler: TLapeCompiler);
+begin
+  Compiler.addGlobalFunc('procedure _FillRectF(left, top, right, bottom: single; c: TBGRAPixel; ADrawMode: Int32; AA: LongBool);', @MyFillRectF);
+  Compiler.addGlobalFunc('procedure _RectangleF(left, top, right, bottom: single; c: TBGRAPixel; w: single; ADrawMode: Int32; AA: LongBool);', @MyRectangleF);
+  Compiler.addGlobalFunc('procedure _RectangleF(left, top, right, bottom: single; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel; ADrawMode: Int32; AA: LongBool); overload;', @MyRectangleWithFillF);
+
+  Compiler.addGlobalFunc('procedure _FillRoundRectF(left, top, right, bottom, rx,ry: single; c: TBGRAPixel; ADrawMode: Int32; AA: LongBool);', @MyFillRoundRectF);
+  Compiler.addGlobalFunc('procedure _RoundRectF(left, top, right, bottom, rx,ry: single; c: TBGRAPixel; w: single; ADrawMode: Int32; AA: LongBool);', @MyRoundRectF);
+  Compiler.addGlobalFunc('procedure _RoundRectF(left, top, right, bottom, rx,ry: single; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel; ADrawMode: Int32; AA: LongBool); overload;', @MyRoundRectWithFillF);
+
+  Compiler.addGlobalFunc('procedure _FillEllipseF(x,y,rx,ry: single; c: TBGRAPixel; ADrawMode: Int32; AA: LongBool);', @MyFillEllipseF);
+  Compiler.addGlobalFunc('procedure _EllipseF(x,y,rx,ry: single; c: TBGRAPixel; w: single; ADrawMode: Int32; AA: LongBool);', @MyEllipseF);
+  Compiler.addGlobalFunc('procedure _EllipseF(x,y,rx,ry: single; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel; ADrawMode: Int32; AA: LongBool); overload;', @MyEllipseWithFillF);
+
+  Compiler.addGlobalFunc('procedure _DrawLineF(x1,y1,x2,y2: single; c: TBGRAPixel; w: single; ADrawMode: Int32; AA: LongBool);', @MyDrawLineF);
+  Compiler.addGlobalFunc('procedure _DrawPolyLineF(const pts: array of TPointF; c: TBGRAPixel; w: single; ADrawMode: Int32; AA: LongBool);', @MyDrawPolyLineF);
+  Compiler.addGlobalFunc('procedure _DrawPolygonF(const pts: array of TPointF; c: TBGRAPixel; w: single; ADrawMode: Int32; AA: LongBool);', @MyDrawPolygonF);
+  Compiler.addGlobalFunc('procedure _DrawPolyLineF(const pts: array of TPointF; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel; ADrawMode: Int32; AA: LongBool); overload;', @MyDrawPolyLineWithFillF);
+  Compiler.addGlobalFunc('procedure _DrawPolygonF(const pts: array of TPointF; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel; ADrawMode: Int32; AA: LongBool); overload;', @MyDrawPolygonWithFillF);
+  Compiler.addGlobalFunc('procedure _FillPolyF(const pts: array of TPointF; c: TBGRAPixel; ADrawMode: Int32; AA: LongBool);', @MyFillPolyF);
+end;

bgrabitmap/test/bgralape/lape.func

@@ -0,0 +1 @@
+({%H-}Params: PParamArray; const Result: Pointer); {$IFDEF Lape_CDECL}cdecl;{$ENDIF}

bgrabitmap/test/bgralape/lape.proc

@@ -0,0 +1 @@
+({%H-}Params: PParamArray); {$IFDEF Lape_CDECL}cdecl;{$ENDIF}

bgrabitmap/test/bgralape/pbgralape.lpi

@@ -0,0 +1,163 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="10"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="pbgralape"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <Icon Value="0"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <BuildModes Count="2">
+      <Item1 Name="Debug" Default="True"/>
+      <Item2 Name="Release">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <PathDelim Value="\"/>
+          <Target>
+            <Filename Value="pbgralape"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir)"/>
+            <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+          </SearchPaths>
+          <CodeGeneration>
+            <SmartLinkUnit Value="True"/>
+            <Optimizations>
+              <OptimizationLevel Value="3"/>
+            </Optimizations>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <GenerateDebugInfo Value="False"/>
+            </Debugging>
+            <LinkSmart Value="True"/>
+            <Options>
+              <Win32>
+                <GraphicApplication Value="True"/>
+              </Win32>
+            </Options>
+          </Linking>
+        </CompilerOptions>
+      </Item2>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="4">
+      <Item1>
+        <PackageName Value="lape"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="SynEdit"/>
+      </Item2>
+      <Item3>
+        <PackageName Value="bgracontrols"/>
+      </Item3>
+      <Item4>
+        <PackageName Value="LCL"/>
+      </Item4>
+    </RequiredPackages>
+    <Units Count="8">
+      <Unit0>
+        <Filename Value="pbgralape.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="umain.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="ubgralape.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="lape_proc.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="lape_func.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="text_functions.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit5>
+      <Unit6>
+        <Filename Value="basic_functions.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit6>
+      <Unit7>
+        <Filename Value="basic_geometry_functions.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit7>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="pbgralape"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <IncludeAssertionCode Value="True"/>
+      </SyntaxOptions>
+    </Parsing>
+    <CodeGeneration>
+      <Checks>
+        <IOChecks Value="True"/>
+        <RangeChecks Value="True"/>
+        <OverflowChecks Value="True"/>
+        <StackChecks Value="True"/>
+      </Checks>
+      <VerifyObjMethodCallValidity Value="True"/>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf2Set"/>
+        <UseHeaptrc Value="True"/>
+        <TrashVariables Value="True"/>
+        <UseExternalDbgSyms Value="True"/>
+      </Debugging>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

bgrabitmap/test/bgralape/pbgralape.lpr

@@ -0,0 +1,20 @@
+program pbgralape;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, umain, ubgralape;
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource := True;
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+

bgrabitmap/test/bgralape/tests.pas

@@ -0,0 +1,556 @@
+{ This file contains Lape test scripts }
+
+procedure TestDone(s: string);
+begin
+  ShowMessage(s);
+end;
+
+var w,h: integer;
+
+///////////////// pixel
+
+procedure TestPixelAndLine;
+var i : integer;
+  r : TRect;
+  c1,c2: TBGRAPixel;
+  pt : TPoint;
+begin
+  FillBitmap(CSSBlack);
+  Antialiasing := False;
+  for i := 1 to 10 do
+    DrawLine(random(w),random(h),random(w),random(h),MergeBGRA(StrToBGRA('Blue'), 11-i, StrToBGRA('Lime'), i));
+  Antialiasing := True;
+  for i := 1 to 10 do
+    DrawLine(random(w),random(h),random(w),random(h),BGRA(0,255,0,i*255 div 10));
+  Antialiasing := False;
+  for i := 1 to 10 do
+    EraseLine(random(w),random(h),random(w),random(h),255);
+  Antialiasing := True;
+  for i := 1 to 10 do
+    EraseLine(random(w),random(h),random(w),random(h),255);
+  
+  r := RectWithSize(w div 4, h div 4, w div 2, h div 2);
+  c1 := MergeBGRA([CSSYellow,CSSWhite]);
+  c2 := MergeBGRA([CSSYellow,CSSRed]);
+  for i := 1 to 100 do
+  begin
+    pt := Point(random(w),random(h));
+    if PtInRect(pt,r) then
+      DrawPixel(pt.x,pt.y,c1) 
+	else
+	  DrawPixel(pt.x,pt.y,c2);
+  end;
+  for i := 1 to 100 do
+    ErasePixel(random(w),random(h),128);
+  TestDone('DrawPixel+ErasePixel+DrawLine[Antialias]+EraseLine[Antialias]+MergeBGRA');
+end;
+
+procedure TestForEachPixel;
+  procedure PixelProc(x,y: Int32; var pix: TBGRAPixel);
+  var hsla: THSLAPixel;
+  begin
+    hsla.hue := (x shl 16) div w;
+	hsla.saturation := ((y shl 17) div h) and 65535;
+	hsla.alpha := 65535;
+	if y > h shr 1 then
+	begin
+	  hsla.lightness := 48000;
+	  pix := GSBAToBGRA(hsla);
+	end
+	else
+	begin
+	  hsla.lightness := 32768;
+	  pix := HSLAToBGRA(hsla);
+	end;
+  end;
+begin
+  ForEachPixel(@PixelProc);
+  TestDone('ForEachPixel+HSLAToBGRA+GSBAToBGRA');
+end;
+
+procedure TestScanline;
+var x,y,v: integer;
+  p: PBGRAPixel;
+  c: TBGRAPixel;
+  ec: TExpandedPixel;
+begin
+  for y := 0 to h-1 do
+  begin
+    p := GetScanLine(y);
+	v := (h-1-y)*65536*2 div h;
+	if v > 65535 then ec.red := 65535 else ec.red := v;
+	if v > 65535 then ec.green := v-65536 else ec.green := 0;
+	ec.blue := 0;
+	ec.alpha := 65535;	
+	c := GammaCompression(ec);
+    for x := w-1 downto 0 do
+	begin
+	  p^ := c;
+	  inc(p);
+	end;
+  end;
+  TestDone('ScanLine+GammaCompression: yellow-red gradient');
+end;
+
+procedure TestFillRect;
+const r = 10;
+var i : integer;
+	c: TBGRAPixel;
+begin
+  FillBitmap(CSSBlack);
+  c := BGRA(255,255,255,0);
+  for i := 1 to 10 do
+  begin
+    Antialiasing := Odd(i);
+	if Antialiasing then
+	begin
+      DrawMode := dmNormal;	
+      FillRoundRect(random(w),random(h),random(w),random(h),r,r,CSSOrange);
+	end
+	else
+	begin
+      DrawMode := dmXor;
+      FillRoundRect(random(w),random(h),random(w),random(h),r,r,c);
+	end;
+  end;
+  DrawMode := dmXor;
+  for i := 1 to 10 do
+    FillRect(random(w),random(h),random(w),random(h),c);
+  DrawMode := dmNormal;
+  TestDone('FillRect+FillRoundRect (r=' + IntToStr(r)+')');
+  Antialiasing := true;
+end;
+
+procedure TestRect;
+const n = 5; r = 10;
+var i : integer;
+	c: TBGRAPixel;
+begin
+  FillBitmap(CSSWhite);
+  for i := 1 to n do
+    Rectangle(random(w),random(h),random(w),random(h),BGRA(128,160,255),BGRA(0,0,255));
+  for i := 1 to n do
+  begin
+    Antialiasing := Odd(i);
+    RoundRect(random(w),random(h),random(w),random(h),r,r,BGRA(128,160,255),BGRA(0,0,255));
+  end;
+  for i := 1 to n do
+    Rectangle(random(w),random(h),random(w),random(h),CSSBlack);
+  for i := 1 to n do
+  begin
+    Antialiasing := Odd(i);
+    RoundRect(random(w),random(h),random(w),random(h),r,r,CSSBlack);
+  end;
+  TestDone('Rectangle+RoundRect (r=' + IntToStr(r)+')');
+  Antialiasing := true;
+end;
+
+procedure TestEllipse;
+const n = 5;
+var i : integer;
+	c: TBGRAPixel;
+begin
+  FillBitmap(CSSBlack);
+  for i := 1 to n do
+  begin
+    Antialiasing := Odd(i);
+    Ellipse(random(w),random(h),random(w)/2,random(h)/2,CSSMaroon,CSSRed);
+  end;
+  for i := 1 to n do
+  begin
+    Antialiasing := Odd(i);
+    FillEllipse(random(w),random(h),random(w)/2,random(h)/2,BGRA(128,160,255,64));
+  end;
+  for i := 1 to n do
+  begin
+    Antialiasing := Odd(i);
+    Ellipse(random(w),random(h),random(w)/2,random(h)/2,CSSPaleTurquoise);
+  end;
+  TestDone('FillEllipse+Ellipse');
+  Antialiasing := true;
+end;
+
+///////////// text
+
+procedure TestTextOut;
+var x,y,i,txtw,txth: integer;
+  c: TBGRAPixel;
+  text: string;
+begin
+  text := 'Hello ' + BGRAToStr(BGRA(0,0,255));
+  FillBitmap(CSSWhite);
+  x := BitmapWidth div 2;
+  y := 0;
+  txth := BitmapHeight div 5;
+  SetFontFullHeight(txth);
+  txtw := TextWidth(text);
+  if txtw > BitmapWidth then SetFontFullHeight(txth*BitmapWidth div txtw);
+  
+  TextAlignment := taCenter;
+  FontStyle := [];            TextOut(x,y,text,CSSBlack); inc(y, txth);
+  FontStyle := [fsBold];      TextOut(x,y,text,CSSBlack); inc(y, txth);
+  FontStyle := [fsItalic];    TextOut(x,y,text,CSSBlack); inc(y, txth);
+  FontStyle := [fsStrikeOut]; TextOut(x,y,text,CSSBlack); inc(y, txth);
+  FontStyle := [fsUnderline]; TextOut(x,y,text,CSSBlack); inc(y, txth);
+  
+  for i := 1 to 100 do
+  begin
+    x := random(w);
+	y := random(h);
+	FillRect(x-5,y-5,x+5,y+5,GetPixel(x,y));
+  end;
+  
+  FontStyle := [];
+  TextAlignment := taLeft;
+  TestDone('TextOut+GetPixel');
+end;
+
+procedure TestTextOutAngle;
+var x,y,i : integer;
+begin
+  FillBitmap(CSSWhite);
+  x := w div 2;
+  y := h div 2;
+  SetFontEmHeight(20);
+  TextLayout := tlCenter;
+  
+  SetClipRect(0,0,w,y);
+  for i := 0 to 5 do
+    TextOutAngle(x,y,i*3600 div 6, '  Text with angle',BGRA(192,192,192));
+  SetClipRect(0,y,w,h);
+  for i := 0 to 5 do
+    TextOutAngle(x,y,i*3600 div 6, '  Text with angle',CSSBlack);
+  NoClip;
+	
+  TextLayout := tlTop;
+
+  TextLayout := tlBottom;
+  TextAlignment := taCenter;
+  TextOut(x, BitmapHeight, 'Text in all directions', CSSBlack);
+  TextLayout := tlTop;
+  TextAlignment := taLeft;
+  
+  TestDone('TextOutAngle+Clipping');
+end;
+
+procedure TestTextRect;
+var r : TRect;  
+begin
+  FillBitmap(CSSWhite);
+  r := rect(0,0,w,h);
+  SetFontEmHeight(20);
+  TextLayout := tlTop;
+  TextAlignment := taLeft;
+  TextRect(r, 'Top-left',CSSBlack);
+  TextLayout := tlCenter;
+  TextAlignment := taCenter;
+  TextRect(r, 'Center',CSSBlack);
+  TextLayout := tlBottom;
+  TextAlignment := taRight;
+  TextRect(r, 'Bottom-Right',CSSBlack);
+  TextLayout := tlTop;
+  TextAlignment := taLeft;
+  FillBitmapAlpha(224);
+  
+  Antialiasing := False;
+  DrawPolygon([Point(w div 2,0),Point(w-1,h-1),Point(0,h-1)],CSSRed);
+  Antialiasing := True;
+  DrawPolygon([Point(w div 2,h-1),Point(w-1,0),Point(0,0)],CSSGreen);
+  Antialiasing := False;
+  ErasePolygonOutline([Point(0,h div 2),Point(w-1,0),Point(w-1,h-1)],192);
+  Antialiasing := True;
+  ErasePolygonOutline([Point(w-1,h div 2),Point(0,0),Point(0,h-1)],192);
+  
+  TestDone('TextRect+DrawPolygon[Antialias]+ErasePolygonOutline[Antialias]');
+end;
+
+/////////////////// bitmap
+
+procedure TestBitmap;
+var mainBitmap, sprite, sprite2: TBGRABitmap;
+  i: integer;
+  
+  procedure PixelSwapRedBlue(x,y: Int32; var pix: TBGRAPixel);
+  var oldRed: byte;
+  begin
+    oldRed := pix.red;
+    pix.red := pix.blue;
+    pix.blue := oldRed;
+  end;
+  
+begin  
+  FillBitmap(CSSWhite);
+  mainBitmap := SelectedBitmap;
+
+  sprite := CreateBitmap(32,32);
+  sprite.Select;
+  for i := 1 to 100 do
+    SetPixel(random(BitmapWidth),random(BitmapHeight),CSSBlack);	
+
+  mainBitmap.Select;
+  for i := 1 to 50 do
+    PutImage(random(BitmapWidth),random(BitmapHeight), sprite, i*255 div 50);	
+
+  sprite.Select;
+  SetBitmapSize(16,16);
+  FillTransparent;
+  for i := 1 to 100 do
+    SetPixel(random(BitmapWidth),random(BitmapHeight),CSSBlack);	
+
+  mainBitmap.Select;
+  for i := 1 to 50 do
+    PutImage(random(BitmapWidth),random(BitmapHeight), sprite, i*255 div 50);	
+  sprite.Free;
+
+  sprite := CreateBitmap('testimage.png');
+  sprite2 := sprite.Duplicate;
+  sprite2.Select;
+  // ToDo: fix
+  //ForEachPixel(@PixelSwapRedBlue);
+  
+  mainBitmap.Select;
+  for i := 1 to 50 do
+  begin
+    PutImage(random(BitmapWidth),random(BitmapHeight), sprite, i*255 div 50);
+    PutImage(random(BitmapWidth),random(BitmapHeight), sprite2, i*255 div 50);
+  end;
+  sprite.Free;
+  sprite2.Free;
+  
+  TestDone('CreateBitmap+PutImage');
+end;
+
+procedure TestColors;
+var x: integer;
+  
+  procedure DoStuff(var x: integer; pixProc1,pixProc2: TForEachPixelProc);
+  var
+    mainBitmap, sprite,sprite2: TBGRABitmap;
+    tx,ty: integer;  
+  begin
+  mainBitmap := SelectedBitmap;  
+  sprite := CreateBitmap('testimage.png');
+  sprite.Select;
+  tx := BitmapWidth;
+  ty := BitmapHeight;  
+  sprite2 := sprite.Duplicate;
+  
+  sprite.Select;
+  ForEachPixel(@pixProc1);  
+  mainBitmap.Select;
+  PutImage(x,0,sprite);
+  sprite.Select;
+  ForEachPixel(@pixProc1);  
+  mainBitmap.Select;
+  PutImage(x,ty,sprite);
+  sprite.Select;
+  ForEachPixel(@pixProc1);  
+  mainBitmap.Select;
+  PutImage(x,2*ty,sprite);
+  inc(x, tx);
+
+  sprite2.Select;
+  ForEachPixel(@pixProc2);  
+  mainBitmap.Select;
+  PutImage(x,0,sprite2);
+  sprite2.Select;
+  ForEachPixel(@pixProc2);  
+  mainBitmap.Select;
+  PutImage(x,ty,sprite2);
+  sprite2.Select;
+  ForEachPixel(@pixProc2);  
+  mainBitmap.Select;
+  PutImage(x,2*ty,sprite2);
+  inc(x, tx);
+  
+  sprite.Free;
+  sprite2.Free;
+  end;
+
+  procedure IntensityNotExpanded(x,y: Int32; var pix: TBGRAPixel);
+  begin
+    pix := SetIntensity(pix, GetIntensity(pix)*3 div 4);
+  end;
+
+  procedure IntensityExpanded(x,y: Int32; var pix: TBGRAPixel);
+  begin //should be the same, but via explicit conversion between TBGRAPixel and TExpandedPixel
+    pix := GammaCompression(SetIntensity(GammaExpansion(pix), GetIntensity(GammaExpansion(pix))*3 div 4));
+  end;
+
+  procedure LightnessNotExpanded(x,y: Int32; var pix: TBGRAPixel);
+  begin
+    pix := SetLightness(pix, GetLightness(pix)*4 div 3);
+  end;
+
+  procedure LightnessExpanded(x,y: Int32; var pix: TBGRAPixel);
+  begin //should be the same, but via explicit conversion between TBGRAPixel and TExpandedPixel
+    pix := GammaCompression(SetLightness(GammaExpansion(pix), GetLightness(GammaExpansion(pix))*4 div 3));
+  end;
+  
+  procedure HSLANotExpanded(x,y: Int32; var pix: TBGRAPixel);
+  var hsla: THSLAPixel;
+  begin
+    hsla := BGRAToHSLA(pix);
+	hsla.hue := hsla.hue+5000;
+    pix := HSLAToBGRA(hsla);
+  end;
+
+  procedure HSLAExpanded(x,y: Int32; var pix: TBGRAPixel);
+  //should be the same, but via explicit conversion between TBGRAPixel and TExpandedPixel
+  var hsla: THSLAPixel;
+  begin
+    hsla := ExpandedToHSLA(GammaExpansion(pix));
+	hsla.hue := hsla.hue+5000;
+    pix := GammaCompression(HSLAToExpanded(hsla));
+  end;  
+
+  procedure GSBANotExpanded(x,y: Int32; var pix: TBGRAPixel);
+  var GSBA: TGSBAPixel;
+  begin
+    GSBA := BGRAToGSBA(pix);
+	GSBA.hue := GSBA.hue+5000;
+    pix := GSBAToBGRA(GSBA);
+  end;
+
+  procedure GSBAExpanded(x,y: Int32; var pix: TBGRAPixel);
+  //should be the same, but via explicit conversion between TBGRAPixel and TExpandedPixel
+  var GSBA: TGSBAPixel;
+  begin
+    GSBA := ExpandedToGSBA(GammaExpansion(pix));
+	GSBA.hue := GSBA.hue+5000;
+    pix := GammaCompression(GSBAToExpanded(GSBA));
+  end;  
+
+  procedure GrayscaleNotExpanded(x,y: Int32; var pix: TBGRAPixel);
+  begin
+    pix := BGRAToGrayscale(pix);
+  end;
+
+  procedure GrayscaleExpanded(x,y: Int32; var pix: TBGRAPixel);
+  //should be the same, but via explicit conversion between TBGRAPixel and TExpandedPixel
+  begin    
+    pix := GammaCompression(ExpandedToGrayscale(GammaExpansion(pix)));
+  end;  
+  
+begin
+  FillBitmap(CSSWhite);
+  x := 0;
+  
+  // ToDo: fix
+  {DoStuff(x, @IntensityNotExpanded, @IntensityExpanded);
+  DoStuff(x, @LightnessNotExpanded, @LightnessExpanded);
+  DoStuff(x, @HSLANotExpanded, @HSLAExpanded);
+  DoStuff(x, @GrayscaleNotExpanded, @GrayscaleExpanded);
+  DoStuff(x, @GSBANotExpanded, @GSBAExpanded);}
+        
+  TestDone('Intensity,Lightness,HSLA,Grayscale,GSBA');
+end;
+
+////////////////// extended geometry
+
+function RandomPointF: TPointF;
+begin
+  result := PointF((random(w*10-1)-4)/10,(random(h*10-1)-4)/10);
+end;
+
+function RandomX: single;
+begin
+  result := (random(w*10-1)-4)/10;
+end;
+
+function RandomY: single;
+begin
+  result := (random(h*10-1)-4)/10;
+end;
+
+procedure TestRectF;
+const n = 3; r= 10;
+var i: integer;
+  c,c2: TBGRAPixel;
+begin
+  FillBitmap(CSSWhite);
+  c := BGRA(0,0,0,128);
+  c2 := BGRA(0,128,0,128);
+  for i := 1 to n do
+    FillRectF(RandomX,RandomY,RandomX,RandomY, c2);
+  for i := 1 to n do
+    RectangleF(RandomX,RandomY,RandomX,RandomY, c,3);
+  for i := 1 to n do
+    RectangleF(RandomX,RandomY,RandomX,RandomY, c,3,c2);
+
+  for i := 1 to n do
+    FillRoundRectF(RandomX,RandomY,RandomX,RandomY,r,r, c2);
+  for i := 1 to n do
+    RoundRectF(RandomX,RandomY,RandomX,RandomY,r,r, c,3);
+  for i := 1 to n do
+    RoundRectF(RandomX,RandomY,RandomX,RandomY,r,r, c,3,c2);
+	
+  for i := 1 to n do
+    FillEllipseF(RandomX,RandomY,RandomX/2,RandomY/2, c2);
+  for i := 1 to n do
+    EllipseF(RandomX,RandomY,RandomX/2,RandomY/2, c,3);
+  for i := 1 to n do
+    EllipseF(RandomX,RandomY,RandomX/2,RandomY/2, c,3,c2);
+  
+  TestDone('RectangleF/RoundRectF/EllipseF');
+end;
+
+procedure TestLineF;
+const n = 3;
+var i: integer;
+  c,c2: TBGRAPixel;
+begin
+  FillBitmap(CSSWhite);
+  c := BGRA(0,0,0,128);
+  c2 := BGRA(0,128,0,128);
+
+  for i := 1 to n do
+    DrawLineF(RandomX,RandomY,RandomX,RandomY, c,3);
+
+  for i := 1 to n do
+    FillPolyF([RandomPointF,RandomPointF,RandomPointF], c2);
+  for i := 1 to n do
+    DrawPolyLineF([RandomPointF,RandomPointF,RandomPointF], c,3);
+  for i := 1 to n do
+    DrawPolygonF([RandomPointF,RandomPointF,RandomPointF], c,3);
+
+  for i := 1 to n do
+    DrawPolyLineF([RandomPointF,RandomPointF,RandomPointF], c,3,c2);
+  for i := 1 to n do
+    DrawPolygonF([RandomPointF,RandomPointF,RandomPointF], c,3,c2);
+	
+  TestDone('DrawLineF, PolyLineF, PolygonF');
+end;
+
+///////////////// tests
+
+begin
+  w := BitmapWidth;
+  h := BitmapHeight;
+  
+  TestBitmap;
+  TestColors;
+  
+  TestRectF;
+  TestLineF;
+  Antialiasing := false;
+  TestRectF;
+  TestLineF;
+  DrawMode := dmSet;
+  TestRectF;
+  TestLineF;
+  DrawMode := dmNormal;
+  Antialiasing := true;
+  
+  TestPixelAndLine;
+  TestForEachPixel;  
+  TestScanline;
+  TestFillRect;
+  TestRect;
+  TestEllipse;  
+  
+  TestTextOut;
+  TestTextOutAngle;
+  TestTextRect;  
+  FillTransparent;
+end;

bgrabitmap/test/bgralape/text_functions.inc

@@ -0,0 +1,102 @@
+var
+  textAlignment: TAlignment;
+  textLayout: TTextLayout;
+
+procedure MySetFontName{$i lape.proc}
+begin
+  target.FontName := PlpString(Params^[0])^;
+end;
+
+procedure MySetFontStyle{$i lape.proc}
+var fs: TFontStyles;
+begin
+  fs := [];
+  if PLongBool(Params^[0])^ then fs += [fsBold];
+  if PLongBool(Params^[1])^ then fs += [fsItalic];
+  if PLongBool(Params^[2])^ then fs += [fsStrikeOut];
+  if PLongBool(Params^[3])^ then fs += [fsUnderline];
+  target.FontStyle := fs;
+end;
+
+procedure MySetTextAlignment{$i lape.proc}
+begin
+  textAlignment:= TAlignment(PInt32(Params^[0])^);
+end;
+
+procedure MySetTextLayout{$i lape.proc}
+begin
+  textLayout:= TTextLayout(PInt32(Params^[0])^);
+end;
+
+procedure MyGetFontFullHeight{$i lape.func}
+begin
+  Int32(Result^) := target.FontFullHeight;
+end;
+
+procedure MySetFontFullHeight{$i lape.proc}
+begin
+  target.FontFullHeight := PInt32(Params^[0])^;
+end;
+
+procedure MySetFontEmHeight{$i lape.proc}
+begin
+  target.FontHeight := PInt32(Params^[0])^;
+end;
+
+procedure MyGetFontEmHeight{$i lape.func}
+begin
+  Int32(Result^) := target.FontHeight;
+end;
+
+procedure MyGetTextWidth{$i lape.func}
+begin
+  Int32(Result^) := target.TextSize(PlpString(Params^[0])^).cx;
+end;
+
+procedure MyTextOut{$i lape.proc}
+var y: single;
+begin
+  y := PSingle(Params^[1])^;
+  if textLayout = tlCenter then y -= target.FontFullHeight/2
+  else if textLayout = tlBottom then y -= target.FontFullHeight;
+  target.TextOut(PSingle(Params^[0])^,y,PlpString(Params^[2])^,PBGRAPixel(Params^[3])^,textAlignment);
+end;
+
+procedure MyTextRect{$i lape.proc}
+var r: TRect;
+begin
+  r := rect(PInt32(Params^[0])^,PInt32(Params^[1])^,PInt32(Params^[2])^,round(PInt32(Params^[3])^));
+  target.TextRect(r,PlpString(Params^[4])^,textAlignment,textLayout,PBGRAPixel(Params^[5])^);
+end;
+
+procedure MyTextOutAngle{$i lape.proc}
+var x,y,h,angle: single;
+begin
+  x := PSingle(Params^[0])^;
+  y := PSingle(Params^[1])^;
+  if textLayout <> tlTop then
+  begin
+    h := target.FontFullHeight;
+    if textLayout = tlCenter then h *= 0.5;
+    angle := round(PSingle(Params^[2])^)*Pi/1800 + Pi/2;
+    x += cos(angle)*h;
+    y -= sin(angle)*h;
+  end;
+  target.TextOutAngle(x,y,round(PSingle(Params^[2])^),PlpString(Params^[3])^,PBGRAPixel(Params^[4])^,textAlignment);
+end;
+
+procedure RegisterTextFunctions(Compiler: TLapeCompiler);
+begin
+  Compiler.addGlobalFunc('procedure _SetFontName(s: string);', @MySetFontName);
+  Compiler.addGlobalFunc('procedure _SetFontStyle(ABold, AItalic, AStrikeOut, AUnderline: LongBool);', @MySetFontStyle);
+  Compiler.addGlobalFunc('procedure _SetTextAlignment(AAlign: Int32);', @MySetTextAlignment);
+  Compiler.addGlobalFunc('procedure _SetTextLayout(ALayout: Int32);', @MySetTextLayout);
+  Compiler.addGlobalFunc('function TextWidth(s: string) : Int32;', @MyGetTextWidth);
+  Compiler.addGlobalFunc('function GetFontFullHeight : Int32;', @MyGetFontFullHeight);
+  Compiler.addGlobalFunc('function GetFontEmHeight : Int32;', @MyGetFontEmHeight);
+  Compiler.addGlobalFunc('procedure SetFontFullHeight(AValue : Int32);', @MySetFontFullHeight);
+  Compiler.addGlobalFunc('procedure SetFontEmHeight(AValue : Int32);', @MySetFontEmHeight);
+  Compiler.addGlobalFunc('procedure TextOut(x, y: single; sUTF8: string; c: TBGRAPixel);', @MyTextOut);
+  Compiler.addGlobalFunc('procedure TextOutAngle(x, y, angle: single; sUTF8: string; c: TBGRAPixel);', @MyTextOutAngle);
+  Compiler.addGlobalFunc('procedure TextRect(left, top, right, bottom: integer; sUTF8: string; c: TBGRAPixel);', @MyTextRect);
+end;

bgrabitmap/test/bgralape/ubgralape.pas

@@ -0,0 +1,220 @@
+unit ubgralape;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, BGRABitmap, BGRABitmapTypes, lptypes, lpcompiler;
+
+function RegisterBitmap(ABitmap: TBGRABitmap): integer;
+procedure UnregisterBitmap(AIndex: integer);
+procedure EnsureInvalidate(AIndex: integer);
+procedure SetTargetBitmap(AIndex: integer);
+procedure AddScriptSystemTypes(Compiler: TLapeCompiler);
+procedure AddScriptSystemFunctions(Compiler: TLapeCompiler);
+procedure FreeBitmaps;
+
+implementation
+
+uses FileUtil, Graphics, GraphType, BGRAPolygon, BGRAFillInfo;
+
+var
+  bitmaps: array of record
+    Bitmap: TBGRABitmap;
+    Registered: boolean;
+    Invalidated: boolean;
+    LockedCount: Int32or64;
+  end;
+  target: TBGRABitmap;
+  targetIndex: integer;
+
+function NewBitmapEntry: integer;
+var i: integer;
+begin
+  for i:= 0 to high(bitmaps) do
+    if bitmaps[i].Bitmap = nil then
+      begin
+        result := i;
+        bitmaps[i].LockedCount:= 0;
+        exit;
+      end;
+  result := length(bitmaps);
+  setlength(bitmaps,length(bitmaps)*2+1);
+  bitmaps[result].LockedCount:= 0;
+end;
+
+procedure FreeBitmap(AIndex: integer);
+begin
+  if (AIndex >= 0) and (AIndex < length(bitmaps)) then
+    if not bitmaps[AIndex].Registered then
+      begin
+        if bitmaps[AIndex].LockedCount > 0 then
+          raise exception.Create('Bitmap is locked');
+        FreeAndNil(bitmaps[AIndex].Bitmap);
+        bitmaps[AIndex].Invalidated:= false;
+      end;
+end;
+
+function RegisterBitmap(ABitmap: TBGRABitmap): integer;
+begin
+  result := NewBitmapEntry;
+  bitmaps[result].Bitmap := ABitmap;
+  bitmaps[result].Invalidated := false;
+  bitmaps[result].Registered := true;
+end;
+
+procedure UnregisterBitmap(AIndex: integer);
+begin
+  if (AIndex >= 0) and (AIndex < length(bitmaps)) then
+    begin
+      EnsureInvalidate(AIndex);
+      if not bitmaps[AIndex].Registered then
+        raise Exception.Create('This bitmap has not been registered');
+      if target = bitmaps[AIndex].Bitmap then
+        begin
+          target := nil;
+          targetIndex := -1;
+        end;
+      bitmaps[AIndex].Bitmap := nil;
+      bitmaps[AIndex].Registered := false;
+    end;
+end;
+
+procedure EnsureInvalidate(AIndex: integer);
+begin
+  if (AIndex >= 0) and (AIndex < length(bitmaps)) then
+    begin
+      if bitmaps[AIndex].Invalidated then
+        begin
+          bitmaps[AIndex].Bitmap.InvalidateBitmap;
+          bitmaps[AIndex].Invalidated := false;
+        end;
+    end;
+end;
+
+procedure WillInvalidateBitmap(AIndex: integer);
+begin
+  if (AIndex >= 0) and (AIndex < length(bitmaps)) then
+    Bitmaps[AIndex].Invalidated := true;
+end;
+
+procedure SetTargetBitmap(AIndex: integer);
+begin
+  if (AIndex < 0) or (AIndex >= length(bitmaps)) or (bitmaps[AIndex].Bitmap = nil) then
+    raise exception.create('Bitmap does not exist');
+  target := bitmaps[AIndex].Bitmap;
+  targetIndex := AIndex;
+end;
+
+function GetBitmap(AIndex: integer): TBGRABitmap;
+begin
+  if (AIndex < 0) or (AIndex >= length(bitmaps)) or (Bitmaps[AIndex].Bitmap = nil) then
+    raise exception.Create('Bitmap does not exist');
+  result := Bitmaps[AIndex].Bitmap;
+end;
+
+function GetScriptSystemInlineFunctions: string; forward;
+
+///////////////////////////// Function implementation ///////////////////////////
+
+{$I basic_functions.inc}
+{$I basic_geometry_functions.inc}
+{$I extended_geometry_functions.inc}
+{$I text_functions.inc}
+{$I color_functions.inc}
+
+/////////////////////////// Function list /////////////////////////////////////////////
+
+procedure AddScriptSystemFunctions(Compiler: TLapeCompiler);
+begin
+  RegisterBasicFunctions(Compiler);
+  RegisterBasicGeometryFunctions(Compiler);
+  RegisterExtendedGeometryFunctions(Compiler);
+  RegisterTextFunctions(Compiler);
+  RegisterColorFunctions(Compiler);
+  Compiler.addDelayedCode(GetScriptSystemInlineFunctions, '',false,true);
+end;
+
+procedure FreeBitmaps;
+var i: integer;
+begin
+  for i := 0 to High(bitmaps) do
+    if (bitmaps[i].Bitmap <> nil) and not bitmaps[i].Registered then
+      begin
+        bitmaps[i].LockedCount := 0;
+        FreeBitmap(i);
+      end;
+end;
+
+////////////////////////////// Load script system //////////////////////////////
+
+var
+  scriptSystemFunctions,scriptSystemTypes: TStringList;
+
+function GetScriptSystemInlineFunctions: string;
+var i: integer;
+begin
+  result := LineEnding;
+  for i := 0 to scriptSystemFunctions.Count-1 do
+    result += scriptSystemFunctions[i]+LineEnding;
+  textAlignment:= taLeftJustify;
+end;
+
+procedure AddScriptSystemTypes(Compiler: TLapeCompiler);
+var line: string;
+  i,idxEq: integer;
+begin
+  for i := 0 to scriptSystemTypes.Count-1 do
+  begin
+    line := scriptSystemTypes[i];
+    idxEq := pos('=',line);
+    if idxEq <> 0 then
+      Compiler.addGlobalType(trim(copy(line,idxEq+1,length(line)-idxEq)),trim(copy(line,1,idxEq-1)));
+  end;
+end;
+
+procedure LoadScriptSystem;
+var
+  scriptSystem: TStringList;
+  i: integer;
+  dest: TStringList;
+begin
+  scriptSystemFunctions := TStringList.Create;
+  scriptSystemTypes := TStringList.Create;
+  dest := nil;
+
+  scriptSystem := TStringList.Create;
+  scriptSystem.LoadFromFile('bgralapesys.pas');
+
+  for i := 0 to scriptSystem.Count-1 do
+  begin
+    if CompareText(Trim(scriptSystem[i]),'implementation') = 0 then
+      dest := scriptSystemFunctions else
+    if CompareText(Trim(scriptSystem[i]),'type') = 0 then
+      dest := scriptSystemTypes else
+    if CompareText(Trim(scriptSystem[i]),'end.') = 0 then break
+    else
+      if Assigned(dest) then dest.Add(scriptSystem[i]);
+  end;
+
+  scriptSystem.Free;
+end;
+
+procedure FreeScriptSystem;
+begin
+  scriptSystemTypes.Free;
+  scriptSystemFunctions.Free;
+end;
+
+initialization
+
+  LoadScriptSystem;
+  Randomize;
+
+finalization
+
+  FreeScriptSystem;
+
+end.
+

bgrabitmap/test/bgralape/umain.lfm

@@ -0,0 +1,552 @@
+object Form1: TForm1
+  Left = 316
+  Height = 476
+  Top = 156
+  Width = 717
+  Caption = 'Form1'
+  ClientHeight = 476
+  ClientWidth = 717
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  LCLVersion = '1.0.10.0'
+  object BGRAVirtualScreen1: TBGRAVirtualScreen
+    Left = 376
+    Height = 424
+    Top = 41
+    Width = 335
+    OnRedraw = BGRAVirtualScreen1Redraw
+    Alignment = taLeftJustify
+    Anchors = [akTop, akLeft, akRight, akBottom]
+    Color = clBtnFace
+    ParentColor = False
+    TabOrder = 0
+  end
+  object Button1: TButton
+    Left = 9
+    Height = 25
+    Top = 9
+    Width = 75
+    Caption = 'Run'
+    OnClick = Button1Click
+    TabOrder = 1
+  end
+  inline SynEdit1: TSynEdit
+    Left = 8
+    Height = 426
+    Top = 41
+    Width = 360
+    Anchors = [akTop, akLeft, akBottom]
+    Font.Height = -13
+    Font.Name = 'Courier New'
+    Font.Pitch = fpFixed
+    Font.Quality = fqNonAntialiased
+    ParentColor = False
+    ParentFont = False
+    TabOrder = 2
+    Gutter.Width = 57
+    Gutter.MouseActions = <>
+    RightGutter.Width = 0
+    RightGutter.MouseActions = <>
+    Highlighter = SynFreePascalSyn1
+    Keystrokes = <    
+      item
+        Command = ecUp
+        ShortCut = 38
+      end    
+      item
+        Command = ecSelUp
+        ShortCut = 8230
+      end    
+      item
+        Command = ecScrollUp
+        ShortCut = 16422
+      end    
+      item
+        Command = ecDown
+        ShortCut = 40
+      end    
+      item
+        Command = ecSelDown
+        ShortCut = 8232
+      end    
+      item
+        Command = ecScrollDown
+        ShortCut = 16424
+      end    
+      item
+        Command = ecLeft
+        ShortCut = 37
+      end    
+      item
+        Command = ecSelLeft
+        ShortCut = 8229
+      end    
+      item
+        Command = ecWordLeft
+        ShortCut = 16421
+      end    
+      item
+        Command = ecSelWordLeft
+        ShortCut = 24613
+      end    
+      item
+        Command = ecRight
+        ShortCut = 39
+      end    
+      item
+        Command = ecSelRight
+        ShortCut = 8231
+      end    
+      item
+        Command = ecWordRight
+        ShortCut = 16423
+      end    
+      item
+        Command = ecSelWordRight
+        ShortCut = 24615
+      end    
+      item
+        Command = ecPageDown
+        ShortCut = 34
+      end    
+      item
+        Command = ecSelPageDown
+        ShortCut = 8226
+      end    
+      item
+        Command = ecPageBottom
+        ShortCut = 16418
+      end    
+      item
+        Command = ecSelPageBottom
+        ShortCut = 24610
+      end    
+      item
+        Command = ecPageUp
+        ShortCut = 33
+      end    
+      item
+        Command = ecSelPageUp
+        ShortCut = 8225
+      end    
+      item
+        Command = ecPageTop
+        ShortCut = 16417
+      end    
+      item
+        Command = ecSelPageTop
+        ShortCut = 24609
+      end    
+      item
+        Command = ecLineStart
+        ShortCut = 36
+      end    
+      item
+        Command = ecSelLineStart
+        ShortCut = 8228
+      end    
+      item
+        Command = ecEditorTop
+        ShortCut = 16420
+      end    
+      item
+        Command = ecSelEditorTop
+        ShortCut = 24612
+      end    
+      item
+        Command = ecLineEnd
+        ShortCut = 35
+      end    
+      item
+        Command = ecSelLineEnd
+        ShortCut = 8227
+      end    
+      item
+        Command = ecEditorBottom
+        ShortCut = 16419
+      end    
+      item
+        Command = ecSelEditorBottom
+        ShortCut = 24611
+      end    
+      item
+        Command = ecToggleMode
+        ShortCut = 45
+      end    
+      item
+        Command = ecCopy
+        ShortCut = 16429
+      end    
+      item
+        Command = ecPaste
+        ShortCut = 8237
+      end    
+      item
+        Command = ecDeleteChar
+        ShortCut = 46
+      end    
+      item
+        Command = ecCut
+        ShortCut = 8238
+      end    
+      item
+        Command = ecDeleteLastChar
+        ShortCut = 8
+      end    
+      item
+        Command = ecDeleteLastChar
+        ShortCut = 8200
+      end    
+      item
+        Command = ecDeleteLastWord
+        ShortCut = 16392
+      end    
+      item
+        Command = ecUndo
+        ShortCut = 32776
+      end    
+      item
+        Command = ecRedo
+        ShortCut = 40968
+      end    
+      item
+        Command = ecLineBreak
+        ShortCut = 13
+      end    
+      item
+        Command = ecSelectAll
+        ShortCut = 16449
+      end    
+      item
+        Command = ecCopy
+        ShortCut = 16451
+      end    
+      item
+        Command = ecBlockIndent
+        ShortCut = 24649
+      end    
+      item
+        Command = ecLineBreak
+        ShortCut = 16461
+      end    
+      item
+        Command = ecInsertLine
+        ShortCut = 16462
+      end    
+      item
+        Command = ecDeleteWord
+        ShortCut = 16468
+      end    
+      item
+        Command = ecBlockUnindent
+        ShortCut = 24661
+      end    
+      item
+        Command = ecPaste
+        ShortCut = 16470
+      end    
+      item
+        Command = ecCut
+        ShortCut = 16472
+      end    
+      item
+        Command = ecDeleteLine
+        ShortCut = 16473
+      end    
+      item
+        Command = ecDeleteEOL
+        ShortCut = 24665
+      end    
+      item
+        Command = ecUndo
+        ShortCut = 16474
+      end    
+      item
+        Command = ecRedo
+        ShortCut = 24666
+      end    
+      item
+        Command = ecGotoMarker0
+        ShortCut = 16432
+      end    
+      item
+        Command = ecGotoMarker1
+        ShortCut = 16433
+      end    
+      item
+        Command = ecGotoMarker2
+        ShortCut = 16434
+      end    
+      item
+        Command = ecGotoMarker3
+        ShortCut = 16435
+      end    
+      item
+        Command = ecGotoMarker4
+        ShortCut = 16436
+      end    
+      item
+        Command = ecGotoMarker5
+        ShortCut = 16437
+      end    
+      item
+        Command = ecGotoMarker6
+        ShortCut = 16438
+      end    
+      item
+        Command = ecGotoMarker7
+        ShortCut = 16439
+      end    
+      item
+        Command = ecGotoMarker8
+        ShortCut = 16440
+      end    
+      item
+        Command = ecGotoMarker9
+        ShortCut = 16441
+      end    
+      item
+        Command = ecSetMarker0
+        ShortCut = 24624
+      end    
+      item
+        Command = ecSetMarker1
+        ShortCut = 24625
+      end    
+      item
+        Command = ecSetMarker2
+        ShortCut = 24626
+      end    
+      item
+        Command = ecSetMarker3
+        ShortCut = 24627
+      end    
+      item
+        Command = ecSetMarker4
+        ShortCut = 24628
+      end    
+      item
+        Command = ecSetMarker5
+        ShortCut = 24629
+      end    
+      item
+        Command = ecSetMarker6
+        ShortCut = 24630
+      end    
+      item
+        Command = ecSetMarker7
+        ShortCut = 24631
+      end    
+      item
+        Command = ecSetMarker8
+        ShortCut = 24632
+      end    
+      item
+        Command = ecSetMarker9
+        ShortCut = 24633
+      end    
+      item
+        Command = EcFoldLevel1
+        ShortCut = 41009
+      end    
+      item
+        Command = EcFoldLevel2
+        ShortCut = 41010
+      end    
+      item
+        Command = EcFoldLevel1
+        ShortCut = 41011
+      end    
+      item
+        Command = EcFoldLevel1
+        ShortCut = 41012
+      end    
+      item
+        Command = EcFoldLevel1
+        ShortCut = 41013
+      end    
+      item
+        Command = EcFoldLevel6
+        ShortCut = 41014
+      end    
+      item
+        Command = EcFoldLevel7
+        ShortCut = 41015
+      end    
+      item
+        Command = EcFoldLevel8
+        ShortCut = 41016
+      end    
+      item
+        Command = EcFoldLevel9
+        ShortCut = 41017
+      end    
+      item
+        Command = EcFoldLevel0
+        ShortCut = 41008
+      end    
+      item
+        Command = EcFoldCurrent
+        ShortCut = 41005
+      end    
+      item
+        Command = EcUnFoldCurrent
+        ShortCut = 41003
+      end    
+      item
+        Command = EcToggleMarkupWord
+        ShortCut = 32845
+      end    
+      item
+        Command = ecNormalSelect
+        ShortCut = 24654
+      end    
+      item
+        Command = ecColumnSelect
+        ShortCut = 24643
+      end    
+      item
+        Command = ecLineSelect
+        ShortCut = 24652
+      end    
+      item
+        Command = ecTab
+        ShortCut = 9
+      end    
+      item
+        Command = ecShiftTab
+        ShortCut = 8201
+      end    
+      item
+        Command = ecMatchBracket
+        ShortCut = 24642
+      end    
+      item
+        Command = ecColSelUp
+        ShortCut = 40998
+      end    
+      item
+        Command = ecColSelDown
+        ShortCut = 41000
+      end    
+      item
+        Command = ecColSelLeft
+        ShortCut = 40997
+      end    
+      item
+        Command = ecColSelRight
+        ShortCut = 40999
+      end    
+      item
+        Command = ecColSelPageDown
+        ShortCut = 40994
+      end    
+      item
+        Command = ecColSelPageBottom
+        ShortCut = 57378
+      end    
+      item
+        Command = ecColSelPageUp
+        ShortCut = 40993
+      end    
+      item
+        Command = ecColSelPageTop
+        ShortCut = 57377
+      end    
+      item
+        Command = ecColSelLineStart
+        ShortCut = 40996
+      end    
+      item
+        Command = ecColSelLineEnd
+        ShortCut = 40995
+      end    
+      item
+        Command = ecColSelEditorTop
+        ShortCut = 57380
+      end    
+      item
+        Command = ecColSelEditorBottom
+        ShortCut = 57379
+      end>
+    MouseActions = <>
+    MouseSelActions = <>
+    Lines.Strings = (
+      'begin'
+      '  Fill(BGRABlack);'
+      '  ShowMessage(''Done'');'
+      'end;'
+    )
+    VisibleSpecialChars = [vscSpace, vscTabAtLast]
+    SelectedColor.BackPriority = 50
+    SelectedColor.ForePriority = 50
+    SelectedColor.FramePriority = 50
+    SelectedColor.BoldPriority = 50
+    SelectedColor.ItalicPriority = 50
+    SelectedColor.UnderlinePriority = 50
+    BracketHighlightStyle = sbhsBoth
+    BracketMatchColor.Background = clNone
+    BracketMatchColor.Foreground = clNone
+    BracketMatchColor.Style = [fsBold]
+    FoldedCodeColor.Background = clNone
+    FoldedCodeColor.Foreground = clGray
+    FoldedCodeColor.FrameColor = clGray
+    MouseLinkColor.Background = clNone
+    MouseLinkColor.Foreground = clBlue
+    LineHighlightColor.Background = clNone
+    LineHighlightColor.Foreground = clNone
+    inline SynLeftGutterPartList1: TSynGutterPartList
+      object SynGutterMarks1: TSynGutterMarks
+        Width = 24
+        MouseActions = <>
+      end
+      object SynGutterLineNumber1: TSynGutterLineNumber
+        Width = 17
+        MouseActions = <>
+        MarkupInfo.Background = clBtnFace
+        MarkupInfo.Foreground = clNone
+        DigitCount = 2
+        ShowOnlyLineNumbersMultiplesOf = 1
+        ZeroStart = False
+        LeadingZeros = False
+      end
+      object SynGutterChanges1: TSynGutterChanges
+        Width = 4
+        MouseActions = <>
+        ModifiedColor = 59900
+        SavedColor = clGreen
+      end
+      object SynGutterSeparator1: TSynGutterSeparator
+        Width = 2
+        MouseActions = <>
+        MarkupInfo.Background = clWhite
+        MarkupInfo.Foreground = clGray
+      end
+      object SynGutterCodeFolding1: TSynGutterCodeFolding
+        MouseActions = <>
+        MarkupInfo.Background = clNone
+        MarkupInfo.Foreground = clGray
+        MouseActionsExpanded = <>
+        MouseActionsCollapsed = <>
+      end
+    end
+  end
+  object SynFreePascalSyn1: TSynFreePascalSyn
+    Enabled = False
+    AsmAttri.FrameEdges = sfeAround
+    CommentAttri.FrameEdges = sfeAround
+    IDEDirectiveAttri.FrameEdges = sfeAround
+    IdentifierAttri.FrameEdges = sfeAround
+    KeyAttri.FrameEdges = sfeAround
+    NumberAttri.FrameEdges = sfeAround
+    SpaceAttri.FrameEdges = sfeAround
+    StringAttri.FrameEdges = sfeAround
+    SymbolAttri.FrameEdges = sfeAround
+    CaseLabelAttri.FrameEdges = sfeAround
+    DirectiveAttri.FrameEdges = sfeAround
+    CompilerMode = pcmObjFPC
+    NestedComments = True
+    left = 248
+    top = 8
+  end
+end

bgrabitmap/test/bgralape/umain.pas

@@ -0,0 +1,127 @@
+unit umain;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, SynHighlighterPas, SynEdit, Forms, Controls,
+  Graphics, Dialogs, StdCtrls, BGRAVirtualScreen, BGRABitmap;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    BGRAVirtualScreen1: TBGRAVirtualScreen;
+    Button1: TButton;
+    SynEdit1: TSynEdit;
+    SynFreePascalSyn1: TSynFreePascalSyn;
+    procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
+    procedure Button1Click(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+  private
+    { private declarations }
+  public
+    { public declarations }
+    bmp: TBGRABitmap;
+    idxBmp: integer;
+    procedure UpdateBitmap;
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+uses lpparser, lpcompiler, lputils, lpvartypes, lptypes, lpeval, lpinterpreter,
+  BGRABitmapTypes, ubgralape;
+
+{$R *.lfm}
+
+procedure MyShowMessage{$I lape.proc}
+begin
+  Form1.UpdateBitmap;
+  ShowMessage(PlpString(Params^[0])^);
+end;
+
+{ TForm1 }
+
+procedure TForm1.Button1Click(Sender: TObject);
+var
+  Parser: TLapeTokenizerBase;
+  Compiler: TLapeCompiler;
+begin
+  Parser := nil;
+  Compiler := nil;
+  try
+    Parser := TLapeTokenizerString.Create(SynEdit1.Lines.Text);
+    Compiler := TLapeCompiler.Create(Parser);
+
+    InitializePascalScriptBasics(Compiler, [psiTypeAlias]);
+    ExposeGlobals(Compiler);
+
+    Compiler.addGlobalFunc('procedure ShowMessage(s: string);', @MyShowMessage);
+
+    ubgralape.AddScriptSystemTypes(Compiler);
+    ubgralape.AddScriptSystemFunctions(Compiler);
+
+//    Compiler.addGlobalMethod('procedure _writeln; override;', @MyWriteLn, Form1);
+
+//    c := LapeImportWrapper(@StupidProc, Compiler, 'function(abc: array of integer): array of integer', FFI_SYSV);
+//    Compiler.addGlobalFunc('function StupidProc(abc: array of integer): array of integer', c.Func);
+
+    if not Compiler.Compile() then
+      raise Exception.Create('Error');
+
+    try
+      FreeAndNil(bmp);
+      bmp := TBGRABitmap.Create(BGRAVirtualScreen1.Width,BGRAVirtualScreen1.Height);
+      idxBmp:= ubgralape.RegisterBitmap(bmp);
+      ubgralape.SetTargetBitmap(idxBmp);
+      RunCode(Compiler.Emitter.Code);
+    finally
+      ubgralape.UnregisterBitmap(idxBmp);
+      idxBmp := -1;
+    end;
+  except
+    on E: Exception do
+    begin
+      ShowMessage(E.Message);
+    end;
+  end;
+  If Assigned(Compiler) then
+    FreeAndNil(Compiler)
+  else
+    FreeAndNil(Parser);
+  BGRAVirtualScreen1.DiscardBitmap;
+end;
+
+procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
+begin
+  Bitmap.DrawCheckers(rect(0,0,Bitmap.Width,Bitmap.Height),BGRAWhite,CSSSilver);
+  if Assigned(bmp) then Bitmap.PutImage(0,0,bmp,dmDrawWithTransparency);
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  SynEdit1.Lines.LoadFromFile('tests.pas');
+  bmp := nil;
+  idxBmp := -1;
+end;
+
+procedure TForm1.FormDestroy(Sender: TObject);
+begin
+  FreeAndNil(bmp);
+end;
+
+procedure TForm1.UpdateBitmap;
+begin
+  if (idxBmp = -1) or (bmp = nil) then exit;
+  ubgralape.EnsureInvalidate(idxBmp);
+  Form1.BGRAVirtualScreen1.RedrawBitmap;
+end;
+
+end.
+