{$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 eaving ', sn, ', sectors coming oward ', sn, ', or 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 }