556 lines
14 KiB
ObjectPascal
556 lines
14 KiB
ObjectPascal
{ 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; |