const xmax = 470; ymax = 270; XDimMax = 20; YDimMax = 15; xoffset = 10; yoffset = -2; 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; XMax : integer; XDim : XIndex; XLength : integer; YMax : integer; YDim : YIndex; YLength : integer; abort, GotDistances : boolean; BaseSector: sectorindex; error : integer; command : string; Branching : char; {$I svga.inc } 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; end; 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 CheckOffspring( var P : Queue; where : sector; maxDist : integer); { Check all sectors from "where" to see if they should be pushed onto the Queue } var t : warpIndex; begin with space.sectors[ where ] do if number > 0 then for t := 1 to number do if (not OnScreen[ data[ t ] ].visible) and (Distances[ data[t] ].d <= maxDist) then enqueue( P, where, data[ t ] ); end; {check offspring} 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 := random( 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 := random( 6 ); two := random( 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 := random( 6 ); two := random( 6 ); three := random( 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 := random( xdim ) + 1; freecol := random( ydim ) + 1; 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 : sectorindex ); 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; var HaveDists : boolean; var sn : sectorindex; var dir : char; var abort : boolean ); { Choose a sector, and fill Distances with distance to that sector, as well as Showing and Grid based on nearby vertices. } var maxD : integer; ch : char; begin InitSectorToScreen( Showing ); InitScreen( Grid ); if not HaveDists then begin if sn = 0 then repeat write('Starting '); sn := GetSector; if sn = 0 then begin writeln('Aborting...'); abort := true; exit; end; {if} if space.sectors[ sn ].number = 0 then writeln('You have never visited ', sn ); until space.sectors[ sn ].number > 0; if dir = 'X' then begin write( 'Sectors eaving ', sn, ', sectors coming oward ', sn, ', or oth? '); readln( dir ); end; if dir in ['l','L'] then TwoWayDistances( sn, distances, false, true ) else if dir in ['t','T'] then TwoWayDistances( sn, distances, true, false ) else TwoWayDistances( sn, distances, true, true ); HaveDists := true; end; {if} write( 'Max distance to include? '); maxD := readNumberFromTerminal; writeln( 'Total of ', CountDist(Distances, maxD), ' at distance at most ', MaxD ); PlaceSectors( Grid, Showing, maxD, sn ); end; {FillGrid} function PortColor( g : stuff; mono : boolean ) : word; begin if (GetMaxColor = 1) or mono then PortColor := 0 else case g of NotAPort : PortColor := Black; 0 : PortColor := Blue; 1 : PortColor := Green; 2 : PortColor := Cyan; 3 : PortColor := LightRed; 4 : PortColor := Magenta; 5 : PortColor := LightBlue; 6 : PortColor := LightGreen; 7 : PortColor := LightCyan; 8 : PortColor := Yellow; else PortColor := black; {shouldn't happen...} end; {case} end; {PortColor} function SectorColor( s : sector; mono : boolean ) : word; begin if GetMaxColor = 1 then {monochrome} SectorColor := 1 else {not monochrome } with space.sectors[s] do if number = 0 then if mono then SectorColor := White else SectorColor := Yellow else if etc and HasFighters <> 0 then SectorColor := White else if porttype = NotAPort then SectorColor := LightGray else if PortColor( porttype, mono ) < LightBlue then SectorColor := LightGray else SectorColor := black; end; {SectorColor} procedure CircleSector( x : XIndex; y : YIndex; s : sector; mono : boolean ); var r, c, xradius : integer; xasp, yasp : word; ColorUsed : word; Pporttype : string; begin r := xpixel( x, y ); c := ypixel( x, y ); GetAspectRatio( xasp, yasp ); xradius := round( yasp/xasp * ylength/2); SetLineStyle( SolidLn, 0, NormWidth ); if space.sectors[s].number = 0 then SetColor( Black ) else SetColor( SectorColor( s , mono) ); SetFillStyle( SolidFill, PortColor( space.sectors[s].porttype, mono ) ); if space.sectors[s].porttype = NotAPort then FillEllipse( r, c, xradius, ylength div 2 ) else begin bar( r - xradius, c - ylength div 2, r + xradius, c + ylength div 2 ); rectangle( r - xradius, c - ylength div 2, r + xradius, c + ylength div 2 ); end; {port} if space.sectors[s].number = 1 then circle( r, c, xradius + 3 ); SetColor( SectorColor( s, mono) ); if (not mono) or (space.sectors[s].porttype = NotAPort) then outTextXY( r, c, str( s, 3 ) ) else {use mono display} begin outtextXY(r, c-3, str(s,3)); outtextXY(r, c+7, status(space.sectors[s].porttype) ); end; {else} if space.sectors[s].etc and SpaceLane <> Nothing then begin SetLineStyle( SolidLn, 0, NormWidth ); MoveTo( r - xradius, c - ylength div 2 ); LineTo( r + xradius, c + ylength div 2 ); end; {if} end; procedure ConnectVertices( i1, i2 : XIndex; j1, j2 : YIndex; TwoWay : boolean ); var n, x1, y1, x2, y2 : integer; dist : real; begin x1 := xpixel( i1, j1 ); y1 := ypixel( i1, j1 ); x2 := xpixel( i2, j2 ); y2 := ypixel( i2, j2 ); if TwoWay then SetLineStyle( SolidLn, 0, NormWidth ) else SetLineStyle( DashedLn, 0, ThickWidth ); dist := sqrt( abs(i2-i1) + abs(j2-j1)); if (dist <= 1.5) or (dist >=9) then n := 0 else n := round(3*dist); MoveTo( x1+n, y1+n ); LineTo( x2+n, y2+n ); end; procedure DrawGrid( var G : screen; STS : SectorToScreen ); var i : XIndex; j : YIndex; t : WarpIndex; temp : integer; begin 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 ) ); 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, mono ); end; {$I initgrph.inc } procedure GetDimensions( var x : XIndex; var xl : integer; var y : YIndex; var yl : integer ); const whitespace : set of char = [' ', #9, #10, #13 ]; 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' ); inc( position ); end; {while} inc( position ); while (position <= length( line ) ) and (line[position] in whitespace) do inc( position ); tempy := 0; while (position <= length( line )) and (line[position] in ['0'..'9']) do begin tempy := 10 * tempy + ord( line[position] ) - ord('0'); inc( position ); 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; InitGraphics; XMax := GetMaxX; YMax := GetMaxY; closeGraph; xl := trunc( XMax / x / 2 ); yl := trunc( YMax / y / 2); end; begin {view} GetDimensions( XDim, XLength, YDim, Ylength ); GotDistances := false; abort := false; BaseSector := 0; Branching := 'X'; repeat FillGrid( Grid, OnScreen, Distances, GotDistances, BaseSector, branching, abort ); if not abort then begin InitGraphics; DrawGrid( Grid, Onscreen ); readln( command ); closeGraph; if command = '' then abort := not prompt( 'again? ') else begin val( command, BaseSector, error ); if error <> 0 then BaseSector := 0; GotDistances := false; end; end; {not abort} until abort; end; {view}