//RouteNeighbor.bcpl
// Code for sorting, nearest neighbor, searching, and area coverage.
//last modified by E. McCreight, May 1, 1979 9:03 PM
get "route.defs"
static
[ iBest; dBest; x; y; s; FindSperge; numAreasCovered = 0; coveredAreas = 0 ]
//----------------------------------------------------------------
//A r e a O v e r l a p D e t e c t o r
//----------------------------------------------------------------
structure area:
[
spMin word
spMax word
]↑1,1
let OverlapsClaimedArea(spMin,spMax) = valof
[
for i=1 to numAreasCovered do
[
if LiesWithin(spMin, coveredAreas>>area.spMin↑i, coveredAreas>>area.spMax↑i)%
LiesWithin(spMax, coveredAreas>>area.spMin↑i, coveredAreas>>area.spMax↑i)%
LiesWithin(coveredAreas>>area.spMin↑i, spMin, spMax)%
LiesWithin(coveredAreas>>area.spMax↑i, spMin, spMax) then
resultis true
]
resultis false
]
and ClaimArea(spMin,spMax) be
[
if coveredAreas eq 0 then coveredAreas = Allocate(SilZone, (size area/16)*maxICs)
numAreasCovered = numAreasCovered+1
if numAreasCovered gr maxICs then CallSwat()
coveredAreas>>area.spMin↑numAreasCovered = spMin
coveredAreas>>area.spMax↑numAreasCovered = spMax
]
and LiesWithin(spWithin, spMin, spMax) = valof
[
if Usc(spWithin, spMin) ls 0 % Usc(spWithin, spMax) gr 0 then resultis false
let xWithin, yWithin = nil,nil
Unsperge(spWithin, 0, lv xWithin, lv yWithin)
let xMin,yMin = nil,nil
Unsperge(spMin, 0, lv xMin, lv yMin)
if xWithin ls xMin % yWithin ls yMin then resultis false
let xMax,yMax = nil,nil
Unsperge(spMax, 0, lv xMax, lv yMax)
if xWithin gr xMax % yWithin gr yMax then resultis false
resultis true
]
//----------------------------------------------------------------
//N e a r e s t N e i g h b o r F i n d e r
//----------------------------------------------------------------
and FindNearest(xParam, yParam, max, FS) = valof
[ // here x,y < #400 and FindSperge addresses a sorted sequence of sperged
// co-ordinates. The result is the argument to FindSperge from 1 to max
// resulting in closest sperged co-ordinate.
FindSperge = FS
x = xParam
y = yParam
s = Sperge(xParam, yParam)
dBest = infinity
iBest = 0
if max gr 0 then FindNearestInRectangle(0, 0, 1, max+1)
resultis iBest
]
and FindNearestInRectangle(prefixMask, prefix, iThisPref, iNextPref) be
[ // First, if this subrectangle has just one point,
// see if it is the best one thus far.
if iThisPref eq iNextPref-1 then
[
let xCur, yCur = nil, nil
Unsperge(FindSperge(iThisPref), 0, lv xCur, lv yCur)
//** PointCursor(xCur, yCur)
let dx = x-xCur
let dy = y-yCur
let dThisPoint = ((dx ge 0)? dx, -dx)+((dy ge 0)? dy, -dy)
if dThisPoint ls dBest then
[
dBest = dThisPoint
iBest = iThisPref
]
return
]
// If not, see if any possible point in this subrectangle is
// closer to (x,y) than dBest. If not, punt.
let xLo, yLo, xHi, yHi = nil, nil, nil, nil
Unsperge(prefix, 0, lv xLo, lv yLo)
Unsperge(prefix+(not prefixMask), 0, lv xHi, lv yHi)
let xClosest = ClosestInInterval(xLo, xHi, x)
let yClosest = ClosestInInterval(yLo, yHi, y)
let dx = x-xClosest
let dy = y-yClosest
let dThisRectangle = ((dx ge 0)? dx, -dx)+((dy ge 0)? dy, -dy)
if dThisRectangle ge dBest then return
// Recursively examine first the side closest to (x,y), and then
// the other side.
//** ShowBox(xLo, yLo, xHi, yHi)
let newPrefixMask = #100000+(prefixMask rshift 1)
let newPrefixMaskBit = newPrefixMask&(not prefixMask)
let sClosest = Sperge(xClosest, yClosest)
let newPrefixBit = sClosest&newPrefixMaskBit
let iMidPref = BinSearch(prefix+newPrefixMaskBit,
iThisPref, iNextPref, CompareFoundSperge)
for half=0 to 1 do
[
test newPrefixBit eq 0
ifso
if iMidPref gr iThisPref then
FindNearestInRectangle(newPrefixMask, prefix, iThisPref, iMidPref)
ifnot
if iMidPref ls iNextPref then
FindNearestInRectangle(newPrefixMask, prefix+
newPrefixBit, iMidPref, iNextPref)
newPrefixBit = newPrefixBit xor newPrefixMaskBit
]
]
and ClosestInInterval(xstart, xend, x) = (x ls xstart)? xstart, ((x gr xend)? xend, x)
and CompareFoundSperge(value, j) = Usc(value, FindSperge(j))
//----------------------------------------------------------------
//B i n a r y S e a r c h R o u t i n e
//----------------------------------------------------------------
and BinSearch(value, minIn, minOut, CompareWithIndex) = valof
[ // returns the index of the first argument to CompareWithIndex
// between minIn and minOut that is greater than or equal to
// value. Assumes CompareWithIndex(value, minOut)<0; never
// checks this. Assumes if i<j then for all values of x,
// CompareWithIndex(x, i)>=CompareWithIndex(x, j).
while minIn ls minOut do
[
let mid = (minIn+minOut) rshift 1 // never =minOut
let c = CompareWithIndex(value, mid)
test c gr 0
ifsominIn = mid+1
ifnottest c ls 0
ifsominOut = mid
ifnotresultis mid
]
resultis minIn
]
//----------------------------------------------------------------
//H e a p R o u t i n e s
//----------------------------------------------------------------
and AddToHeap(heap, item, Compare) be
[
let sonPtr = heap!0+1
heap!0 = sonPtr
let fatherPtr = sonPtr rshift 1
while fatherPtr gr 0 & Compare(heap!fatherPtr, item) ls 0 do
[
heap!sonPtr = heap!fatherPtr
sonPtr = fatherPtr
fatherPtr = fatherPtr rshift 1
]
heap!sonPtr = item
]
and PullFromHeap(heap, Compare) = valof
[
if heap!0 le 0 then CallSwat("Pull from empty heap")
let result = heap!1
let testItem = heap!(heap!0)
heap!0 = heap!0-1
let fatherPtr = 1
let sonPtr = 2
while sonPtr le heap!0 do
[
if sonPtr ls heap!0 &
Compare(heap!(sonPtr+1), heap!sonPtr) gr 0 then
sonPtr = sonPtr+1
if Compare(testItem, heap!sonPtr) ge 0 then break
heap!fatherPtr = heap!sonPtr
fatherPtr = sonPtr
sonPtr = fatherPtr+fatherPtr
]
heap!fatherPtr = testItem
resultis result
]
//----------------------------------------------------------------
//S o r t R o u t i n e
//----------------------------------------------------------------
and Sort(heap, Compare) be
[
let len = heap!0
heap!0 = 0
for i=1 to len do AddToHeap(heap, heap!i, Compare)
for i=len to 2 by -1 do heap!i = PullFromHeap(heap, Compare)
heap!0 = len
]
//----------------------------------------------------------------
//C o - o r d i n a t e S p e r g i n g O p e r a t i o n s
//----------------------------------------------------------------
and Sperge(x, y, pFine; numargs na) = valof
[
if na gr 2 then @pFine = (x&3 lshift 2)+(y&3)
resultis (Spread(x rshift 2) lshift 1)+Spread(y rshift 2)
]
and Spread(x) = valof
[ // x must be < #400
let x1 = ((xŨ) lshift 4)+(x)
let x2 = ((x1) lshift 2)+(x1ջ)
resultis ((x2刲) lshift 1)+(x2⢵)
]
and Unsperge(sperge, fine, px, py) be
[
@px = (Unspread(sperge rshift 1) lshift 2)+((fine rshift 2)&3)
@py = (Unspread(sperge) lshift 2)+(fine&3)
]
and Unspread(x) = valof
[
let x3 = x촭
let x2 = ((x3 rshift 1)刲)+(x3⢵)
let x1 = ((x2 rshift 2))+(x2ջ)
resultis ((x1 rshift 4)Ũ)+(x1)
]