

program starfield;

uses crush13h,crt;

Const
        ZInc = 25;
        ZOfs = 256;
        ZScale = 256;

type star= record
                 x,y,z:real;
           end;

var stars: array [0..1000] of star;
    a:integer;
    c:char;
    ang:real;

type verts= record
                   x,y,z:real;
            end;
     ZZ= record
               z:real;
               n:integer;
         end;

Var     Vert : Array[0..32] Of verts;
        zbuffer: array[0..32] of ZZ;

        Vertn:word;
        c1:integer;
        r:integer;
        deg:integer;

        count,add:integer;
        pb:integer;
        blur1:integer;

procedure appeardot1(x,y:integer;where:word);
begin
     putpixel (x,y,1*round(256 div 12),where);
end;

procedure appeardot2(x,y:integer;where:word);
begin
     putpixel (x,y,2*round(256 div 12),where);
     putpixel (x-1,y,1*round(256 div 12),where);
     putpixel (x+1,y,1*round(256 div 12),where);
     putpixel (x,y+1,1*round(256 div 12),where);
     putpixel (x,y-1,1*round(256 div 12),where);
end;

procedure appeardot3(x,y:integer;where:word);
begin
     putpixel (x,y,3*round(256 div 12),where);
     putpixel (x-1,y,2*round(256 div 12),where);
     putpixel (x+1,y,2*round(256 div 12),where);
     putpixel (x,y+1,2*round(256 div 12),where);
     putpixel (x,y-1,2*round(256 div 12),where);
     putpixel (x-1,y+1,1*round(256 div 12),where);
     putpixel (x+1,y+1,1*round(256 div 12),where);
     putpixel (x+1,y-1,1*round(256 div 12),where);
     putpixel (x-1,y-1,1*round(256 div 12),where);
end;

procedure appeardot4(x,y:integer;where:word);
begin
     putpixel (x,y,4*round(256 div 12),where);
     putpixel (x-1,y,3*round(256 div 12),where);
     putpixel (x+1,y,3*round(256 div 12),where);
     putpixel (x,y+1,3*round(256 div 12),where);
     putpixel (x,y-1,3*round(256 div 12),where);
     putpixel (x-1,y+1,1*round(256 div 12),where);
     putpixel (x+1,y+1,1*round(256 div 12),where);
     putpixel (x-1,y-1,1*round(256 div 12),where);
     putpixel (x+1,y-1,1*round(256 div 12),where);
     putpixel (x-2,y,1*round(256 div 12),where);
     putpixel (x+2,y,1*round(256 div 12),where);
     putpixel (x,y+2,1*round(256 div 12),where);
     putpixel (x,y-2,1*round(256 div 12),where);
end;

procedure appeardot5(x,y:integer;where:word);
begin
     putpixel (x,y,5*round(256 div 12),where);
     putpixel (x-1,y,4*round(256 div 12),where);
     putpixel (x+1,y,4*round(256 div 12),where);
     putpixel (x,y+1,4*round(256 div 12),where);
     putpixel (x,y-1,4*round(256 div 12),where);
     putpixel (x-1,y+1,2*round(256 div 12),where);
     putpixel (x+1,y+1,2*round(256 div 12),where);
     putpixel (x+1,y-1,2*round(256 div 12),where);
     putpixel (x-1,y-1,2*round(256 div 12),where);
     putpixel (x-2,y,2*round(256 div 12),where);
     putpixel (x+2,y,2*round(256 div 12),where);
     putpixel (x,y+2,2*round(256 div 12),where);
     putpixel (x,y-2,2*round(256 div 12),where);
     putpixel (x-3,y,1*round(256 div 12),where);
     putpixel (x+3,y,1*round(256 div 12),where);
     putpixel (x,y+3,1*round(256 div 12),where);
     putpixel (x,y-3,1*round(256 div 12),where);
end;

procedure appeardot6(x,y:integer;where:word);
begin
     putpixel (x,y,6*round(256 div 12),where);
     putpixel (x-1,y,5*round(256 div 12),where);
     putpixel (x+1,y,5*round(256 div 12),where);
     putpixel (x,y+1,5*round(256 div 12),where);
     putpixel (x,y-1,5*round(256 div 12),where);
     putpixel (x-1,y+1,3*round(256 div 12),where);
     putpixel (x+1,y+1,3*round(256 div 12),where);
     putpixel (x+1,y-1,3*round(256 div 12),where);
     putpixel (x-1,y-1,3*round(256 div 12),where);
     putpixel (x-2,y,3*round(256 div 12),where);
     putpixel (x+2,y,3*round(256 div 12),where);
     putpixel (x,y+2,3*round(256 div 12),where);
     putpixel (x,y-2,3*round(256 div 12),where);
     putpixel (x-3,y,2*round(256 div 12),where);
     putpixel (x+3,y,2*round(256 div 12),where);
     putpixel (x,y+3,2*round(256 div 12),where);
     putpixel (x,y-3,2*round(256 div 12),where);
     putpixel (x-4,y,1*round(256 div 12),where);
     putpixel (x+4,y,1*round(256 div 12),where);
     putpixel (x,y+4,1*round(256 div 12),where);
     putpixel (x,y-4,1*round(256 div 12),where);
end;

procedure appeardot7(x,y:integer;where:word);
begin
     putpixel (x,y,10*round(256 div 12),where);
     putpixel (x-1,y,8*round(256 div 12),where);
     putpixel (x+1,y,8*round(256 div 12),where);
     putpixel (x,y+1,8*round(256 div 12),where);
     putpixel (x,y-1,8*round(256 div 12),where);
     putpixel (x-1,y+1,4*round(256 div 12),where);
     putpixel (x+1,y+1,4*round(256 div 12),where);
     putpixel (x+1,y-1,4*round(256 div 12),where);
     putpixel (x-1,y-1,4*round(256 div 12),where);
     putpixel (x-2,y,4*round(256 div 12),where);
     putpixel (x+2,y,4*round(256 div 12),where);
     putpixel (x,y+2,4*round(256 div 12),where);
     putpixel (x,y-2,4*round(256 div 12),where);
     putpixel (x-3,y,2*round(256 div 12),where);
     putpixel (x+3,y,2*round(256 div 12),where);
     putpixel (x,y+3,2*round(256 div 12),where);
     putpixel (x,y-3,2*round(256 div 12),where);
     putpixel (x-4,y,2*round(256 div 12),where);
     putpixel (x+4,y,2*round(256 div 12),where);
     putpixel (x,y+4,2*round(256 div 12),where);
     putpixel (x,y-4,2*round(256 div 12),where);
     putpixel (x-5,y,1*round(256 div 12),where);
     putpixel (x+5,y,1*round(256 div 12),where);
     putpixel (x,y+5,1*round(256 div 12),where);
     putpixel (x,y-5,1*round(256 div 12),where);
end;

procedure appeardot8(x,y:integer;where:word);
begin
     putpixel (x,y,12*round(256 div 12),where);
     putpixel (x-1,y,10*round(256 div 12),where);
     putpixel (x+1,y,10*round(256 div 12),where);
     putpixel (x,y+1,10*round(256 div 12),where);
     putpixel (x,y-1,10*round(256 div 12),where);
     putpixel (x-1,y+1,6*round(256 div 12),where);
     putpixel (x+1,y+1,6*round(256 div 12),where);
     putpixel (x+1,y-1,6*round(256 div 12),where);
     putpixel (x-1,y-1,6*round(256 div 12),where);
     putpixel (x-2,y,6*round(256 div 12),where);
     putpixel (x+2,y,6*round(256 div 12),where);
     putpixel (x,y+2,6*round(256 div 12),where);
     putpixel (x,y-2,6*round(256 div 12),where);
     putpixel (x-3,y,4*round(256 div 12),where);
     putpixel (x+3,y,4*round(256 div 12),where);
     putpixel (x,y+3,4*round(256 div 12),where);
     putpixel (x,y-3,4*round(256 div 12),where);
     putpixel (x-4,y,4*round(256 div 12),where);
     putpixel (x+4,y,4*round(256 div 12),where);
     putpixel (x,y+4,4*round(256 div 12),where);
     putpixel (x,y-4,4*round(256 div 12),where);
     putpixel (x-5,y,2*round(256 div 12),where);
     putpixel (x+5,y,2*round(256 div 12),where);
     putpixel (x,y+5,2*round(256 div 12),where);
     putpixel (x,y-5,2*round(256 div 12),where);
     putpixel (x-6,y,1*round(256 div 12),where);
     putpixel (x+6,y,1*round(256 div 12),where);
     putpixel (x,y+6,1*round(256 div 12),where);
     putpixel (x,y-6,1*round(256 div 12),where);
     putpixel (x-2,y+2,2*round(256 div 12),where);
     putpixel (x-2,y-2,2*round(256 div 12),where);
     putpixel (x+2,y+2,2*round(256 div 12),where);
     putpixel (x+2,y-2,2*round(256 div 12),where);
end;

procedure getzbuffer;
var z1,z2:real;
    n1,n2:integer;
    count69:integer;
begin
     for a:=0 to vertn do zbuffer[a].z:=vert[a].z;
     for a:=0 to vertn do zbuffer[a].n:=a;
     count69:=0;

     repeat
     for a:=0 to vertn-1 do
     begin
          if zbuffer[a].z>zbuffer[a+1].z then
             begin
                  z1:=zbuffer[a].z;
                  z2:=zbuffer[a+1].z;
                  n1:=zbuffer[a].n;
                  n2:=zbuffer[a+1].n;
                  zbuffer[a].z:=z2;
                  zbuffer[a+1].z:=z1;
                  zbuffer[a].n:=n2;
                  zbuffer[a+1].n:=n1;
             end;
     end;
     count69:=count69+1;
     until count69=33;
end;

procedure drawcube;
Var SX, SY, SX1, SY1, SX2, SY2, n : Word;
Begin
     n := vertn;
     Repeat


                         SX := Round((ZScale*vert[zbuffer[n].n].X)/(vert[zbuffer[n].n].Z-ZOfs));
                         SY := Round((ZScale*vert[zbuffer[n].n].Y)/(vert[zbuffer[n].n].Z-ZOfs));


                            if vert[zbuffer[n].n].z>-248 then appeardot3(160+SX, 100-SY, vp[2]);
                            if vert[zbuffer[n].n].z>-176 then appeardot5(160+SX, 100-SY, vp[2]);
                            if vert[zbuffer[n].n].z>-52 then  appeardot6(160+SX, 100-SY, vp[2]);
                            if vert[zbuffer[n].n].z>0 then    appeardot7(160+SX, 100-SY, vp[2]);
                            if vert[zbuffer[n].n].z>52 then   appeardot8(160+SX, 100-SY, vp[2]);
                            if vert[zbuffer[n].n].z>176 then  appeardot8(160+SX, 100-SY, vp[2]);
                            if vert[zbuffer[n].n].z>248 then  appeardot8(160+SX, 100-SY, vp[2]);





           n := n - 1;
     Until n = 0;
end;

procedure terminate;
begin
     closevirt;
     video_mode ( 03);
     writeln ('twinkle twinkle little star!');
     writeln ('take me to the nearest bar');
     writeln ('please don''t tell me it''s to far');
     writeln ('i''m to drunk to drive a car!');
     writeln;
     writeln ('        BYMKKO YRAMA');
     writeln ('        in, Bjoer/TPOLM');

     halt;
end;

Procedure Rotate(Var X, Y, ang : Real);
Var XX, YY : Real;
Begin
           XX := X*Cos(ang)+Y*Sin(ang);
      YY := Y*Cos(ang)-X*Sin(ang);
      X := XX;
      Y := YY;
End;

procedure movestars;
begin
     for a:=0 to 1000 do
     with stars[a] do
         begin
              x:=x+ (z / 256);
              if x>319 then x:=x-319;
              if x<0 then x:=x+319;
         end;
end;

procedure putstars(where:word);
begin
     for a:=0 to 1000 do
     with stars[a] do
         begin
              mem[where:round(x)+320*round(y)]:=round(z);
         end;
end;

procedure blur3 (where:word);
var b:word;
begin
     for b:=0 to 64000 do
         begin
              if mem[vp[2]:b]>4 then
              mem[vp[2]:b]:=mem[vp[2]:b]-5;
         end;
end;

procedure blur2 (where:word);
var b:word;
begin
     for b:=0 to 64000 do
         begin
              if mem[vp[2]:b]>9 then
              mem[vp[2]:b]:=mem[vp[2]:b]-10;
         end;
end;

procedure blur_1 (where:word);
var b:word;
begin
     for b:=0 to 64000 do
         begin
              if mem[vp[2]:b]>14 then
              mem[vp[2]:b]:=mem[vp[2]:b]-15;
         end;
end;

begin
     writeln ('b to activate blur, esc to exit');
     readkey;

     video_mode ( $13);
     initvirt;

     randomize;

     for a:=0 to 1000 do
     with stars[a] do
         begin
              x:=random(320);
              y:=random(200);
              z:=random(256);
         end;

     cls (0,vp[2]);
     cls (0,vp[1]);
     cls (0,vga);

     for a:=0 to 256 do
     begin
          setcolor (a,round(a div 4),round(a div 4),round(a div 4));
     end;

     c:=' ';

          With Vert[0] Do
           Begin
              X := -random(120);
              Y := random(120);
              Z := random(120);

           end;
      With Vert[1] Do
           begin
              X := -random(120);
              Y := random(120);
              Z := random(120);

           end;
      With Vert[2] Do
           begin
              X := random(120);
              Y := random(120);
              Z := random(120);

           end;
      With Vert[3] Do
           begin
              X := random(120);
              Y := random(120);
              Z := random(120);

           End;
      With Vert[4] Do
           Begin
              X := random(120);
              Y := random(120);
              Z := random(120);

           end;
      With Vert[5] Do
           Begin
              X := random(120);
              Y := -random(120);
              Z := random(120);

           end;

      With Vert[6] Do
           Begin
              X := random(120);
              Y := -random(120);
              Z := random(120);

           end;
      With Vert[7] Do
           Begin
              X := random(120);
              Y := -random(120);
              Z := random(120);

           end;
      With Vert[8] Do
           Begin
              X := -random(120);
              Y := -random(120);
              Z := random(120);

           end;
      With Vert[9] Do
           Begin
              X := -random(120);
              Y := -random(120);
              Z := random(120);

           end;
      With Vert[10] Do
           Begin
              X := -random(120);
              Y := -random(120);
              Z := random(120);

           end;
      With Vert[11] Do
           Begin
              X := -random(120);
              Y := random(120);
              Z := random(120);

           end;
      With Vert[12] Do
           Begin
              X := -random(120);
              Y := random(120);
              Z := -random(120);

           end;
      With Vert[13] Do
           Begin
              X := -random(120);
              Y := random(120);
              Z := -random(120);

           end;
      With Vert[14] Do
           Begin
              X := random(120);
              Y := random(120);
              Z := -random(120);

           end;
      With Vert[15] Do
           Begin
              X := random(120);
              Y := random(120);
              Z := -random(120);

           end;
      With Vert[16] Do
           Begin
              X := random(120);
              Y := random(120);
              Z := -random(120);

           end;
      With Vert[17] Do
           Begin
              X := random(120);
              Y := -random(120);
              Z := -random(120);

           end;
      With Vert[18] Do
           Begin
              X := random(120);
              Y := -random(120);
              Z := -random(120);

           end;
      With Vert[19] Do
           Begin
              X := random(120);
              Y := -random(120);
              Z := -random(120);

           end;
      With Vert[20] Do
           Begin
              X := -random(120);
              Y := -random(120);
              Z := -random(120);

           end;
      With Vert[21] Do
           Begin
              X := -random(120);
              Y := -random(120);
              Z := -random(120);

           end;
      With Vert[22] Do
           Begin
              X := -random(120);
              Y := -random(120);
              Z := -random(120);

           end;
      With Vert[23] Do
           Begin
              X := -random(120);
              Y := random(120);
              Z := -random(120);

           end;
      With Vert[24] Do
           Begin
              X := -random(120);
              Y := random(120);
              Z := -random(120);

           end;
      With Vert[25] Do
           Begin
              X := -random(120);
              Y := random(120);
              Z := random(120);

           end;
      With Vert[26] Do
           Begin
              X := -random(120);
              Y := -random(120);
              Z := random(120);

           end;
      With Vert[27] Do
           Begin
              X := -random(120);
              Y := -random(120);
              Z := -random(120);

           end;
      With Vert[28] Do
           Begin
              X := random(120);
              Y := random(120);
              Z := -random(120);

           end;
      With Vert[29] Do
           Begin
              X := random(120);
              Y := random(120);
              Z := random(120);

           end;
      With Vert[30] Do
           Begin
              X := random(120);
              Y := -random(120);
              Z := random(120);
           end;
      With Vert[31] Do
           Begin
              X := random(120);
              Y := -random(120);
              Z := -random(120);
           end;

     Vertn := 32;
     ang:=pi/72;

     count:=340;
     add:=3;

     pb:=0;
     blur1:=0;
     r:=10;

     repeat
     count:=count-add;
     if count<-900 then
        begin
        pb:=pb+1;
        if pb>5 then pb:=0;
        count:=340;
        end;

     movestars;

     if blur1=3 then blur3 (vp[2]);
     if blur1=2 then blur2 (vp[2]);
     if blur1=1 then blur_1 (vp[2]);

     if blur1=0 then cls (0,vp[2]);
     putstars(vp[2]);

              Drawcube;

              waitvbl;
              move (mem[vp[2]:0],mem[vga:0],64000);

              for a:=0 to vertn do
              begin
                   if (pb mod 2)=0 then With Vert[a] Do rotate(z,y,ang);
                   if (pb mod 3)=0 then With Vert[a] Do rotate(x,z,ang);
                   if (pb mod 2)<>0 then With Vert[a] Do rotate(x,y,ang);
                   if pb>2 then With Vert[a] Do rotate(x,y,ang);
                   if pb=1 then With Vert[a] Do rotate(z,y,ang);
                   if pb>4 then With Vert[a] Do rotate(y,z,ang);
                   if pb=3 then With Vert[a] Do rotate(x,z,ang);
                   if pb<4 then With Vert[a] Do rotate(y,x,ang);

              end;
              getzbuffer;

     if keypressed=true then
        begin
        c:=readkey;
        if c='b' then
           begin
             blur1:=blur1+1;
             if blur1>3 then blur1:=0;
             c:=' ';
           end;
        end;
     until c=#27;
     terminate;
end.