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 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 := 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 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; CheckOffspring( PlaceMe, baseSect, maxdist ); While PlaceMe.front <> 0 do begin serve( PlaceMe, daddy, sonny ); if not showing[ sonny ].visible then begin FindHome( Grid, Showing, daddy, sonny ); if Showing[ sonny ].visible then { if he didn't make it} CheckOffspring( PlaceMe, sonny, maxDist ); { don't look for kids } end;{if not showing} end; {while} end; {while} procedure InitSectorToScreen( var s : SectorToScreen ); var n : sector; begin for n := 1 to 1000 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; FixDistances( sn, Distances ); repeat write( 'Max distance to include? '); readln( maxD ); writeln( 'Total of ', CountDist( 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 ); const size = 11; 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 ); MoveTo( r - xoffset, c - yoffset ); Drawstring( NumVal( s ) ); 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 );