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