SRL Archive - Other Scripts

This script is capable of rendering 17 points per ms. That's 17000 points every second, but please keep it below 3,400 points if you want to be able to get 30 fps.

There is still some problems which I know how to fix, but I'm lazy and abandoned this project long time ago.
The problems are distance check on every point in the object to see what points to be in front of others. As it is right now, it renders each point from index 0 to the highest index.
You can render more than 1 object, but the script doesn't know which object comes in front of you and what objects does not (meaning if you have a cat on the back side of a wall, it will probably paint the cat on the front side)

This is me rendering… well… me (I rotated the object so you can see the 3D effect):

Here you can clearly see that some points are in front of others (aka 3D):

HOW TO RENDER OBJECTS:
Save a bitmap in your Simba folder named "texture.bmp" and run the script. I would test with a 50x50 picture first.
You can render anything. Varying from cats to nude pictures of your neighbor.
NOTE: If you do large pictures (1000 x 1000 or more) and have a slow computer/low ram then be aware that Simba might crash!

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.

Save this in the same folder as Simba.exe to test:
Save is at "texture.bmp"

Upload a .bmp foar us? :3 whenever I try it doesn't work. :/

Math error at line 282

X := wX / ((TextureW*TextureW)+TextureH);  

It's working just fine for me.

You should learn about interpolation. ;)

same as Fremnet :(
this looked really cool too

~shut

Added a picture in the first post.. Idk what stopped you guys from finding a random picture like me and save is as a .bmp file though :P
The only reason why you should get a math error is if you did something wrong with the bitmap.

Wizzup: I don't even know what that is :) :p
E: Oh! Cool! Yeah, that would be good to have in this kind of scripts

Exception: Error while reading stream: Wrong image format at line 251

That's why. I get that when I try to just save that as a .bmp. I had to paste it into paint and change the file type (couldn't do it just setting the file type to all).

From: i luffs yeww
Exception: Error while reading stream: Wrong image format at line 251

That's why. I get that when I try to just save that as a .bmp. I had to paste it into paint and change the file type (couldn't do it just setting the file type to all).

Ugh.. Imageshack changed the filetype >_<

I get a math error on line 282

I have no idea why you guys get a math error there….. Only reason should be if you don't have a texture.bmp in your simba core folder

Loading object [TestObject]
Math error at line 282
The following bitmaps were not freed: [0, 1]

ditto

It's because people are saving the images wrong. I don't remember how I saved it but I know I got it to work with some hentai.

From: i luffs yeww
It's because people are saving the images wrong. I don't remember how I saved it but I know I got it to work with some hentai.

Loled.

I'm srs. So the problem is probably because you have to use hentai to make this work.

Google images works fine, just make sure safe search is off.