· 5 years ago · Feb 26, 2021, 07:16 PM
1{
2Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net)
3}
4
5{
6 Tunnel demo for OpenPTC 1.0 C++ API
7 Originally coded by Thomas Rizos (rizos@swipnet.se)
8 Adapted for OpenPTC by Glenn Fiedler (ptc@gaffer.org)
9 This source code is licensed under the GNU GPL
10}
11
12program Tunnel;
13
14{$MODE objfpc}
15{$MACRO ON}
16{$define xSize:=800}
17{$define ySize:=600}
18
19
20
21uses
22 ptc, Math;
23
24type
25 { tunnel class }
26 TTunnel = class
27 public
28 constructor Create;
29 destructor Destroy; override;
30 procedure setup;
31 procedure draw(buffer: PUint32; t: Single);
32 private
33 { tunnel data }
34 screenX: Integer;
35 screenY: Integer;
36 tunnel: PUint32;
37 texture: PUint8;
38 end;
39
40constructor TTunnel.Create;
41begin
42 { allocate tables }
43 //screenX:= xSize;
44 //screenY:= ySize;
45 tunnel := GetMem(screenX*screenY*SizeOf(Uint32));
46 texture := GetMem(256*256*2*SizeOf(Uint8));
47 { setup }
48 setup;
49end;
50
51destructor TTunnel.Destroy;
52begin
53 { free tables }
54 FreeMem(tunnel);
55 FreeMem(texture);
56
57 inherited Destroy;
58end;
59
60procedure TTunnel.setup;
61var
62 index: Integer;
63 x, y: Integer;
64 angle, angle1, angle2, radius, u, v: Double;
65begin
66 { tunnel index }
67 index := 0;
68
69 { generate tunnel table }
70 for y := 200 DownTo -199 do
71 for x := -320 to 319 do
72 begin
73 { calculate angle from center }
74 angle := arctan2(y, x) * 256 / pi / 2;
75
76 { calculate radius from center }
77 radius := sqrt(x * x + y * y);
78
79 { clamp radius to minimum }
80 if radius < 1 then
81 radius := 1;
82
83 { texture coordinates }
84 u := angle;
85 v := 6000 / radius;
86
87 { calculate texture index for (u,v) }
88 tunnel[index] := (Trunc(v) and $FF) * 256 + (Trunc(u) and $FF);
89 Inc(index);
90 end;
91
92 { generate blue plasma texture }
93 index := 0;
94 angle2 := pi * 2/256 * 230;
95 for y := 0 to 256 * 2 - 1 do
96 begin
97 angle1 := pi * 2/256 * 100;
98 for x := 0 to 256-1 do
99 begin
100 texture[index] := Trunc(sin(angle1)*80 + sin(angle2)*40 + 128);
101 angle1 := angle1 + pi*2/256*3;
102 Inc(index);
103 end;
104 angle2 := angle2 + pi * 2/256 *2;
105 end;
106end;
107
108procedure TTunnel.draw(buffer: PUint32; t: Single);
109var
110 x, y: Integer;
111 scroll: Uint32;
112 i: Integer;
113begin
114 { tunnel control functions }
115 x := Trunc(sin(t) * 99.9);
116 y := Trunc(t * screenY);
117
118 { calculate tunnel scroll offset }
119 scroll := ((y and $FF) shl 8) + (x and $FF);
120
121 { loop through each pixel }
122 for i := 0 to 64000-1 do
123 { lookup tunnel texture }
124 buffer[i] := texture[tunnel[i] + scroll];
125end;
126
127var
128 format: IPTCFormat;
129 console: IPTCConsole;
130 surface: IPTCSurface;
131 TheTunnel: TTunnel = nil;
132 time, delta: Single;
133 buffer: PUint32;
134 screenX: Integer;
135 screenY: Integer;
136
137begin
138screenX:= xSize;
139screenY:= ySize;
140 try
141 try
142 { create format }
143 format := TPTCFormatFactory.CreateNew(32, $00FF0000, $0000FF00, $000000FF);
144
145 { create console }
146 console := TPTCConsoleFactory.CreateNew;
147
148 { open console }
149 console.open('Tunnel demo', screenX, screenY, format);
150
151 { create surface }
152 surface := TPTCSurfaceFactory.CreateNew(screenX, screenY, format);
153
154 { create tunnel }
155 TheTunnel := TTunnel.Create;
156
157 { time data }
158 time := 0;
159 delta := 0.03;
160
161 { loop until a key is pressed }
162 while not console.KeyPressed do
163 begin
164 { lock surface }
165 buffer := surface.lock;
166 try
167 { draw tunnel }
168 TheTunnel.draw(buffer, time);
169 finally
170 { unlock surface }
171 surface.unlock;
172 end;
173
174 { copy to console }
175 surface.copy(console);
176
177 { update console }
178 console.update;
179
180 { update time }
181 time := time + delta;
182 end;
183 finally
184 TheTunnel.Free;
185 if Assigned(console) then
186 console.close;
187 end;
188 except
189 on error: TPTCError do
190 { report error }
191 error.report;
192 end;
193end.
194