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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, 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 const

    48     MATRIX_STACK_SIZE = 10;

    49 

    50 type

    51     TMatrixStack = record

    52         top:Integer;

    53         stack: array[0..9] of TMatrix4x4f;

    54         end;

    55 var

    56     MatrixStacks : array[0..1] of TMatrixStack;

    57     CurMatrix: integer;

    58 

    59 procedure MatrixLoadIdentity(out Result: TMatrix4x4f);

    60 begin

    61     Result[0,0]:= 1.0; Result[1,0]:=0.0; Result[2,0]:=0.0; Result[3,0]:=0.0;

    62     Result[0,1]:= 0.0; Result[1,1]:=1.0; Result[2,1]:=0.0; Result[3,1]:=0.0;

    63     Result[0,2]:= 0.0; Result[1,2]:=0.0; Result[2,2]:=1.0; Result[3,2]:=0.0;

    64     Result[0,3]:= 0.0; Result[1,3]:=0.0; Result[2,3]:=0.0; Result[3,3]:=1.0;

    65 end;

    66 

    67 procedure hglMatrixMode(t: Integer);

    68 begin

    69     CurMatrix := t;

    70 end;

    71 

    72 procedure hglLoadIdentity();

    73 begin

    74     MatrixLoadIdentity(MatrixStacks[CurMatrix].stack[MatrixStacks[CurMatrix].top]);

    75 end;

    76 

    77 procedure hglScalef(x: GLfloat; y: GLfloat; z: GLfloat);

    78 var

    79     m:TMatrix4x4f;

    80     t:TMatrix4x4f;

    81 begin

    82     m[0,0]:=x;m[1,0]:=0;m[2,0]:=0;m[3,0]:=0;

    83     m[0,1]:=0;m[1,1]:=y;m[2,1]:=0;m[3,1]:=0;

    84     m[0,2]:=0;m[1,2]:=0;m[2,2]:=z;m[3,2]:=0;

    85     m[0,3]:=0;m[1,3]:=0;m[2,3]:=0;m[3,3]:=1;

    86 

    87     MatrixMultiply(t, MatrixStacks[CurMatrix].stack[MatrixStacks[CurMatrix].top], m);

    88     MatrixStacks[CurMatrix].stack[MatrixStacks[CurMatrix].top] := t;

    89 end;

    90 

    91 procedure hglTranslatef(x: GLfloat; y: GLfloat; z: GLfloat);

    92 var

    93     m:TMatrix4x4f;

    94     t:TMatrix4x4f;

    95 begin

    96     m[0,0]:=1;m[1,0]:=0;m[2,0]:=0;m[3,0]:=x;

    97     m[0,1]:=0;m[1,1]:=1;m[2,1]:=0;m[3,1]:=y;

    98     m[0,2]:=0;m[1,2]:=0;m[2,2]:=1;m[3,2]:=z;

    99     m[0,3]:=0;m[1,3]:=0;m[2,3]:=0;m[3,3]:=1;

   100 

   101     MatrixMultiply(t, MatrixStacks[CurMatrix].stack[MatrixStacks[CurMatrix].top], m);

   102     MatrixStacks[CurMatrix].stack[MatrixStacks[CurMatrix].top] := t;

   103 end;

   104 

   105 procedure hglRotatef(a:GLfloat; x:GLfloat; y:GLfloat; z:GLfloat);

   106 var

   107     m:TMatrix4x4f;

   108     t:TMatrix4x4f;

   109     c:GLfloat;

   110     s:GLfloat;

   111     xn, yn, zn:GLfloat;

   112     l:GLfloat;

   113 begin

   114     a:=a * 3.14159265368 / 180;

   115     c:=cos(a);

   116     s:=sin(a);

   117 

   118     l := 1.0 / sqrt(x * x + y * y + z * z);

   119     xn := x * l;

   120     yn := y * l;

   121     zn := z * l;

   122 

   123     m[0,0]:=c + xn * xn * (1 - c);

   124     m[1,0]:=xn * yn * (1 - c) - zn * s;

   125     m[2,0]:=xn * zn * (1 - c) + yn * s;

   126     m[3,0]:=0;

   127 

   128 

   129     m[0,1]:=yn * xn * (1 - c) + zn * s;

   130     m[1,1]:=c + yn * yn * (1 - c);

   131     m[2,1]:=yn * zn * (1 - c) - xn * s;

   132     m[3,1]:=0;

   133 

   134     m[0,2]:=zn * xn * (1 - c) - yn * s;

   135     m[1,2]:=zn * yn * (1 - c) + xn * s;

   136     m[2,2]:=c + zn * zn * (1 - c);

   137     m[3,2]:=0;

   138 

   139     m[0,3]:=0;m[1,3]:=0;m[2,3]:=0;m[3,3]:=1;

   140 

   141     MatrixMultiply(t, MatrixStacks[CurMatrix].stack[MatrixStacks[CurMatrix].top], m);

   142     MatrixStacks[CurMatrix].stack[MatrixStacks[CurMatrix].top] := t;

   143 end;

   144 

   145 procedure hglMVP(var res: TMatrix4x4f);

   146 begin

   147     MatrixMultiply(res,

   148                    MatrixStacks[MATRIX_PROJECTION].stack[MatrixStacks[MATRIX_PROJECTION].top],

   149                    MatrixStacks[MATRIX_MODELVIEW].stack[MatrixStacks[MATRIX_MODELVIEW].top]);

   150 end;

   151 

   152 procedure hglPushMatrix();

   153 var

   154     t: Integer;

   155 begin

   156     t := MatrixStacks[CurMatrix].top;

   157     MatrixStacks[CurMatrix].stack[t + 1] := MatrixStacks[CurMatrix].stack[t];

   158     inc(t);

   159     MatrixStacks[CurMatrix].top := t;

   160 end;

   161 

   162 procedure hglPopMatrix();

   163 var

   164     t: Integer;

   165 begin

   166     t := MatrixStacks[CurMatrix].top;

   167     dec(t);

   168     MatrixStacks[CurMatrix].top := t;

   169 end;

   170 

   171 procedure initModule();

   172 begin

   173     MatrixStacks[MATRIX_MODELVIEW].top := 0;

   174     MatrixStacks[MATRIX_Projection].top := 0;

   175     MatrixLoadIdentity(MatrixStacks[MATRIX_MODELVIEW].stack[0]);

   176     MatrixLoadIdentity(MatrixStacks[MATRIX_PROJECTION].stack[0]);

   177 end;

   178 

   179 procedure freeModule();

   180 begin

   181 end;

   182 

   183 procedure MatrixMultiply(out Result: TMatrix4x4f; const lhs, rhs: TMatrix4x4f);

   184 var

   185     test: TMatrix4x4f;

   186     i, j: Integer;

   187     error: boolean;

   188 begin

   189     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];

   190     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];

   191     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];

   192     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];

   193 

   194     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];

   195     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];

   196     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];

   197     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];

   198 

   199     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];

   200     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];

   201     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];

   202     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];

   203 

   204     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];

   205     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];

   206     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];

   207     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];

   208 

   209 {

   210     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];

   211     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];

   212     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];

   213     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];

   214 

   215     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];

   216     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];

   217     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];

   218     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];

   219 

   220     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];

   221     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];

   222     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];

   223     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];

   224 

   225     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];

   226     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];

   227     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];

   228     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];

   229 }

   230 

   231     {$IFNDEF PAS2C}

   232     glPushMatrix;

   233     glLoadMatrixf(@lhs[0, 0]);

   234     glMultMatrixf(@rhs[0, 0]);

   235     glGetFloatv(GL_MODELVIEW_MATRIX, @test[0, 0]);

   236     glPopMatrix;

   237 

   238     error:=false;

   239     for i:=0 to 3 do

   240       for j:=0 to 3 do

   241         if Abs(test[i, j] - Result[i, j]) > 0.000001 then

   242           error:=true;

   243 

   244     if error then

   245     begin

   246         writeln('shall:');

   247         for i:=0 to 3 do

   248         begin

   249           for j:=0 to 3 do

   250             write(test[i, j]);

   251           writeln;

   252         end;

   253 

   254         writeln('is:');

   255         for i:=0 to 3 do

   256         begin

   257           for j:=0 to 3 do

   258             write(Result[i, j]);

   259           writeln;

   260         end;

   261         halt(0);

   262     end;

   263     {$ENDIF}

   264 

   265 end;

   266 

   267 

   268 end.