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