1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
unit GTIWebServerTestAggActionHandlerUnit;
interface
uses
sysutils,
zstream,
ftfont,
agg_2D,
FPimage,
FPImgCanv,
FPWritePNG,
FPWriteJPEG,
agg_basics;
type
{ TTestAggActionHandler }
TTestAggActionHandler = class
public
const ImageWidth = 800;
const ImageHeight = 480;
const RGBA_Width = 4;
const LineCount = 30;
const FontFilePath = '/usr/share/fonts/TTF/DejaVuSans.ttf';
procedure HandlePlug;
procedure DrawStuff(agg: agg2D_ptr);
procedure DrawText(aImage: TFPMemoryImage);
end;
implementation
{ TTestAggActionHandler }
procedure TTestAggActionHandler.HandlePlug;
var
agg: agg2D_ptr;
buf: array of int8;
image: TFPMemoryImage;
writer: TFPWriterJPEG;
x, y: integer;
c: TFPColor;
function getBufItemAsWord(aDelta: byte): word;
var
actualY: integer;
begin
actualY := ImageHeight - y - 1;
result :=
word(buf[x * RGBA_Width + actualY * ImageWidth * RGBA_Width + aDelta] shl 8)
or word(128);
end;
begin
setLength(buf, ImageWidth * ImageHeight * RGBA_Width);
New(agg, Construct);
agg^.attach(@(buf[0]), ImageWidth, ImageHeight, ImageWidth * RGBA_Width);
DrawStuff(agg);
Dispose(agg, Destruct); // not necessary to keep it after rendering is finished
image := TFPMemoryImage.create(ImageWidth, ImageHeight);
for x := 0 to ImageWidth - 1 do
for y := 0 to ImageHeight - 1 do
begin
c.red := getBufItemAsWord(2);
c.green := getBufItemAsWord(1);
c.blue := getBufItemAsWord(0);
c.alpha := getBufItemAsWord(3);
image.Colors[x, y] := c;
end;
{
writer := TFPWriterPNG.create;
writer.CompressionLevel := clmax;
writer.WordSized := false; // reduce size
}
writer := TFPWriterJPEG.create;
writer.CompressionQuality := $FF div 3; // bad quality plz
writer.ProgressiveEncoding := true;
image.SaveToFile('wut.jpeg', writer);
image.free;
writer.free;
end;
procedure TTestAggActionHandler.DrawStuff(agg: agg2D_ptr);
var
i: integer;
x, y, px, py, d: double;
begin
agg^.clearAll(0, 0, 0);
agg^.lineColor(0, 0, 0, 255);
agg^.lineWidth(3);
agg^.rectangle(0, 0, ImageWidth, ImageHeight);
agg^.font(FontFilePath, 16);
d := ImageWidth / LineCount;
agg^.lineColor(0, 0, 0, 100);
for i := 1 to LineCount - 1 do
begin
x := i * d;
agg^.line(x, 0, x, ImageHeight );
end;
for i := 1 to trunc(ImageHeight / d) - 1 do
begin
y := i * d;
agg^.line(0, y, ImageWidth, y);
end;
x := 0;
y := ImageHeight / 2;
px := x;
py := y;
agg^.lineColor(255, 0, 0, 200);
agg^.fillColor(0, 0, 0, 200);
for i := 0 to LineCount - 1 do
begin
x := x + d;
y := y + random(round(ImageHeight / 3)) - ImageHeight / 6;
if y < 0 then
y := ImageHeight / 6;
if y >= ImageHeight then
y := ImageHeight - ImageHeight / 6;
agg^.line(px, py, x, y);
agg^.text(x, y, char_ptr(intToStr(i) + ' bla'));
px := x;
py := y;
end;
end;
procedure TTestAggActionHandler.DrawText(aImage: TFPMemoryImage);
var
canvas: TFPImageCanvas;
font: TFreeTypeFont;
begin
font := TFreeTypeFont.create;
canvas := TFPImageCanvas.create(aImage);
end;
end.
|
