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