program stars;
{$R-}
{$S-}    {dangerous, but it's pretty well debugged}
{$G+}
{************************************************************************}
{*                                                                      *}
{*     STARS by Mark Mackey. Displays a starfield from a moving,        *}
{*       rotating viewpoint. Somewhat glitchy due to using only         *}
{*       16-bit arithmetic (rotations aren't quite orthogonal),         *}
{*       but works OK as an example. Could also be sped up a bit        *}
{*       by rewriting the newstar() procedure in assembler and          *}
{*       fiddling with the update() code, but I couldn't be bothered.   *}
{*       If anyone wants to convert this to 32-bit arithmetic and       *}
{*       send me a copy I'd be quite grateful...                        *}
{*     Alternatively, the star positions could be fixed and the         *}
{*       display positions re-evaluated each display cycle from the     *}
{*       orientation and position of the viewer, but this would make    *}
{*       wraparound harder and would probably be slower.                *}
{*     This code is released as freeware. You are free to use and       *}
{*       modify it as you see fit, but acknowledgement would be nice,   *}
(*       {$DEFINE DREAM_ON} as would $$$ {$UNDEF DREAM_ON}.             *)
{*                                                                      *}
{*     Please send comments, suggestions, bugs etc to                   *}
{*       mmackey@aqueous.ml.csiro.au. If mail bounces (I'm moving       *}
{*       soon) resend to mackey@aqueous.ml.csiro.au with 'MARK:' in     *}
{*       the subject header, and it'll get to me eventually...          *}
{*                                                                      *}
{*     Hit 'x','y','z' to toggle rotation about that axis, '<' or '>'   *}
{*       to change rotation speed for currently selected axes, or       *}
{*       '+','-' to change speed.  ESC exits.                           *}
{*                                                                      *}
{*     If this program crashes in a huge steaming heap then you've      *}
{*     probably got a 286. This program won't run on a 286. Sorry.      *}
{*     You lose :).                                                     *}
{*                                                                      *}
{*                                         (C) 1993  Mark Mackey        *}
{************************************************************************}

uses crt;
const MaxStars=1000;         { OK for 486-33. Decrease for slower computers}
      xltsin:integer=640;
      xltcos:integer=round((1-(640/32767)*(640/32767))*32767);
      yltsin:integer=640;
      yltcos:integer=round((1-(640/32767)*(640/32767))*32767);
      zltsin:integer=640;
      zltcos:integer=round((1-(640/32767)*(640/32767))*32767);
                {rotation parameters, 16-bit.}
      speed:word=256;    {speed of movement thru starfield}


 { basic screen size stuff used for star animation. }
const XWIDTH = 320;
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;   { flags for rotation around x,y,z axes}


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!}
  {Sets a pixel in mode 13h}
begin
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
                                 rear of starfield}
begin
  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;
  { Updates star position. Don't you hate the way TP6 can't
    handle 386 assembly code? }


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:=false;roty:=false;rotz:=true;     { set initial rotations}
  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
                                           key pressed}
      if ch='+' then speed:=speed+32;
      if ch='-' then speed:=speed-32;
      if ch='x' then rotx:=not rotx;
      if ch='y' then roty:=not roty;
      if ch='z' then rotz:=not rotz;
      if (ch=',') or (ch='.') then
      begin
        if ch=',' then
        begin
          if rotx then inc(xltsin,20);
          if roty then inc(yltsin,20);
          if rotz then inc(zltsin,20);
        end
        else
        begin
          if rotx then dec(xltsin,20);
          if roty then dec(yltsin,20);
          if rotz then dec(zltsin,20);
        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);
      end;
    end;
  until ch=#27;       {hit ESC to exit}
  settextmode;
  writeln;
  writeln('Thank you for watching STARS by M. Mackey.');
end.