SRL Archive - Other Scripts

This is Entirely written by Pplsuqbawlz i just found it very intersting so check it out.

{.Script Info:
# ScriptName  = cube
# Author      = pplsuqbawlz
# Description = 3d-spinning cube and/or 3d-engine in scar.
# Version     = 1.0
# Date        = 4/17/06
# Comments    = Fun to play with.
/Script Info}
program cube;
const
  // CONFIG
  size = 128;
  rate = 2;
  foreColor = 0;
  backColor = 14933725;
  degree = 90;

  //RECCOMENDED THAT YOU DO NOT EDIT BELOW
  width = 3*size+14;
  height = 3*size + 14;
  pi = 3.14159265;
  diameter = size * 2 + 1;
  halfsize = size / 2;
  diahalf = diameter + halfsize;
  circumfrence = (diameter * pi);
  increment = degree / circumfrence;

  frames = (degree / (increment * rate));

var
  coordX, coordY: Array[1..4] of Integer;
  fullrender, framesize, count: Integer;
  mainCanvas: TCanvas;
  i: Extended;


function draw:Integer;
var canvas : TCanvas;
  idx, adj, img: integer;
begin
    img := BitmapFromString(diameter,diameter,'');
    canvas := getBitmapCanvas(img);
    canvas.Brush.Style:= bsSolid;
    canvas.Brush.Color:= backColor;
    canvas.Pen.Color := backColor;
    canvas.Rectangle(0, 0, diameter, diameter);
    canvas.Pen.Style := psSolid;
    canvas.Pen.Color := foreColor;

    for idx := 1 to 4 do
    begin
      adj := (idx mod 4) + 1;
      canvas.moveTo(coordX[idx], coordY[idx]);        // VERT
      canvas.lineTo(coordX[idx], coordY[idx] + size); // VERT
      canvas.moveTo(coordX[idx], coordY[idx]); // TOP
      canvas.lineTo(coordX[adj], coordY[adj]); // TOP
      canvas.moveTo(coordX[idx], coordY[idx] + size); // BOTTOM
      canvas.lineTo(coordX[adj], coordY[adj] + size); // BOTTOM
    end;

    result:=img;
end;

procedure render;
var idx,deg,x,y: Integer;
    theta: Extended;
begin
 if(i < 360)then
 begin
   i := i + (increment * rate);
   for idx := 1 to 4 do
   begin
     deg := (round(i + (idx * 90)) mod 360);
     theta := ((deg * pi) / 180);
     x := round(Cos( theta ) * size) + size;
     y := round((Sin( theta ) * size) / 2) + halfsize;
     coordX[idx] := x;
     coordY[idx] := y;
   end;
 end else i:= 0;
end;

procedure debug;
var dbg : TCanvas;
begin
  DisplayDebugImgWindow(width, height);
  dbg := GetDebugCanvas;
  dbg.Brush.Style:= bsSolid;
  dbg.Brush.Color:= 8421504;
  dbg.Rectangle(-1, -1, width+1, height+1);
  dbg.Brush.Color:= backColor;
  dbg.Pen.Color := 0;
  dbg.Rectangle(5, 5, width-5, height-5);
  dbg.Pen.Color:= 16777215;
  dbg.Rectangle(6, 6, width-6, height-6);
end;


begin

framesize:= round(frames)*diameter;
fullrender := BitmapFromString(framesize,diameter,'');
mainCanvas := getBitmapCanvas(fullrender);
count:=0;
debug;
repeat
  render;
  CopyCanvas(GetBitmapCanvas(draw), mainCanvas, 0, 0, diameter, diameter, (count*diameter), 0, ((count+1)*diameter), diameter);
  count:=count+1;
until(i > degree);

count:= 0;
i:= 0;
repeat
  i:= i + (increment * rate);
  if(i > degree) then i:= i - degree;
  count := round(i/increment) mod round(frames);
  CopyCanvas(mainCanvas, GetDebugCanvas, (count*diameter), 0, ((count+1)*diameter), diameter, 7 + halfsize, 7+halfsize,diahalf+7,diameter+7+halfsize);
  wait(0);
until(false)
end.

WHOA!
Thats frigen schweed!
Nice find

He's the only person who had done this ever ;)

rofl i remember this thing so funny

Wah, I don't understand any of the code.

That's awsome ;D

# Date = 4/17/06

is Pplsuqbawlz still active in the Scar Community? If so, bring him over :)

He is but barely :( Im sure we can get mopar to do it…

ppl is a mod(or admin?) at mopar's forums. Although half the time he just brags of his knowledge but never demonstrates it anymore.

Hah, this is why I love blitz3d.
I could do all that in
cube=CreateCube
ScaleEntity,cube,5,5,5
PositionEntity,cube,0,0,0

edit* Oh crap, this is an old post. I didn't notice, sorry :D

yah. its ok, its too 1337 to be old :o i was looking at it the other day. its awesome. :)

I didn't see this before. :eek: Like wow… :eek:

pplsuqbawlz say's it takes to long to register so he can't be bothered to do it :)

does he really need to be polled? just tell him to email user and pass and let him in.. thats what i would do. oh well… this is amazing.

hrmmm… I like it. :)
Very good math practice.
Inspired me. I think I'll make a similar script as well. Perhaps a sphere :)

Not bad…

{

Cruel is a glutton :(
please don't make fun of him...
Thanks Josh for sphere/math help0rz!

WASD - to rotate
QE - to zoom
Arrows - to move

}

program Sphererific;
type
  T3Dpoint = record
    x,y,z: extended;
  end;
  T3Dline = record
    p1,p2: T3Dpoint;
  end;
const
  count = 3; //Number of spheres
  rotspeed = 4; //Speed of rotation/movement
  width = 600;
  height = 600;
  foreColor = clBlack;
  backColor = clLime;
var
  lines: array of T3Dline;
  mv,mh,i,bmp,ss1,ss2,ss3,posx,posy: integer;
  h,v,cosh,sinh,cosv,sinv,sz: extended;
  c:T3Dpoint;
  dbg,render:TCanvas;
 
procedure ValChg(var ss:Integer; min,max:Integer; inc:Boolean);
begin
  if inc then if ss<(max-rotspeed) then ss:=ss+rotspeed else ss:=min+(max-ss);
  if not inc then if ss>(min+rotspeed) then ss:=ss-rotspeed else ss:=max-(ss-min);
end;
   
function SpaceToX(x,y,z: extended): integer;
begin
  result:=mh+round((x*cosh+z*sinh)*sz);
end;

function SpaceToY(x,y,z: extended): integer;
begin
  result:=mv+round(sz*(y*cosv+(-x*sinh+z*cosh)*sinv));
end;

procedure Addline(ln1:T3Dline);
begin
  SetArrayLength(lines,GetArrayLength(lines)+1);
  lines[GetArrayLength(lines)-1]:=ln1;
end;

procedure AddSphere(r:extended; c:T3Dpoint);
var
  ln1:T3Dline;
  x,y:integer;
  lat,long,cr:extended;
begin
     for y:=-3 to 3 do begin
          lat:=y*pi/6;
          ln1.p1.y:=r*sin(lat)+c.y;
          ln1.p2.y:=ln1.p1.y;
          for x:=0 to 12 do begin
               long:=x*pi/6;
               cr:=r*cos(lat);
               ln1.p1:=ln1.p2;
               ln1.p2.x:=cr*cos(long)+c.x;
               ln1.p2.z:=cr*sin(long)+c.z;
               if x<>0 then Addline(ln1);
          end;
     end;
     for x:=0 to 12 do begin
          long:=x*pi/6;
          for y:=-3 to 3 do begin
               lat:=y*pi/6;
               ln1.p1:=ln1.p2;
               cr:=r*cos(lat);
               ln1.p2.x:=cr*cos(long)+c.x;
               ln1.p2.z:=cr*sin(long)+c.z;
               ln1.p2.y:=r*sin(lat)+c.y;
               if y<>-3 then Addline(ln1);
          end;
     end;
end;

begin
  bmp:= BitmapFromString(width,height,#0);
  render:= GetBitmapCanvas(bmp);
  DisplayDebugImgWindow(width,height);
  dbg:=GetDebugCanvas;
  render.Brush.Color:= backColor;
  render.Pen.Color := backColor;
  render.Pen.Color := foreColor;
  sz:=30; posx:=-50; posy:=50;
  ss1:=60; ss2:=140; ss3:=20;
  for i:= 1 to count do begin
    c.x:=random(100); c.y:=random(100); c.z:=random(100);
    AddSphere(random(25)+25,c);
  end;
  repeat
     if IsKeyDown('w') then ValChg(ss2,0,360,false);
     if IsKeyDown('a') then ValChg(ss1,0,360,false);
     if IsKeyDown('s') then ValChg(ss2,0,360,true);
     if IsKeyDown('d') then ValChg(ss1,0,360,true);
     if IsKeyDown('q') then ValChg(ss3,0,360,true);
     if IsKeyDown('e') then ValChg(ss3,0,360,false);
     if IsArrowDown(0) then ValChg(posy,-600,600,false);
     if IsArrowDown(1) then ValChg(posx,-600,600,true);
     if IsArrowDown(2) then ValChg(posy,-600,600,true);
     if IsArrowDown(3) then ValChg(posx,-600,600,false);
     mv:=(height shr 1)+posy;
     mh:=(width shr 1)+posx;
     h:=ss1*pi/180; v:=ss2*pi/180; sz:=ss3/20;
     cosh:=cos(h); sinh:=sin(h); cosv:=cos(v); sinv:=sin(v);
     sleep(10);
     render.Rectangle(0,0,width,height);
     for i:= GetArrayLength(lines)-1 downto 0 do begin
          render.moveto(SpaceToX(lines[i].p1.x,lines[i].p1.y,lines[i].p1.z),SpaceToY(lines[i].p1.x,lines[i].p1.y,lines[i].p1.z));
          render.lineto(SpaceToX(lines[i].p2.x,lines[i].p2.y,lines[i].p2.z),SpaceToY(lines[i].p2.x,lines[i].p2.y,lines[i].p2.z));
     end;
     CopyCanvas(render,dbg,0,0,width,height,0,0,width,height);
  until false;
end.

Should make a basic game with 3D drawings… even though this is pointless running it through SCAR… rofl. :rolleyes:

That's great cruel :D