[Back to GRAPHICS SWAG index]  [Back to Main SWAG index]  [Original]

{
Ok...  Here goes.  You will have to figure out how to TSR this if you
want...  But you can navigate in this one too!  TP v6.0
}

program stars;
{$R-}
{$S-}    {dangerous, but it's pretty well debugged}
{$G+}
uses crt;
const MaxStars=1000;         { OK for 486-33. Decrease for slower computers}
      xltsin:integer=0;
      xltcos:integer=round((1-(640/32767)*(640/32767))*32767);
      yltsin:integer=0;
      yltcos:integer=round((1-(640/32767)*(640/32767))*32767);
      zltsin:integer=0;
      zltcos:integer=round((1-(640/32767)*(640/32767))*32767);
                {rotation parameters, 16-bit.}
      speed:word=264;    {speed of movement thru starfield}
const XWIDTH = 320;  { basic screen size stuff used for star animation.}
const YWIDTH = 200;
const XCENTER = ( XWIDTH div 2 );
const YCENTER = ( YWIDTH div 2 );
type STARtype=record
                x,y,z:integer; {The x, y and z coordinates}
                xz,yz:integer; { screen coords}
              end;
var star:array[1..maxstars] of startype;
    i:integer;
    ch:char;
    rotx,roty,rotz:boolean;
    rotxv,rotyv,rotzv:integer;
procedure setmode13;    {sets 320*200 256-colour mode}
assembler;
asm
  mov ax,13h
  int 10h
end;
procedure settextmode;   {returns to text mode}
assembler;
asm
  mov ax,03h
  int 10h
end;
procedure setpix(x,y:integer;c:byte);  {NO BOUNDARY CHECKING!}
begin   {Sets a pixel in mode 13h}
asm
  mov ax,0a000h
  mov es,ax
  mov ax,y
  mov bx,320
  mul bx
  mov di,x
  add di,ax
  mov al,c
  mov es:[di],al
end;
end;
procedure initstar(i:integer);  {initialise stars at random positions}
begin
  with star[i] do
  begin
    x := longint(-32767)+random(65535);
    y := longint(-32767)+random(65535);             {at rear}
    z := random(16000)+256;
    xz:=xcenter;
    yz:=ycenter;
  end;
end;
procedure newstar(i:integer);   {create new star at either front or}
begin                            {rear of starfield}
  with star[i] do
  begin
    x := longint(-32767)+random(65535);
    y := longint(-32767)+random(65535);
    if z<256 then z := random(1256)+14500     {kludgy, huh?}
      else z:=random(256)+256;
    xz:=xcenter;
    yz:=ycenter;
  end;
end;

{$L update.obj}
procedure update(var star:startype;i:integer);external;




begin
   {gets ~100 frames/sec on a 486-33 with 500 stars,
       rotating on 1 axis, speed 256}
  clrscr;
  checkbreak:=false;                      { for speed?}
  randomize;
  for i:=1 to maxstars do initstar(i);    {initialise stars}
  setmode13;
  rotx:=true;roty:=true;rotz:=true;
  ch:=' ';
  repeat
    for i:=1 to maxstars do update(star[i],i);  {update star positions}
    if keypressed then
    begin
      ch:=readkey;                       { change parameters according to }
      if ch='+' then speed:=speed+32;    {  key pressed}
      if ch='-' then speed:=speed-32;
      if ch=#13 then
         begin
              xltsin:=0;
              yltsin:=0;
              zltsin:=0;
              speed:=256;
         end;
      if ch=#80 then dec(xltsin,96);
      if ch=#72 then inc(xltsin,96);
      if ch=#77 then dec(yltsin,96);
      if ch=#75 then inc(yltsin,96);
      if ch=#81 then
         begin
              dec(yltsin,96);
              if xltsin<0 then inc(zltsin,96);
              if xltsin>0 then dec(zltsin,96);
         end;
      if ch=#79 then
         begin
              inc(yltsin,96);
              if xltsin<0 then dec(zltsin,96);
              if xltsin>0 then inc(zltsin,96);
         end;
      if ch=#71 then dec(zltsin,96);
      if ch=#73 then inc(zltsin,96);
      end;
    xltcos:=round((1-sqr(xltsin/32767))*32767);
    yltcos:=round((1-sqr(yltsin/32767))*32767);    { evaluate cos values}
    zltcos:=round((1-sqr(zltsin/32767))*32767);
  until ch=#27;       {hit ESC to exit}
  settextmode;
  writeln;
end.

[Back to GRAPHICS SWAG index]  [Back to Main SWAG index]  [Original]