SCAR Code:
type T3DPoint = record
x, y, z : Extended;
Color : Integer;
end;
T3DPointArray = array of T3DPoint;
T3DPointObject = record
Name : String;
T3DPoints : T3DPointArray;
MidPoint : T3DPoint;
xRot, yRot, zRot : Integer;
Size : Integer;
end;
T3DPointObjectArray = array of T3DPointObject;
TView = record
x, y, z : Extended;
xRot, yRot, zRot : Integer;
end;
TGame = record
View : TView;
Objects : T3DPointObjectArray;
Image : Integer;
Width, Height : Integer;
end;
var
Game : TGame;
Increase : Integer;
const
QUALITY = 2;
SPEED = 100;
function IntTo3DPoint(x, y, z : Extended): T3DPoint;
begin
Result.x := x;
Result.y := y;
Result.z := z;
end;
function Distance3D(P1, P2 : T3DPoint): Integer;
begin
Result:= Floor(Sqrt((P1.X-P2.X) * (P1.X - P2.X) + (P1.Y - P2.Y) * (P1.Y - P2.Y) + (P1.Z - P2.Z) * (P1.Z - P2.Z)));
end;
function GetAngle(X, Y, X2, Y2 : Extended): Extended;
begin
Result := (ArcTan2(Round(Y2-Y), Round(X2-X)) * (180/Pi)) + 90;
while Result < 0.0 do
Result := Result + 360.0;
end;
function RotateP(X, Y, X2, Y2: Extended; Angle : Integer): TPoint;
var
Dist : Integer;
Ang : Extended;
begin
Dist := Distance(Round(X), Round(Y), Round(X2), Round(Y2));
Ang := GetAngle(X2, Y2, X, Y) + Angle;
Result.X := Round(Sin(Ang * Pi / 180) * Dist + X2);
Result.Y := Round(Cos(Ang * Pi / 180) * -Dist + Y2);
end;
procedure Rotate3DPoint(var V : T3DPoint; Mid : T3DPoint; xRot, yRot, zRot : Integer);
var
P : TPoint;
begin
if xRot = 0 then
if yRot = 0 then
if zRot = 0 then
Exit;
P := RotateP(V.Y, V.Z, Mid.y, Mid.z, xRot);
V.Y := P.x;
V.Z := P.y;
P := RotateP(V.X, V.Z, Mid.x, Mid.z, yRot);
V.X := P.x;
V.Z := P.y;
P := RotateP(V.X, V.Y, Mid.x, Mid.y, zRot);
V.X := P.x;
V.Y := P.y;
end;
function Turn3DPointToPoint(V : T3DPoint; View : TView): TPoint;
var
cx, cy, cz : Extended;
begin
if V.Z - View.Z < 1 then
Result := Point(-999, -999)
else
try
Result := Point(Round(Round(Game.Width/2) - (V.X - View.X) * Game.Width / (V.Z - View.Z)), Round(Round(Game.Height/2) - (V.Y - View.Y) * Game.Height / (V.Z - View.Z)));
except
Result := Point(-999, -999);
end;
end;
procedure Render3DPoint(V : T3DPoint; View : TView; var Target : Integer; S : Integer);
var
P : TPoint;
W, H : Integer;
begin
GetBitmapSize(Target, W, H);
P := Turn3DPointToPoint(V, View);
if (P.X > (-1+S)) and (P.Y > (-1+S)) then
if (P.X < W-1-S) and (P.Y < H-1-S) then
RectangleBitmap(Target, IntToBox(P.X-S, P.Y-S, P.X+S, P.Y+S), V.Color);
end;
procedure Render3DPointObject(var Obj : T3DPointObject; View : TView; var Target : Integer);
var
I, H, t : Integer;
begin
WriteLn('Rendering object [' + Obj.Name + '] started (' + IntToStr(High(Obj.T3DPoints)) + 'p)');
t := GetSystemTime;
H := High(Obj.T3DPoints);
Render3DPoint(Obj.MidPoint, View, Target, 1);
if (Obj.xRot <> 0) or (Obj.yRot <> 0) or (Obj.ZRot <> 0) then
begin
for I := 0 to H do
begin
Rotate3DPoint(Obj.T3DPoints[I], Obj.MidPoint, Obj.xRot, Obj.yRot, Obj.zRot);
Render3DPoint(Obj.T3DPoints[I], View, Target, Obj.Size);
end;
Obj.xRot := 0;
Obj.yRot := 0;
Obj.zRot := 0;
end else
for I := 0 to H do
Render3DPoint(Obj.T3DPoints[I], View, Target, Obj.Size);
WriteLn('Rendering object [' + Obj.Name + '] complete (' + IntToStr(Round(GetSystemTime-t)) + 'ms)');
end;
procedure RunGame; // This is also EXPERIMENTAL
var
sArr : array of Word;
I, H : Integer;
begin
sArr := [VK_W, VK_A, VK_S, VK_D, VK_E, VK_Q,
VK_Z, VK_X,
VK_R, VK_T, VK_Y];
Increase := SPEED;
while True do
begin
FreeBitmap(Game.Image);
Game.Image := CreateBitmap(Game.Width, Game.Height);
H := High(Game.Objects);
for I := 0 to H do
Render3DPointObject(Game.Objects[I], Game.View, Game.Image);
DrawBitmapDebugImg(Game.Image);
for I := High(sArr) downto 0 do
begin
IsKeyDown(sArr[I]); //Free the buffer
if IsKeyDown(sArr[I]) then
case I of
0: Game.View.Z := Game.View.Z + Increase;
1: Game.View.X := Game.View.X + Increase;
2: Game.View.Z := Game.View.Z - Increase;
3: Game.View.X := Game.View.X - Increase;
4: Game.View.Y := Game.View.Y + Increase;
5: Game.View.Y := Game.View.Y - Increase;
6: Increase := Increase + SPEED;
7: Increase := Increase - SPEED;
8: Game.Objects[0].xRot := Game.Objects[0].xRot + 15;
9: Game.Objects[0].yRot := Game.Objects[0].yRot + 15;
10: Game.Objects[0].zRot := Game.Objects[0].zRot + 15;
end;
end;
end;
end;
{EXPERIMENTAL} {EXPERIMENTAL} {EXPERIMENTAL} {EXPERIMENTAL} {EXPERIMENTAL} {EXPERIMENTAL} {EXPERIMENTAL}
function GetObject(Name : String; Path : String): T3DPointObject;
var
sArr, sArr2 : TStringArray;
S, wS : String;
I, H, P, wX, wY, wZ : Integer;
begin
WriteLn('Loading object [' + Name + ']');
I := OpenFile(Path, False);
ReadFileString(I, S, FileSize(I));
CloseFile(I);
WriteLn(' Gathering points');
wS := Between('(', ')', S);
Result.Name := Name;
Result.zRot := 180;
Result.Size := 1;
SetArrayLength(Result.T3DPoints, StrToInt(wS)+1);
P := Pos('[', S);
Delete(S, 1, P-1);
repeat
P := Pos(']', S);
if P = 0 then Break;
Delete(S, P, 1);
until False
sArr := Explode('[', S);
WriteLn(' Gathering points done' #13#10 ' Setting points');
H := High(sArr);
for I := 1 to H do
begin
wS := Between('*', '*', sArr[I]);
P := Pos('(', sArr[I]);
Delete(sArr[I], 1, P-1);
P := StrToInt(wS);
Delete(sArr[I], 1, 1);
Delete(sArr[I], Pos(')', sArr[I]), 1);
sArr2 := Explode(',', sArr[I]);
with Result.T3DPoints[P] do
begin
X := StrToInt(sArr2[0]);
Y := StrToInt(sArr2[1]);
Z := StrToInt(sArr2[2]);
Color := StrToInt(sArr2[3]);
end;
wX := wX + StrToInt(sArr2[0]);
wY := wY + StrToInt(sArr2[1]);
wZ := wZ + StrToInt(sArr2[2]);
end;
WriteLn(' Setting points done');
wX := Round(wX / (H-1));
wY := Round(wY / (H-1));
wZ := Round(wZ / (H-1));
with Result.MidPoint do
begin
X := wX;
Y := wY;
Z := wZ;
Color := 255;
end;
WriteLn('Loading object [' + Name + '] complete');
end;
procedure LoadObject(Name, Path : String; var The3DPointObjArray : T3DPointObjectArray);
begin
SetArrayLength(The3DPointObjArray, GetArrayLength(The3DPointObjArray)+1);
The3DPointObjArray[High(The3DPointObjArray)] := GetObject(Name, Path);
end;
procedure LoadTestObject(var The3DPointObjArray : T3DPointObjectArray);
begin
LoadObject('TestObject', AppPath + 'Unnamed.3DPObj', The3DPointObjArray);
end;
procedure LoadTestObjectFromBitmap(Name : String; var The3DPointObjArray : T3DPointObjectArray);
var
TextureMap, BumpMap, cL, cX, cY, TextureW, TextureH, t : Integer;
wX, wY, wZ : Extended;
begin
WriteLn('Loading object [' + Name + ']');
t := GetSystemTime;
TextureMap := LoadBitmap(AppPath + 'texture.bmp');
BumpMap := GreyScaleBitmap(TextureMap);
SaveBitmap(BumpMap, AppPath + 'bump.bmp');
GetBitmapSize(TextureMap, TextureW, TextureH);
Dec(TextureW);
Dec(TextureH);
SetArrayLength(The3DPointObjArray, 1);
SetArrayLength(The3DPointObjArray[0].T3DPoints, (TextureW*TextureW)+TextureH);
The3DPointObjArray[0].Name := Name;
The3DPointObjArray[0].xRot := 0;
The3DPointObjArray[0].yRot := 0;
The3DPointObjArray[0].zRot := 180;
The3DPointObjArray[0].Size := 4;
for cX := 0 to TextureW-1 do
begin
for cY := 0 to TextureH-1 do
begin
with The3DPointObjArray[0].T3DPoints[(cX*TextureW)+cY] do
begin
X := cX;
Y := cY;
Z := (FastGetPixel(BumpMap, cX, cY) / 255) / 1000;
Color := FastGetPixel(TextureMap, cX, cY);
end;
wX := wX + cX;
wY := wY + cY;
wZ := wZ + The3DPointObjArray[0].T3DPoints[(cX*TextureW)+cY].Z;
end;
end;
with The3DPointObjArray[0].MidPoint do
begin
X := wX / ((TextureW*TextureW)+TextureH);
Y := wY / ((TextureW*TextureW)+TextureH);
Z := wZ / ((TextureW*TextureW)+TextureH);
Color := 255;
end;
WriteLn('Loading object [' + Name + '] complete (' + IntToStr(Round(GetSystemTime-t)) + 'ms)');
FreeBitmap(TextureMap);
FreeBitmap(BumpMap);
end;
{EXPERIMENTAL} {EXPERIMENTAL} {EXPERIMENTAL} {EXPERIMENTAL} {EXPERIMENTAL} {EXPERIMENTAL} {EXPERIMENTAL}
begin
ClearDebug;
LoadTestObjectFromBitmap('TestObject', Game.Objects);
Game.Width := 800;
Game.Height := 600;
Game.View.x := Game.Objects[0].MidPoint.X;
Game.View.y := Game.Objects[0].MidPoint.Y;
Game.View.z := Game.Objects[0].MidPoint.Z-500;
Game.Image := CreateBitmap(Game.Width, Game.Height);
DisplayDebugImgWindow(Game.Width, Game.Height);
RunGame;
end.