DP Tool Club 31/CDASC_31_1996_juillet_aout.iso/vrac/3dstars0.zip/3DSTARS.PAS

Pascal/Delphi Source File | 1994-10-30 | 6KB | 228 lines

Program PanzerBatallion_294;

 { Real-3D starfield. Code by Alan F.                                94-10-30

              This is just a cute little starfield routine
              in Turbo Pascal. I am not into coding PC-software
              and this is my first demo-ish routine for PC. Nothing
              special indeed. Well, I consider PC-assembler being
              far less efficient than the MC680x0 assembler so this
              code features only a few assembler subroutines.

              Excuse the lack of real comments in the code.

   Contact at Vodka BBS - [phone], 14.4kbps, 24h/day.

   You will need to adjust the number of them stars shown to fit your
   system capatibilities.

   Note: If you have a math coprocessor, compile this using math-co option!

 }

uses crt;

const d:integer=300;                            {Distance from Screen}
      stno:integer=100;                         {Number of stars to plot}
      offscreen:integer=0;
      my:integer=220;                           {The positin of the 'camera'}

var x,y,z,sx,sy,xa,ya,za:integer;               {Just a bunch of variabels}
    xb,yb,zb,xab,yab,zab:byte;
    sr1,sr2,sr3,cr1,cr2,cr3:longint;
    fact:real;
    xr,yr,zr,add:integer;
    star:array[0..999,0..2] of integer;         {... and some arrays}
    color:array[0..999,0..1] of byte;
    adds:array[0..999,0..1] of integer;
    trig:array[0..720,0..1] of integer;

procedure setcolors;                {Initialize gray-scales}
     var  colreg:byte;
     BEGIN
     for colreg:=0 to 255 do begin

      asm
      mov    dx,3c8h
      mov   al,colreg
      out   dx,al
      inc   dx
      mov   al,colreg
      out   dx,al
      mov   al,colreg
      out   dx,al
      mov   al,colreg
      out   dx,al
      end;
    end;
    END;

procedure setmode(mode:byte);            {Shift VGA-modes}
     begin
     asm
       xor ah, ah
       mov al, mode
       int 10h
     end;
 end;

procedure synchronise;                   {Synchronize Vertical-Blank}
       begin
       asm
        mov     dx,3dah
       @preVRT:
        in      al,dx
        test    al,8
        jnz     @preVRT
       @postVRT:
        in      al,dx
        test    al,8
        jz      @postVRT
       end;
end;

procedure trigonometrics;            {Precalculate SIN/COS}
    var i:integer;
    BEGIN
    for i:=0 to 720 do begin
       trig[i,0]:=round(sin(i/720*(pi*2))*1024);
       trig[i,1]:=round(cos(i/720*(pi*2))*1024);
    end;
    END;

procedure rotate;                 {Rotate the view of the camera to the
                   current values}
      BEGIN
           sr1:=trig[xr,0];   {Uses precalculated SIN/COS thus avoiding}
           cr1:=trig[xr,1];   {slow floating-point variables}
           sr2:=trig[yr,0];
           cr2:=trig[yr,1];
           sr3:=trig[zr,0];
           cr3:=trig[zr,1];
      END;

procedure plotstars(numb,f1 : integer);         {Plot them stars}
 var      i:integer;
      colr:byte;
 begin
   for i:=0 to numb do begin
   add:=adds[i,f1];
   colr:=color[i,f1];
   asm
     cmp add, 0                           {0 marks an off-screen star}
     je  @noplot                          {If not visible, do nothing}
     mov ax, 0A000h                       {Screenbase -> AX}
     mov si, add                          {Screen position -> SI}
     mov es, ax                           {AX -> ES}
     mov al, colr                         {Get color}
     mov es:[si],al                       {Plot the colored star}
   @noplot:
     end;
   end;
 end;

procedure erasestars(numb,field:integer); {Erase stars, (almost) the same as
                       the procedure above}
 var      i:integer;
 begin
   for i:=0 to numb do begin
   add:=adds[i,field];
   asm
     cmp add, 0
     je  @noerase
     mov ax, 0A000h
     mov si, add
     mov es, ax
     mov byte ptr es:[si],0                {Remove the star from screen}
   @noerase:
     end;
     end;
 end;

Procedure calculate(numb,field:integer);   {Calculate 3D stars}
      var i:integer;
      BEGIN
           for i:=0 to numb do begin
           xa:=(cr1*star[i,0]-sr1*star[i,1]) div 1024;
           ya:=(sr1*star[i,0]+cr1*star[i,1]) div 1024;
           za:=(cr2*star[i,2]-sr2*xa) div 1024;

           x:=(cr2*xa+sr2*star[i,2]) div 1024;
           y:=(cr3*ya-sr3*za) div 1024;
           z:=(sr3*ya+cr3*za) div 1024;

           color[i,field]:=255-(y+200) div 7;  {Calculate the shade of
                            the current star}

           inc (y, my);                 {Reposition camera's position}

           if y<>0 then            {Make sure no division-by-zero occurs}
           fact:=d/y
           else
           fact:=0;                      {The star is too close anyway}
           sx:=round(160+fact*x);        {Finally, convert to 2D}
           sy:=round(100+fact*z);

           if (sx>0) and (sx<320) and (sy>0) and (sy<200) then
          adds[i,field]:=sx+sy*320     {Calculate star's offset}
           else
          adds[i,field]:=offscreen
           end;
      END;

procedure changeview;            {Change the ange of the camera}

    begin
      xr:=xr+2;
      yr:=yr+1;
      yr:=yr+2;

      if xr>719 then
         xr:=xr-(720*(xr div 720));
      if yr>719 then
         yr:=yr-(720*(yr div 720));
      if zr>719 then
         zr:=zr-(720*(zr div 720));
    end;

procedure slump(numb:integer);     {Randomize the positions. (No kidding!?)}
      var i:integer;
      BEGIN
           randomize;
           for i:=0 to numb do begin
           star[i,0]:=random(200)-100;
           star[i,1]:=random(200)-100;
           star[i,2]:=random(200)-100;
           end;
      END;

BEGIN                                   {Ahh, yeah, the loop itself...}

     trigonometrics;
     slump(stno);

     setmode($13);
     rotate;
     calculate(stno,1);

     setcolors;

     repeat
       rotate;
       changeview;
       calculate(stno,0);
       synchronise;
       erasestars(stno,1);
       plotstars(stno,0);

       rotate;
       changeview;
       calculate(stno,1);
       synchronise;
       erasestars(stno,0);
       plotstars(stno,1);

     until keypressed;
     setmode($3);
END.