program smallflt;	{ a scaled-down "star flight"}
{$P-}
{Written by Mike Morton for MacTutor}
{Converted to Atari ST Personal Pascal by Bruce Wiebe}
{Copyright 1989 Antic Publishing Inc.}

{$I include\GEMSUBS.PAS}

const
  numStars   = 75;{ number of stars we display}
  maxXY      = 64; { largest star radius (X or Y)}
  halfXY     = 32;
  maxZ       = 200;{ largest star distance (Z)}
  speed      = 4;  { Z change per animation cycle}


type
  Point = record
    h,v :integer;
  End;

  star = record    { information about one star }
    ploc : point;  { physical location in space (X,Y)}
    z  : integer;  { physical location in space (Z)}
    sloc : point;  { location on screen (h,v)}
  end;

  rect = record
    top,bottom,left,right : Integer;
  End;

  star_ptr = ^star;


var{ global program variables}
  stars: array[0..numStars] of star;	{ information on stars}
  bounds: rect;		{ rectangle used for bounds checking}
  sorigin: point;	{ center of screen}
  x1,y1,x,y,w,h : Integer; {window parameters}
  Win1_Title : Window_Title;
  Window_Parts, win1 : Short_Integer;
  PhysBase : Long_Integer;
  junk : Integer;

Function Addr(VAR what : star): Long_Integer; EXTERNAL;

Function Ptr(where : Long_Integer): star_ptr; EXTERNAL;

Function GetPhysBase : Long_Integer;
  XBIOS(2);

Function Random : Long_Integer;
  XBIOS(17);

Procedure FLIPPIX(screenaddress, h, v : Long_integer); 
EXTERNAL;

FUNCTION Button_Pressed:Boolean;
VAR
  control : array[0..11] of Integer;
  int_in  : array[0..15] of Integer;
  int_out : array[0..45] of Integer;
  pts_in,pts_out : array[0..11] of Integer;
Begin
  vdi_call(124,0,0,0,control,int_in,int_out,pts_in,pts_out,false);
  If int_out[0] = 0 then Button_Pressed:=FALSE
  Else                   Button_Pressed:=TRUE;
End; {vq_mouse}

{ makestar -- randomize physical location; set Z and find screen location}
Procedure makeStar(VAR new : star);{ initialize one star}
var
  dh,dv : integer;{ star's position, relative to origin}
begin
  new.ploc.h := (random MOD maxXY) -halfXY;       { horizontal position}
  new.ploc.v := (random MOD maxXY) -halfXY;       { vertical position}
  new.z := maxZ;                        { how far away is it?}
  dh := new.ploc.h * maxZ div new.z;    { compute h offset}
  new.sloc.h := sorigin.h + dh;	        { compute absolute h pos}
  dv := new.ploc.v * maxZ div new.z;    { compute v offset}
  new.sloc.v := sorigin.v + dv;		{ compute absolute v pos}
  flipPix(PhysBase,new.sloc.h, new.sloc.v);
	{ flip spot (draw star 1st)}
end;{ of procedure makeStar}


{ initialize --}
{ define bounds rect; draw initial stars}
Procedure initialize;	{ one-time initialize}
var
  i,x1,y1 : integer; { star number}
begin
  If Init_Gem < 0 then Halt;
  Init_Mouse;
  Hide_Mouse;
  {Set up window}
  Begin_Update;
  work_rect(0,x,y,w,h);
  bounds.bottom:=x+h;
  bounds.Top:=y;
  bounds.right:=y+w;
  bounds.left:=x;
  Window_Parts:=G_Name|G_Close|G_Move|G_Size;
  Win1_Title:='  Small Flight  ';
  win1:=New_Window(Window_Parts,win1_title,x,y,w,h);
  open_window(win1,0,0,0,0);
  Work_Rect(win1,x,y,w,h);
  Set_Clip(x,y,w,h);
  Paint_Color(Black);
  Paint_Rect(x,y,w,h);
  Paint_Color(white);
  Set_Mouse(M_Arrow);
  End_Update;
  Draw_Mode(3);
  sorigin.h := (bounds.left + bounds.right)  div 2;{ find the ...}
  sorigin.v := (bounds.top  + bounds.bottom) div 2;{ ... origin  }
  PhysBase:=GetPhysBase;
  for i := 1 to numStars do   { loop through all the stars}
    makeStar(stars[i]);       { and make up each one }
end;	{ of procedure init }

{ cycle  main routine.  For each star, erase the old position.     }
{ See if its motion has carried it past the plane we're in.  If so,  }
{ we create a new star.  If not, we compute the new apparent position}
{ from the new Z.  If the apparent position is outside display, we   }
{ create a new star; otherwise we draw the star's new position       }

procedure cycle;{ do one animation cycle}
var
  i : integer;	{ star number in main loop }
  dv, dh:	integer;		{star coordinates, origin-relative}
  sp:	star_ptr;{ fast pointer to stars[i]}
  where : Long_Integer;

begin
  for i := 1 to numStars do	{ loop through all the stars}
  begin
    where := Addr(stars[i]);{ point to star avoid subscripting}
    sp:=Ptr(where);
    flipPix(PhysBase,sp^.sloc.h,sp^.sloc.v);	{ erase the star's old position}
    sp^.z := sp^.z - speed;{ time advances: find new z position}
    if sp^.z <= 0			{ past the plane of the eye yet?}
      then makeStar(sp^)            { yes, this star's gone; make another}
    else
    begin                             { no, update star's screen position}
      dh := sp^.ploc.h * maxZ div sp^.z; { compute relative h}
      sp^.sloc.h := sorigin.h + dh;	 { and compute absolute screen h}
      dv := sp^.ploc.v * maxZ div sp^.z; { compute relative v}
      sp^.sloc.v := sorigin.v + dv;	 { and compute absolute screen v}
      if   (dv+sorigin.v >= bounds.bottom) { is the new position ...}
        or (dv+sorigin.v <= bounds.top)    { ... outside ...}
        or (dh+sorigin.h >= bounds.right) { ... the bounds rectangle ...}
        or (dh+sorigin.h <= bounds.left) { ... which is centered at origin?}
        then makeStar(sp^)               { yes, so get a new one}
      else 
        flipPix(PhysBase,sp^.sloc.h,sp^.sloc.v);
                                  { no:  draw it at new position}
    end;                          { of case where z didn't go off edge}
  end;	                             { of loop through all stars}
end;                                     { of procedure cycle}


begin{ main program}
  initialize;{set everything up}
  repeat	{ main loop}
    cycle;{ do one animation "frame"}
{repeat}
  until Button_Pressed;
  Close_Window(win1);
  Delete_Window(win1);
  Show_Mouse;
  Exit_GEM;
end.