//RouteNeighbor.bcpl

// Code for 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))

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)

]