Game Killer/Game_Killer.bin/286.VIEWMAC.INC

Text File | 1991-07-08 | 13KB | 443 lines

{$S View }
const
  xmax = 470;
  ymax = 270;
  XDimMax  = 20;
  YDimMax  = 15;
  xoffset  = 10;
  yoffset  = -2;
  size     = 11;

type
  Vertex = record
             sectorNum: integer;  { 0 if not in use }
           end;
  XIndex = 1..XDimMax;
  YIndex = 1..YDimMax;
  Screen = array [XIndex, YIndex ] of Vertex;
  Pair   = record
             visible : boolean;
             row : XIndex;
             col : YIndex;
           end;
  SectorToScreen = array [ sector ] of pair;

procedure View;

var
  Grid      : screen;
  OnScreen  : SectorToScreen;
  XDim      : XIndex;
  XLength   : integer;
  YDim      : YIndex;
  YLength   : integer;

function xpixel( i,j : integer ) : integer;
begin
  if not odd( j ) then
    xpixel := (2 * i - 1) * XLength
  else
    xpixel := 2 * i * XLength;
end;

function ypixel( i,j : integer ) : integer;
begin
  ypixel := (2 * j - 1) * Ylength + 4;
end;

function NumVal( n : integer ) : string;
var
  temp : string;
begin
  temp := '';
  while n > 0 do
    begin
      temp := chr( n mod 10 + ord('0') ) + temp;
      n := n div 10;
    end;
  if length( temp ) = 1 then
    temp := ' ' + temp + ' '
  else if length( temp ) = 2 then
    temp := ' ' + temp;
  NumVal := temp;
end; {NumVal}

procedure Tag( var STS : sectorToScreen;
               var scr : screen;
                   num : sector;
                  irow : XIndex;
                  jcol : YIndex );
{ put sector num into screen scr at irow, jcol; update sts accordingly }
begin
  if sts[ num].visible then
    writeln('sector ', num, ' already placed before Tag!')
  else if scr[ irow, jcol ].sectorNum <> 0 then
    writeln('row ', irow, ', col ', jcol, ' already in use!')
  else
    begin
      with STS[ num ] do
        begin
          visible := true;
          row     := irow;
          col     := jcol;
        end; {with}
      scr[ irow, jcol ].SectorNum := num;
    end; {else}
end; {tag}

procedure GoDirection( d : integer;
                   var Row   : XIndex;
                   var Col   : YIndex);
{ 0 is upleft, 1 left, 2 downleft, 3 downright, etc mod 6 }
begin
  d := abs( d ) mod 6;
  if odd( Col ) then
    case d of
      0 : begin
            if Col > 1 then col := col - 1;
            if Row < XDim then row := row + 1;
          end;
      1 : if Row < XDim then row := row + 1;
      2 : begin
            if Col < YDim then col := col + 1;
            if Row < XDim then row := row + 1;
          end;
      3 : if Col < YDim then col := col + 1;
      4 : if row > 1 then row := row - 1;
      5 : if Col > 1 then col := col - 1;
    end {case}
  else
    case d of
    0 : if Col > 1 then col := col - 1;
    1 : if Row < XDim then row := row + 1;
    2 : if Col < YDim then col := col + 1;
    3 : begin
          if Col < YDim then col := col + 1;
          if Row > 1 then row := row - 1;
        end;
    4 : if Row > 1 then row := row - 1;
    5 : begin
          if Col > 1 then col := col - 1;
          if Row > 1 then row := row - 1;
        end;
    end; {case}
end;

procedure seek( var freerow : Xindex; var freecol : Yindex; home : sector );
const
  MaxTries = 100;
var
  one, two, three, n : integer;
{ Trying to find a home for the new guy, close to the home sector.
one, two, and three will be random directions to try (of radius 1, 2, and
3).  When we are successful, we just break out of the procedure, hopefully
returning a freerow and freecol. }
begin
  one := die( 6 );
  for one := one to one + 5 do { from random start, advance 5 positions }
    begin
      freerow := OnScreen[ home ].row;
      freecol := OnScreen[ home ].col;
      GoDirection( one, freerow, freecol );
      if grid[ freerow, freecol ].SectorNum = 0 then
        exit;
    end; {one}
  one := die( 6 );
  two := die( 6 );
  for one := one to one + 5 do
    for two := two to two + 5 do
      begin
        freerow := OnScreen[ home ].row;
        freecol := OnScreen[ home ].col;
        GoDirection( one, freerow, freecol );
        GoDirection( two, freerow, freecol );
        if grid[ freerow, freecol ].SectorNum = 0 then
          exit;
      end; {one two}
  one := die( 6 );
  two := die( 6 );
  three := die( 6 );
  for one := one to one + 5 do
    for two := two to two + 5 do
      for three := three to three + 5 do
        begin
          freerow := OnScreen[ home ].row;
          freecol := OnScreen[ home ].col;
          GoDirection( one, freerow, freecol );
          GoDirection( two, freerow, freecol );
          GoDirection( three, freerow, freecol );
          if grid[ freerow, freecol ].SectorNum = 0 then
            exit;
        end; {one two three}
  writeln('couldn''t place anything near ', home );
  n := 0;
  repeat
    freerow := die( xdim );
    freecol := die( ydim );
    n := n + 1;
  until (n = MaxTries) or (grid[ freerow, freecol ].sectorNum = 0);
end; {seek}

procedure FindHome( var Grid : screen;
                    var Showing : SectorToScreen;
                        home, near : sector );
{ This is an interesting bit: given the home sector, find an open slot
in the Grid to place the near sector. }
var
  basedir : integer;
  baserow : XIndex;
  basecol : YIndex;
begin
{  writeln('Trying to find a home for ', near, ' close to ', home );
  writeln('starting at ', showing[ home ].row, showing[ home ].col ); }
  seek( baserow, basecol, home );
  if grid[ baserow, basecol ].SectorNum <> 0 then
    writeln('Seek Failed!')
  else
    Tag( Showing, Grid, near, baserow, basecol );
{  writeln('chose ', baserow, ' ', basecol );
  readln; }
end;

procedure DistanceSortedQueueLoad( var q : queue; max : integer );
{ Load all pairs (parent, offspring) from the distance array whose distance
is less than max, but do so in priority order sorted by distance. }
var
  r : integer;
  sec : sector;
begin
  for r := 1 to max do
    for sec := 1 to maxSector do
      if distances[sec].d = r then
        enqueue( q, distances[sec].s, sec );
end; {DistanceSortedQueueLoad}

procedure PlaceSectors( var Grid  : screen;
                        var Showing : SectorToScreen;
                        var maxDist : integer;
                        var BaseSect : sector );
var
  PlaceMe : Queue;
  daddy, sonny : sector;
begin
  Tag( showing, Grid, baseSect, XDim div 2, YDim div 2 ); { put first in center}
  PlaceMe.front := 0;
  DistanceSortedQueueLoad( PlaceMe, maxdist );
  While PlaceMe.front <> 0 do
    begin
      serve( PlaceMe, daddy, sonny );
      if showing[ daddy ].visible then
        FindHome( Grid, Showing, daddy, sonny );
    end; {while}
end; {while}

procedure InitSectorToScreen( var s : SectorToScreen );
var
  n : sector;
begin
  for n := 1 to maxSector do
    s[ n ].visible := false;
end;

procedure InitScreen( var s : Screen );
var
  r : XIndex;
  c : YIndex;
begin
  for r := 1 to XDim do for c := 1 to YDim do
    s[ r, c ].sectorNum := 0;
end;

procedure FillGrid( var Grid : screen;
                    var Showing : SectorToScreen;
                    var Distances : distanceArray );
{ Choose a sector, and fill Distances with distance to that sector,
as well as Showing and Grid based on nearby vertices. }
var
  maxD : integer;
  sn   : sector;
  ch   : char;
begin
  repeat
    write('Starting at which sector? ');
    readln( sn );
    if space.sectors[ sn ].number = 0 then
      writeln('You have never visited ', sn );
  until space.sectors[ sn ].number > 0;
  write( 'Sectors <L>eaving ', sn, ', sectors coming <T>oward ', sn, ', or <B>oth? ');
  readln( ch );
  if ch in ['l','L'] then
    TwoWayDistances( sn, distances, false, true )
  else if ch in ['t','T'] then
    TwoWayDistances( sn, distances, true, false )
  else
    TwoWayDistances( sn, distances, true, true );
  repeat
    write( 'Max distance to include? ');
    readln( maxD );
    writeln( 'Total of ', CountDist(Distances, maxD), ' at distance at most ', MaxD );
    write('Is this okay?  (y/n) ');
    readln( ch );
  until ch in ['Y','y'];
  InitSectorToScreen( Showing );
  InitScreen( Grid );
  PlaceSectors( Grid, Showing, maxD, sn );
end; {FillGrid}



procedure CircleSector( x : XIndex; y : YIndex; s : sector );
var
  r, c, n : integer;
  q    : rect;
begin
  r := xpixel( x, y );
  c := ypixel( x, y );
  SetRect( q, r - size, c - size, r + size, c + size );
  eraseOval( q );
  with space.sectors[ s ] do
    if number > 0 then
      if portType <> NotAPort then
        FrameRect( q )
      else
        FrameOval( q );
  if space.sectors[s].number = 1 then {dead end}
    begin
      setRect( q, r-size+3, c-size+3, r+size-3, c+size-3);
      if space.sectors[s].portType <> NotAPort then
        FrameRect( q )
      else
        FrameOval( q );
    end; {dead end}
  MoveTo( r - xoffset, c - yoffset );
  Drawstring( NumVal( s ) );
  if space.sectors[s].etc and SpaceLane <> Nothing then
    if space.sectors[s].portType = NotAPort then
      begin
        MoveTo( r - size div 2, c - size div 2 );
        line( size, size );
      end
    else
      begin
        MoveTo( r-size, c-size );
        line( 2*size,2*size);
      end;
end;

procedure NormalPenStats;
begin
  PenSize( 1, 1 );
end;

procedure UnknownPenStats;
begin
  Pensize( 3, 3 );
{  PenPat( ltGray ); }
end;

procedure ConnectVertices( i1, i2 : XIndex; j1, j2 : YIndex;
                           TwoWay : boolean );
var
  x1, y1, x2, y2 : integer;
begin
  x1 := xpixel( i1, j1 );
  y1 := ypixel( i1, j1 );
  x2 := xpixel( i2, j2 );
  y2 := ypixel( i2, j2 );
  if TwoWay then
    NormalPenStats
  else
    UnknownPenStats;
  MoveTo( x1, y1 );
  LineTo( x2, y2 );
end;

procedure DrawGrid( var G : screen; STS : SectorToScreen );
var
  i : XIndex;
  j : YIndex;
  t : WarpIndex;
  temp : integer;
begin
  clearScreen;
  for i := 1 to XDim do
    for j := 1 to YDim do
      if G[ i, j ].sectorNum <> 0 then
        with G[ i, j ] do
          with space.sectors[ sectorNum ] do if number > 0 then
            for t := 1 to number do
              if STS[ data[ t ] ].visible then
                ConnectVertices( i, STS[data[t] ].row, j, STS[data[t]].col,
                                 IsWarp( data[t], sectorNum ) );
  NormalPenStats;
  for i := 1 to XDim do
    for j := 1 to YDim do
      if G[ i, j ].sectorNum <> 0 then
          CircleSector( i, j, G[i,j].sectorNum );
end;

procedure GetDimensions( var x : XIndex; var xl : integer;
                         var y : YIndex; var yl : integer );
var
  line : string;
  ok   : boolean;
  tempx, tempy,
  position : integer;
begin
  ok := false;
  repeat
    write('Max dimensions? [', XDimMax, ' by ', YDimMax, ']  ');
    readln( line );
    if line = '' then
      begin
        ok := true;
        x := XDimMax * 2 div 3;
        y := YDimMax * 2 div 3;
      end
    else
      begin
        position := 1;
        tempx := 0;
        while (position <= length( line )) and
              (line[position] in ['0'..'9']) do
          begin
            tempx := 10 * tempx + ord( line[ position ] ) - ord( '0' );
            position := position + 1;
          end; {while}
        position := position + 1;
        while (position <= length( line ) ) and
              (line[position] in [' ', #9, #10, #13 ]) do
          position := position + 1;
        tempy := 0;
        while (position <= length( line )) and
              (line[position] in ['0'..'9']) do
          begin
            tempy := 10 * tempy + ord( line[position] ) - ord('0');
            position := position + 1;
          end; {while}
        ok := (tempx>0) and (tempx<=XDimMax) and (tempy>0) and (tempy<=YDimMax);
        if ok then
          begin
            x := tempx;
            y := tempy;
          end {if}
        else
          begin
            writeln('I don''t understand ', line );
            writeln('Please give two integers separated by a space.');
          end; {else}
      end; {else}
  until ok;
  xl := trunc( XMax / x / 2 );
  yl := trunc( YMax / y / 2);
end;

begin {view}
  GetDimensions( XDim, XLength, YDim, Ylength );
  FillGrid( Grid, OnScreen, Distances );
  DrawGrid( Grid, Onscreen );
  readln;
  clearscreen;
end; {view}

{$S }