1 (*
2  * Hedgewars, a free turn based strategy game
3  * Copyright (c) 2004-2012 Andrey Korotaev <unC0Rr@gmail.com>
4  *
5  * This program is free software; you can redistribute it and/or modify
6  * it under the terms of the GNU General Public License as published by
7  * the Free Software Foundation; version 2 of the License
8  *
9  * This program is distributed in the hope that it will be useful,
10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12  * GNU General Public License for more details.
13  *
14  * You should have received a copy of the GNU General Public License
15  * along with this program; if not, write to the Free Software
16  * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
17  *)
18 
19 {$INCLUDE "options.inc"}
20 
21 unit uMatrix;
22 
23 interface
24 
25 uses uTypes {$IFNDEF PAS2C}, gl{$ENDIF};
26 
27 const
28     MATRIX_MODELVIEW:Integer = 0;
29     MATRIX_PROJECTION:Integer = 1;
30 
31 procedure MatrixLoadIdentity(out Result: TMatrix4x4f);
32 procedure MatrixMultiply(out Result: TMatrix4x4f; const lhs, rhs: TMatrix4x4f);
33 
34 procedure hglMatrixMode(t: Integer);
35 procedure hglLoadIdentity();
36 procedure hglPushMatrix();
37 procedure hglPopMatrix();
38 procedure hglMVP(var res : TMatrix4x4f);
39 procedure hglScalef(x: GLfloat; y: GLfloat; z: GLfloat);
40 procedure hglTranslatef(x: GLfloat; y: GLfloat; z: GLfloat);
41 procedure hglRotatef(a:GLfloat; x:GLfloat; y:GLfloat; z:GLfloat);
42 procedure initModule();
43 procedure freeModule();
44 
45 implementation
46 
47 uses uDebug;
48 
49 const
50     MATRIX_STACK_SIZE = 10;
51 
52 type
53     TMatrixStack = record
54         top:Integer;
55         stack: array[0..9] of TMatrix4x4f;
56         end;
57 var
58     MatrixStacks : array[0..1] of TMatrixStack;
59     CurMatrix: integer;
60 
61 procedure MatrixLoadIdentity(out Result: TMatrix4x4f);
62 begin
63     Result[0,0]:= 1.0; Result[1,0]:=0.0; Result[2,0]:=0.0; Result[3,0]:=0.0;
64     Result[0,1]:= 0.0; Result[1,1]:=1.0; Result[2,1]:=0.0; Result[3,1]:=0.0;
65     Result[0,2]:= 0.0; Result[1,2]:=0.0; Result[2,2]:=1.0; Result[3,2]:=0.0;
66     Result[0,3]:= 0.0; Result[1,3]:=0.0; Result[2,3]:=0.0; Result[3,3]:=1.0;
67 end;
68 
69 procedure hglMatrixMode(t: Integer);
70 begin
71     CurMatrix := t;
72 end;
73 
74 procedure hglLoadIdentity();
75 begin
76     MatrixLoadIdentity(MatrixStacks[CurMatrix].stack[MatrixStacks[CurMatrix].top]);
77 end;
78 
79 procedure hglScalef(x: GLfloat; y: GLfloat; z: GLfloat);
80 var
81     m:TMatrix4x4f;
82     t:TMatrix4x4f;
83 begin
84     m[0,0]:=x;m[1,0]:=0;m[2,0]:=0;m[3,0]:=0;
85     m[0,1]:=0;m[1,1]:=y;m[2,1]:=0;m[3,1]:=0;
86     m[0,2]:=0;m[1,2]:=0;m[2,2]:=z;m[3,2]:=0;
87     m[0,3]:=0;m[1,3]:=0;m[2,3]:=0;m[3,3]:=1;
88 
89     MatrixMultiply(t, MatrixStacks[CurMatrix].stack[MatrixStacks[CurMatrix].top], m);
90     MatrixStacks[CurMatrix].stack[MatrixStacks[CurMatrix].top] := t;
91 end;
92 
93 procedure hglTranslatef(x: GLfloat; y: GLfloat; z: GLfloat);
94 var
95     m:TMatrix4x4f;
96     t:TMatrix4x4f;
97 begin
98     m[0,0]:=1;m[1,0]:=0;m[2,0]:=0;m[3,0]:=x;
99     m[0,1]:=0;m[1,1]:=1;m[2,1]:=0;m[3,1]:=y;
100     m[0,2]:=0;m[1,2]:=0;m[2,2]:=1;m[3,2]:=z;
101     m[0,3]:=0;m[1,3]:=0;m[2,3]:=0;m[3,3]:=1;
102 
103     MatrixMultiply(t, MatrixStacks[CurMatrix].stack[MatrixStacks[CurMatrix].top], m);
104     MatrixStacks[CurMatrix].stack[MatrixStacks[CurMatrix].top] := t;
105 end;
106 
107 procedure hglRotatef(a:GLfloat; x:GLfloat; y:GLfloat; z:GLfloat);
108 var
109     m:TMatrix4x4f;
110     t:TMatrix4x4f;
111     c:GLfloat;
112     s:GLfloat;
113     xn, yn, zn:GLfloat;
114     l:GLfloat;
115 begin
116     a:=a * 3.14159265368 / 180;
117     c:=cos(a);
118     s:=sin(a);
119 
120     l := 1.0 / sqrt(x * x + y * y + z * z);
121     xn := x * l;
122     yn := y * l;
123     zn := z * l;
124 
125     m[0,0]:=c + xn * xn * (1 - c);
126     m[1,0]:=xn * yn * (1 - c) - zn * s;
127     m[2,0]:=xn * zn * (1 - c) + yn * s;
128     m[3,0]:=0;
129 
130 
131     m[0,1]:=yn * xn * (1 - c) + zn * s;
132     m[1,1]:=c + yn * yn * (1 - c);
133     m[2,1]:=yn * zn * (1 - c) - xn * s;
134     m[3,1]:=0;
135 
136     m[0,2]:=zn * xn * (1 - c) - yn * s;
137     m[1,2]:=zn * yn * (1 - c) + xn * s;
138     m[2,2]:=c + zn * zn * (1 - c);
139     m[3,2]:=0;
140 
141     m[0,3]:=0;m[1,3]:=0;m[2,3]:=0;m[3,3]:=1;
142 
143     MatrixMultiply(t, MatrixStacks[CurMatrix].stack[MatrixStacks[CurMatrix].top], m);
144     MatrixStacks[CurMatrix].stack[MatrixStacks[CurMatrix].top] := t;
145 end;
146 
147 procedure hglMVP(var res: TMatrix4x4f);
148 begin
149     MatrixMultiply(res,
150                    MatrixStacks[MATRIX_PROJECTION].stack[MatrixStacks[MATRIX_PROJECTION].top],
151                    MatrixStacks[MATRIX_MODELVIEW].stack[MatrixStacks[MATRIX_MODELVIEW].top]);
152 end;
153 
154 procedure hglPushMatrix();
155 var
156     t: Integer;
157 begin
158     t := MatrixStacks[CurMatrix].top;
159     MatrixStacks[CurMatrix].stack[t + 1] := MatrixStacks[CurMatrix].stack[t];
160     inc(t);
161     MatrixStacks[CurMatrix].top := t;
162 end;
163 
164 procedure hglPopMatrix();
165 var
166     t: Integer;
167 begin
168     t := MatrixStacks[CurMatrix].top;
169     dec(t);
170     MatrixStacks[CurMatrix].top := t;
171 end;
172 
173 procedure initModule();
174 begin
175     MatrixStacks[MATRIX_MODELVIEW].top := 0;
176     MatrixStacks[MATRIX_Projection].top := 0;
177     MatrixLoadIdentity(MatrixStacks[MATRIX_MODELVIEW].stack[0]);
178     MatrixLoadIdentity(MatrixStacks[MATRIX_PROJECTION].stack[0]);
179 end;
180 
181 procedure freeModule();
182 begin
183 end;
184 
185 procedure MatrixMultiply(out Result: TMatrix4x4f; const lhs, rhs: TMatrix4x4f);
186 var
187     test: TMatrix4x4f;
188     i, j: Integer;
189     error: boolean;
190 begin
191     Result[0,0]:=lhs[0,0]*rhs[0,0] + lhs[1,0]*rhs[0,1] + lhs[2,0]*rhs[0,2] + lhs[3,0]*rhs[0,3];
192     Result[0,1]:=lhs[0,1]*rhs[0,0] + lhs[1,1]*rhs[0,1] + lhs[2,1]*rhs[0,2] + lhs[3,1]*rhs[0,3];
193     Result[0,2]:=lhs[0,2]*rhs[0,0] + lhs[1,2]*rhs[0,1] + lhs[2,2]*rhs[0,2] + lhs[3,2]*rhs[0,3];
194     Result[0,3]:=lhs[0,3]*rhs[0,0] + lhs[1,3]*rhs[0,1] + lhs[2,3]*rhs[0,2] + lhs[3,3]*rhs[0,3];
195 
196     Result[1,0]:=lhs[0,0]*rhs[1,0] + lhs[1,0]*rhs[1,1] + lhs[2,0]*rhs[1,2] + lhs[3,0]*rhs[1,3];
197     Result[1,1]:=lhs[0,1]*rhs[1,0] + lhs[1,1]*rhs[1,1] + lhs[2,1]*rhs[1,2] + lhs[3,1]*rhs[1,3];
198     Result[1,2]:=lhs[0,2]*rhs[1,0] + lhs[1,2]*rhs[1,1] + lhs[2,2]*rhs[1,2] + lhs[3,2]*rhs[1,3];
199     Result[1,3]:=lhs[0,3]*rhs[1,0] + lhs[1,3]*rhs[1,1] + lhs[2,3]*rhs[1,2] + lhs[3,3]*rhs[1,3];
200 
201     Result[2,0]:=lhs[0,0]*rhs[2,0] + lhs[1,0]*rhs[2,1] + lhs[2,0]*rhs[2,2] + lhs[3,0]*rhs[2,3];
202     Result[2,1]:=lhs[0,1]*rhs[2,0] + lhs[1,1]*rhs[2,1] + lhs[2,1]*rhs[2,2] + lhs[3,1]*rhs[2,3];
203     Result[2,2]:=lhs[0,2]*rhs[2,0] + lhs[1,2]*rhs[2,1] + lhs[2,2]*rhs[2,2] + lhs[3,2]*rhs[2,3];
204     Result[2,3]:=lhs[0,3]*rhs[2,0] + lhs[1,3]*rhs[2,1] + lhs[2,3]*rhs[2,2] + lhs[3,3]*rhs[2,3];
205 
206     Result[3,0]:=lhs[0,0]*rhs[3,0] + lhs[1,0]*rhs[3,1] + lhs[2,0]*rhs[3,2] + lhs[3,0]*rhs[3,3];
207     Result[3,1]:=lhs[0,1]*rhs[3,0] + lhs[1,1]*rhs[3,1] + lhs[2,1]*rhs[3,2] + lhs[3,1]*rhs[3,3];
208     Result[3,2]:=lhs[0,2]*rhs[3,0] + lhs[1,2]*rhs[3,1] + lhs[2,2]*rhs[3,2] + lhs[3,2]*rhs[3,3];
209     Result[3,3]:=lhs[0,3]*rhs[3,0] + lhs[1,3]*rhs[3,1] + lhs[2,3]*rhs[3,2] + lhs[3,3]*rhs[3,3];
210 
211 {
212     Result[0,0]:=lhs[0,0]*rhs[0,0] + lhs[1,0]*rhs[0,1] + lhs[2,0]*rhs[0,2] + lhs[3,0]*rhs[0,3];
213     Result[0,1]:=lhs[0,0]*rhs[1,0] + lhs[1,0]*rhs[1,1] + lhs[2,0]*rhs[1,2] + lhs[3,0]*rhs[1,3];
214     Result[0,2]:=lhs[0,0]*rhs[2,0] + lhs[1,0]*rhs[2,1] + lhs[2,0]*rhs[2,2] + lhs[3,0]*rhs[2,3];
215     Result[0,3]:=lhs[0,0]*rhs[3,0] + lhs[1,0]*rhs[3,1] + lhs[2,0]*rhs[3,2] + lhs[3,0]*rhs[3,3];
216 
217     Result[1,0]:=lhs[0,1]*rhs[0,0] + lhs[1,1]*rhs[0,1] + lhs[2,1]*rhs[0,2] + lhs[3,1]*rhs[0,3];
218     Result[1,1]:=lhs[0,1]*rhs[1,0] + lhs[1,1]*rhs[1,1] + lhs[2,1]*rhs[1,2] + lhs[3,1]*rhs[1,3];
219     Result[1,2]:=lhs[0,1]*rhs[2,0] + lhs[1,1]*rhs[2,1] + lhs[2,1]*rhs[2,2] + lhs[3,1]*rhs[2,3];
220     Result[1,3]:=lhs[0,1]*rhs[3,0] + lhs[1,1]*rhs[3,1] + lhs[2,1]*rhs[3,2] + lhs[3,1]*rhs[3,3];
221 
222     Result[2,0]:=lhs[0,2]*rhs[0,0] + lhs[1,2]*rhs[0,1] + lhs[2,2]*rhs[0,2] + lhs[3,2]*rhs[0,3];
223     Result[2,1]:=lhs[0,2]*rhs[1,0] + lhs[1,2]*rhs[1,1] + lhs[2,2]*rhs[1,2] + lhs[3,2]*rhs[1,3];
224     Result[2,2]:=lhs[0,2]*rhs[2,0] + lhs[1,2]*rhs[2,1] + lhs[2,2]*rhs[2,2] + lhs[3,2]*rhs[2,3];
225     Result[2,3]:=lhs[0,2]*rhs[3,0] + lhs[1,2]*rhs[3,1] + lhs[2,2]*rhs[3,2] + lhs[3,2]*rhs[3,3];
226 
227     Result[3,0]:=lhs[0,3]*rhs[0,0] + lhs[1,3]*rhs[0,1] + lhs[2,3]*rhs[0,2] + lhs[3,3]*rhs[0,3];
228     Result[3,1]:=lhs[0,3]*rhs[1,0] + lhs[1,3]*rhs[1,1] + lhs[2,3]*rhs[1,2] + lhs[3,3]*rhs[1,3];
229     Result[3,2]:=lhs[0,3]*rhs[2,0] + lhs[1,3]*rhs[2,1] + lhs[2,3]*rhs[2,2] + lhs[3,3]*rhs[2,3];
230     Result[3,3]:=lhs[0,3]*rhs[3,0] + lhs[1,3]*rhs[3,1] + lhs[2,3]*rhs[3,2] + lhs[3,3]*rhs[3,3];
231 }
232 
233     glPushMatrix;
234     glLoadMatrixf(@lhs[0, 0]);
235     glMultMatrixf(@rhs[0, 0]);
236     glGetFloatv(GL_MODELVIEW_MATRIX, @test[0, 0]);
237     glPopMatrix;
238 
239     error:=false;
240     for i:=0 to 3 do
241       for j:=0 to 3 do
242         if Abs(test[i, j] - Result[i, j]) > 0.000001 then
243           error:=true;
244 
245     {$IFNDEF PAS2C}
246     if error then
247     begin
248         writeln('shall:');
249         for i:=0 to 3 do
250         begin
251           for j:=0 to 3 do
252             write(test[i, j]);
253           writeln;
254         end;
255 
256         writeln('is:');
257         for i:=0 to 3 do
258         begin
259           for j:=0 to 3 do
260             write(Result[i, j]);
261           writeln;
262         end;
263         checkFails(false, 'Error in matrix multiplication?!', true);
264     end;
265     {$ENDIF}
266 
267 end;
268 
269 
270 end.
271